1: #!/usr/bin/perl
2:
3: # Coded by Guy Ashkenazi, guy@fh.huji.ac.il
4: # Based on the work of Peter Ertl, peter.ertl@pharma.novartis.com
5:
6: use GD;
7:
8: # read the width and the JME string from the cgi query
9: %data = &read_input;
10: @JMEstring = split (/ /,$data{JME});
11: $width = $data{WIDTH};
12:
13: #print "Content-type: text/plain\n\n";
14:
15: # parse JME string
16:
17: $natoms= shift @JMEstring;
18: $nbonds= shift @JMEstring;
19:
20: for ($i = 0; $i < $natoms; $i++) {
21: @name[$i] = shift @JMEstring;
22: @x[$i] = shift @JMEstring;
23: @y[$i] = shift @JMEstring;
24: }
25:
26: for ($i = 0; $i < $nbonds; $i++) {
27: @atomA[$i] = (shift @JMEstring)-1;
28: @atomB[$i] = (shift @JMEstring)-1;
29: @bondType[$i] = shift @JMEstring;
30: }
31:
32: # Find border and move lower left corner to (1.5,1.0)
33:
34: $xmin = $xmax = @x[0];
35: $ymin = $ymax = $y[0];
36: $maxName = 0;
37:
38: for ($i = 1; $i < $natoms; $i++) {
39: $xmax = @x[$i] if (@x[$i] > $xmax);
40: $xmin = @x[$i] if (@x[$i] < $xmin);
41: $ymax = @y[$i] if (@y[$i] > $ymax);
42: $ymin = @y[$i] if (@y[$i] < $ymin);
43: @name[$i] =~ /(\@{1,2})?(\w+)([\+|\-])?(\d)?/;
44: $maxName = length $2 if (length $2 > $maxName);
45: }
46: $maxName = ($maxName-3 < 0) ? 0 : $maxName-3;
47:
48: $scale = $width / ($xmax-$xmin+3+$maxName);
49: $height = $scale * ($ymax-$ymin+2);
50:
51: for ($i = 0; $i < $natoms; $i++) {
52: @x[$i] += (1.5+$maxName/2-$xmin);
53: @x[$i] *= $scale;
54: @y[$i] += (1.0-$ymin);
55: @y[$i] *= $scale;
56: }
57:
58: # Count bonds
59:
60: @bonds = map {0} 0..$natoms-1;
61: @adjacent = map {0} 0..$natoms-1;
62: @bondsx = map {0} 0..$natoms-1;
63: @bondsy = map {0} 0..$natoms-1;
64: for ($i = 0; $i < $nbonds; $i++) {
65: @bonds[@atomA[$i]] += (@bondType[$i]>0) ? @bondType[$i] : 1;
66: @bonds[@atomB[$i]] += (@bondType[$i]>0) ? @bondType[$i] : 1;
67:
68: @adjacent[@atomA[$i]]++;
69: @adjacent[@atomB[$i]]++;
70:
71: @bondsx[@atomA[$i]] += @x[@atomB[$i]] - @x[@atomA[$i]];
72: @bondsy[@atomA[$i]] += @y[@atomB[$i]] - @y[@atomA[$i]];
73: @bondsx[@atomB[$i]] += @x[@atomA[$i]] - @x[@atomB[$i]];
74: @bondsy[@atomB[$i]] += @y[@atomA[$i]] - @y[@atomB[$i]];
75: }
76:
77: # Create a new PostScript object
78: $im = new GD::Image($width,$height);
79: $white = $im->colorAllocate(255,255,255);
80: $black = $im->colorAllocate(0,0,0);
81: $gray = $im->colorAllocate(200,200,200);
82: #$gdAntiAliased = $im->colorAllocate(1,1,1);
83: $im->setAntiAliased($black);
84:
85: # Draw bonds
86: $doubleWidth = 0.10*$scale;
87: $tripleWidth = 0.15*$scale;
88:
89: for ($i = 0; $i < $nbonds; $i++) {
90: $xa = @x[@atomA[$i]];
91: $ya = @y[@atomA[$i]];
92: $xb = @x[@atomB[$i]];
93: $yb = @y[@atomB[$i]];
94:
95: if (@bondType[$i] != 1) {
96: $dx = $xb-$xa;
97: $dy = $yb-$ya;
98: $dd = sqrt($dx*$dx + $dy*$dy);
99: $sina=$dy/$dd;
100: $cosa=$dx/$dd;
101: }
102: if (@bondType[$i] == -2) {
103: for ($t = 0; $t <= 1; $t += 0.1) {
104: $xab = $xa + $t*$dx;
105: $yab = $ya + $t*$dy;
106: $xperp = $tripleWidth*$sina*$t;
107: $yperp = $tripleWidth*$cosa*$t;
108: $im->line($xab+$xperp,$height-($yab-$yperp),
109: $xab-$xperp,$height-($yab+$yperp),
110: gdAntiAliased);
111: }
112: }
113: elsif (@bondType[$i] == -1) {
114: $xperp = $tripleWidth*$sina;
115: $yperp = $tripleWidth*$cosa;
116: $poly = new GD::Polygon;
117: $poly->addPt($xa,$height-$ya);
118: $poly->addPt($xb+$xperp,$height-($yb-$yperp));
119: $poly->addPt($xb-$xperp,$height-($yb+$yperp));
120: $im->filledPolygon($poly,$black);
121: }
122: elsif (@bondType[$i] == 1) {
123: $im->line($xa,$height-$ya,$xb,$height-$yb,gdAntiAliased);
124: }
125: elsif (@bondType[$i] == 2 &&
126: ((@adjacent[@atomA[$i]] == 1 && @adjacent[@atomB[$i]] > 2)||
127: (@adjacent[@atomB[$i]] == 1 && @adjacent[@atomA[$i]] > 2))) {
128: # centered bond
129: $xperp = $doubleWidth*$sina;
130: $yperp = $doubleWidth*$cosa;
131: $im->line($xa+$xperp,$height-($ya-$yperp),
132: $xb+$xperp,$height-($yb-$yperp),
133: gdAntiAliased);
134: $im->line($xa-$xperp,$height-($ya+$yperp),
135: $xb-$xperp,$height-($yb+$yperp),
136: gdAntiAliased);
137: }
138: elsif (@bondType[$i] == 2) {
139: $xperp = 2*$doubleWidth*$sina;
140: $yperp = 2*$doubleWidth*$cosa;
141: $im->line($xa,$height-$ya,$xb,$height-$yb,gdAntiAliased);
142: $im->line($xa+0.1*$dx-$xperp,$height-($ya+0.1*$dy+$yperp),
143: $xb-0.1*$dx-$xperp,$height-($yb-0.1*$dy+$yperp),
144: gdAntiAliased);
145: }
146: elsif (@bondType[$i] == 3) {
147: $xperp = $tripleWidth*$sina;
148: $yperp = $tripleWidth*$cosa;
149: $im->line($xa,$height-$ya,$xb,$height-$yb,gdAntiAliased);
150: $im->line($xa+$xperp,$height-($ya-$yperp),
151: $xb+$xperp,$height-($yb-$yperp),
152: gdAntiAliased);
153: $im->line($xa-$xperp,$height-($ya+$yperp),
154: $xb-$xperp,$height-($yb+$yperp),
155: gdAntiAliased);
156: }
157: }
158:
159: # Write labels
160:
161: %valence = ("C",4,"N",3,"P",3,"O",2,"S",2);
162:
163: $font = '/usr/share/fonts/default/Type1/n021003l.pfb';
164: $pointsize = 20;
165: @bounds = GD::Image->stringTTF($black,$font,100,0,0,0,"H");
166: $ptsize = 100*0.662*$pointsize*(2.54/72)*$scale/(@bounds[3]-@bounds[5]);
167:
168: for ($i = 0; $i < $natoms; $i++) {
169: my ($formula,$sign,$charge) =
170: (@name[$i] =~ /(\w+)([\+|\-])?(\d)?/);
171: $sign = "–" if ($sign eq "-"); # replace by n-dash
172:
173: if ($formula ne "C" || $sign ne ""||
174: @adjacent[$i] < 2 || (@adjacent[$i] == 2 && @bonds[$i] == 4)) {
175: # don't show C, unless charged, terminal, or linear
176: $nH = 0;
177: if (exists $valence{$formula}) {
178: $nH = $valence{$formula} - @bonds[$i];
179: $nH += (($charge eq "")? 1 : $charge) if ($sign eq "+");
180: $nH -= (($charge eq "")? 1 : $charge) if ($sign eq "-");
181: }
182: $formula .= "H" if ($nH > 0);
183: $formula .= $nH if ($nH > 1);
184: @formula = $formula=~ /[A-Z][a-z]?\d*/g;
185:
186: $PI = 3.1415;
187: if (abs(@bondsy[$i]) < 0.01 && abs(@bondsx[$i]) < 0.01) {
188: $bondAngle = -$PI;
189: }
190: else {
191: $bondAngle = atan2(@bondsy[$i],@bondsx[$i]);
192: }
193:
194: if (@adjacent[$i] < 2) {
195: $direction = (@bondsx[$i] < 0.01) ? "r" : "l";
196: }
197: else {
198: if ($bondAngle >= -$PI/4 && $bondAngle <= $PI/4) {
199: $direction = "l";
200: }
201: elsif ($bondAngle > $PI/4 && $bondAngle < 3*$PI/4) {
202: $direction = "d";
203: }
204: elsif ($bondAngle < -$PI/4 && $bondAngle > -3*$PI/4) {
205: $direction = "u";
206: }
207: else {
208: $direction = "r";
209: }
210: }
211:
212: if ($direction eq "r") { # direction = right
213: @formula[0] =~ /([A-Z][a-z]?)(\d*)/;
214: $carrige = @x[$i]-stringWidth($1)/2;
215: foreach (@formula) {
216: $_ =~ /([A-Z][a-z]?)(\d*)/;
217: $carrige = printElement ($1,$2,$carrige,@y[$i]);
218: }
219: printCharge ($sign,$charge,$carrige,@y[$i]) if ($sign ne "");
220: }
221: elsif ($direction eq "l") { # direction = left, reverse hydrogens
222: @formula[0] =~ /([A-Z][a-z]?)(\d*)/;
223: $carrige = @x[$i]+
224: stringWidth($1)/2+stringWidth($2)-stringWidth($formula);
225: foreach (reverse @formula) {
226: $_ =~ /([A-Z][a-z]?)(\d*)/;
227: $carrige = printElement ($1,$2,$carrige,@y[$i]);
228: }
229: printCharge ($sign,$charge,$carrige,@y[$i]) if ($sign ne "");
230: }
231: elsif ($direction eq "u") { # direction = up
232: (shift @formula) =~ /([A-Z][a-z]?)(\d*)/;
233: $carrige = @x[$i]-stringWidth($1)/2;
234: $carrige = printElement ($1,$2,$carrige,@y[$i]);
235: $y = (@formula > 0) ? @y[$i] + fm2cm(800) : @y[$i];
236: $carrige =
237: (@formula > 0) ? @x[$i]-stringWidth($1)/2 : $carrige;
238: foreach (@formula) {
239: $_ =~ /([A-Z][a-z]?)(\d*)/;
240: $carrige = printElement ($1,$2,$carrige,$y);
241: }
242: printCharge ($sign,$charge,$carrige,$y) if ($sign ne "");
243: }
244: else { # direction = down
245: (shift @formula) =~ /([A-Z][a-z]?)(\d*)/;
246: $carrige = @x[$i]-stringWidth($1)/2;
247: $carrige = printElement ($1,$2,$carrige,@y[$i]);
248: $y = (@formula > 0) ? @y[$i] + fm2cm(-800) : @y[$i];
249: $carrige =
250: (@formula > 0) ? @x[$i]-stringWidth($1)/2 : $carrige;
251: foreach (@formula) {
252: $_ =~ /([A-Z][a-z]?)(\d*)/;
253: $carrige = printElement ($1,$2,$carrige,$y);
254: }
255: printCharge ($sign,$charge,$carrige,$y) if ($sign ne "");
256: }
257: }
258:
259: }
260:
261: # make sure we are writing to a binary stream
262: binmode STDOUT;
263:
264: # Convert the image to PNG and print it on standard output
265: print "Content-type: image/png\n\n";
266: print $im->png;
267: sub stringWidth {
268: my ($string) = @_;
269: my $width = 0;
270: while ($string =~ /[A-Za-z]/g) {
271: my @bounds = GD::Image->stringTTF($black,$font,$ptsize,0,0,0,$&);
272: $width += @bounds[2]-@bounds[0]+2;
273: }
274: while ($string =~ /[\d+-]/g) {
275: my @bounds = GD::Image->stringTTF($black,$font,0.6*$ptsize,0,0,0,$&);
276: $width += @bounds[2]-@bounds[0]+2;
277: }
278:
279: return $width;
280: }
281:
282: sub fm2cm { #font metrics to cm
283: my ($fm) = @_;
284: return $scale*(2.54/72)*$pointsize*$fm/1000;
285: }
286:
287: sub printElement { #element symbol + optional subscript
288: my ($element,$subscript,$x,$y) = @_;
289: $yy = 662;
290:
291: my @bounds = GD::Image->stringTTF($black,$font,$ptsize,0,
292: $x,$height-($y+fm2cm(-$yy/2)),$element);
293: $im->filledRectangle(
294: @bounds[6]-1,@bounds[7]-fm2cm(135),
295: @bounds[2]+1,@bounds[3]+fm2cm(135),$white);
296:
297: $im->stringTTF($black,$font,$ptsize,0,
298: $x,$height-($y+fm2cm(-$yy/2)),$element);
299: $x = @bounds[2] + 1;
300:
301: if ($subscript ne "") {
302: @bounds = GD::Image->stringTTF($black,$font,0.6*$ptsize,0,
303: $x,$height-($y+fm2cm(-0.8*$yy)),$subscript);
304: $im->filledRectangle(
305: @bounds[6]-1,@bounds[7]-fm2cm(45),
306: @bounds[2]+1,@bounds[3]+fm2cm(45),$white);
307: $im->stringTTF($black,$font,0.6*$ptsize,0,
308: $x,$height-($y+fm2cm(-0.8*$yy)),$subscript);
309: }
310: $x = @bounds[2] + 1;
311: }
312:
313: sub printCharge {
314: my ($sign,$charge,$x,$y) = @_;
315: $yy = 662;
316:
317: $charge = "" if ($charge == 1);
318: $charge .= $sign;
319:
320: my @bounds = GD::Image->stringTTF($black,$font,0.6*$ptsize,0,
321: $x,$height-($y+fm2cm(0.2*$yy)),$charge);
322: $im->filledRectangle(
323: @bounds[6]-1,@bounds[7]-fm2cm(45),
324: @bounds[2]+1,@bounds[3]+fm2cm(45),$white);
325:
326: $im->stringTTF($black,$font,0.6*$ptsize,0,$x,$height-($y+fm2cm(0.2*$yy)),$charge);
327: $x = @bounds[2] + 1;
328: }
329:
330: sub dienice {
331: my($errmsg) = @_;
332: print "Content-type: text/html\n\n";
333: print "<h2>Error</h2>\n";
334: print "$errmsg<p>\n";
335: print "</body></html>\n";
336: system("/bin/rm temp/$SNUM.*");
337: exit;
338: }
339:
340: sub read_input
341: {
342: local ($buffer, @pairs, $pair, $name, $value, %FORM);
343: # Read in text
344: $ENV{'REQUEST_METHOD'} =~ tr/a-z/A-Z/;
345: if ($ENV{'REQUEST_METHOD'} eq "POST")
346: {
347: read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
348: } else
349: {
350: $buffer = $ENV{'QUERY_STRING'};
351: }
352: # Split information into name/value pairs
353: @pairs = split(/&/, $buffer);
354: foreach $pair (@pairs)
355: {
356: ($name, $value) = split(/=/, $pair);
357: $value =~ tr/+/ /;
358: $value =~ s/%(..)/pack("C", hex($1))/eg;
359: $FORM{$name} = $value;
360: }
361: %FORM;
362: }
363:
364: #while (($key,$value) = each %ENV) {
365: # print "$key = $value<br>\n";
366: #}
367: #open(STDERR,">errorlog");
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to convertjme.pl CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / homework