1: #!/usr/bin/perl
2: # The LearningOnline Network with CAPA
3: # Dynamically converts JME strings into either a png or ps file.
4: #
5: # $Id: convertjme.pl,v 1.4 2003/10/17 22:24:51 albertel Exp $
6: #
7: # Copyright Michigan State University Board of Trustees
8: #
9: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
10: #
11: # LON-CAPA is free software; you can redistribute it and/or modify
12: # it under the terms of the GNU General Public License as published by
13: # the Free Software Foundation; either version 2 of the License, or
14: # (at your option) any later version.
15: #
16: # LON-CAPA is distributed in the hope that it will be useful,
17: # but WITHOUT ANY WARRANTY; without even the implied warranty of
18: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19: # GNU General Public License for more details.
20: #
21: # You should have received a copy of the GNU General Public License
22: # along with LON-CAPA; if not, write to the Free Software
23: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
24: #
25: # /home/httpd/html/adm/gpl.txt
26: #
27: # http://www.lon-capa.org/
28: # Coded by Guy Ashkenazi, guy@fh.huji.ac.il
29: # Based on the work of Peter Ertl, peter.ertl@pharma.novartis.com
30:
31:
32:
33: use strict;
34: use lib '/home/httpd/lib/perl';
35: use GD;
36: use PostScript::Simple;
37: use LONCAPA::loncgi();
38:
39: if (! &LONCAPA::loncgi::check_cookie_and_load_env()) {
40: print <<END;
41: Content-type: text/html
42:
43: <html>
44: <head><title>Bad Cookie</title></head>
45: <body>
46: Your cookie information is incorrect.
47: </body>
48: </html>
49: END
50: exit;
51: }
52:
53: sub unescape {
54: my $str=shift;
55: $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
56: return $str;
57: }
58:
59: # read the width and the JME string from the cgi query
60: my $id=$ENV{'QUERY_STRING'};
61: my @JMEstring = split(/ /,&unescape($ENV{'cgi.'.$id.'.JME'}));
62: my $width = $ENV{'cgi.'.$id.'.WIDTH'};
63: my $png = $ENV{'cgi.'.$id.'.PNG'};
64: my $ps = $ENV{'cgi.'.$id.'.PS'};
65: if (!$width) { $width = 200; }
66:
67: # parse JME string
68:
69: my $natoms= shift @JMEstring;
70: my $nbonds= shift @JMEstring;
71: my (@name,@x,@y);
72: for (my $i = 0; $i < $natoms; $i++) {
73: @name[$i] = shift @JMEstring;
74: @x[$i] = shift @JMEstring;
75: @y[$i] = shift @JMEstring;
76: }
77:
78: my (@atomA,@atomB,@bondType);
79: for (my $i = 0; $i < $nbonds; $i++) {
80: @atomA[$i] = (shift @JMEstring)-1;
81: @atomB[$i] = (shift @JMEstring)-1;
82: @bondType[$i] = shift @JMEstring;
83: }
84:
85: # Find border and move lower left corner to (1.5,1.0)
86:
87: my $xmin = my $xmax = @x[0];
88: my $ymin = my $ymax = $y[0];
89: my $maxName = 0;
90:
91: for (my $i = 1; $i < $natoms; $i++) {
92: $xmax = @x[$i] if (@x[$i] > $xmax);
93: $xmin = @x[$i] if (@x[$i] < $xmin);
94: $ymax = @y[$i] if (@y[$i] > $ymax);
95: $ymin = @y[$i] if (@y[$i] < $ymin);
96: @name[$i] =~ /(\@{1,2})?(\w+)([\+|\-])?(\d)?/;
97: $maxName = length $2 if (length $2 > $maxName);
98: }
99: $maxName = ($maxName-3 < 0) ? 0 : $maxName-3;
100: my $scale = $width / ($xmax-$xmin+3+$maxName);
101: my $height = $scale * ($ymax-$ymin+2);
102:
103: for (my $i = 0; $i < $natoms; $i++) {
104: @x[$i] += (1.5+$maxName/2-$xmin);
105: if ($png) { @x[$i] *= $scale; }
106: @y[$i] += (1.0-$ymin);
107: if ($png) { @y[$i] *= $scale; }
108: }
109:
110: # Count bonds
111:
112: my @bonds = map {0} 0..$natoms-1;
113: my @adjacent = map {0} 0..$natoms-1;
114: my @bondsx = map {0} 0..$natoms-1;
115: my @bondsy = map {0} 0..$natoms-1;
116: for (my $i = 0; $i < $nbonds; $i++) {
117: @bonds[@atomA[$i]] += (@bondType[$i]>0) ? @bondType[$i] : 1;
118: @bonds[@atomB[$i]] += (@bondType[$i]>0) ? @bondType[$i] : 1;
119:
120: @adjacent[@atomA[$i]]++;
121: @adjacent[@atomB[$i]]++;
122:
123: @bondsx[@atomA[$i]] += @x[@atomB[$i]] - @x[@atomA[$i]];
124: @bondsy[@atomA[$i]] += @y[@atomB[$i]] - @y[@atomA[$i]];
125: @bondsx[@atomB[$i]] += @x[@atomA[$i]] - @x[@atomB[$i]];
126: @bondsy[@atomB[$i]] += @y[@atomA[$i]] - @y[@atomB[$i]];
127: }
128:
129: # Create a new PostScript object
130: my ($im,$white,$black,$gray);
131: if ($png) {
132: $im = new GD::Image($width,$height);
133: $white = $im->colorAllocate(255,255,255);
134: $black = $im->colorAllocate(0,0,0);
135: $gray = $im->colorAllocate(200,200,200);
136: #$gdAntiAliased = $im->colorAllocate(1,1,1);
137: $im->setAntiAliased($black);
138: } elsif ($ps) {
139: $im = new PostScript::Simple(xsize => $xmax-$xmin+3+$maxName,
140: ysize => $ymax-$ymin+2,
141: clip => 1,
142: eps => 1,
143: color => 0,
144: units => "cm");
145: }
146:
147: # Draw bonds
148: my $doubleWidth;
149: my $tripleWidth;
150: if ($png) {
151: $doubleWidth = 0.10*$scale;
152: $tripleWidth = 0.15*$scale;
153: } elsif ($ps) {
154: $doubleWidth = 0.10;
155: $tripleWidth = 0.15;
156: }
157:
158: for (my $i = 0; $i < $nbonds; $i++) {
159: my $xa = @x[@atomA[$i]];
160: my $ya = @y[@atomA[$i]];
161: my $xb = @x[@atomB[$i]];
162: my $yb = @y[@atomB[$i]];
163:
164: my ($sina,$cosa,$dx,$dy);
165: if (@bondType[$i] != 1) {
166: $dx = $xb-$xa;
167: $dy = $yb-$ya;
168: my $dd = sqrt($dx*$dx + $dy*$dy);
169: $sina=$dy/$dd;
170: $cosa=$dx/$dd;
171: }
172: if (@bondType[$i] == -2) {
173: for (my $t = 0; $t <= 1; $t += 0.1) {
174: my $xab = $xa + $t*$dx;
175: my $yab = $ya + $t*$dy;
176: my $xperp = $tripleWidth*$sina*$t;
177: my $yperp = $tripleWidth*$cosa*$t;
178: if ($png) {
179: $im->line($xab+$xperp,$height-($yab-$yperp),
180: $xab-$xperp,$height-($yab+$yperp),
181: gdAntiAliased);
182: } elsif ($ps) {
183: $im->line($xab+$xperp,$yab-$yperp,$xab-$xperp,$yab+$yperp);
184: }
185: }
186: }
187: elsif (@bondType[$i] == -1) {
188: my $xperp = $tripleWidth*$sina;
189: my $yperp = $tripleWidth*$cosa;
190: if ($png) {
191: my $poly = new GD::Polygon;
192: $poly->addPt($xa,$height-$ya);
193: $poly->addPt($xb+$xperp,$height-($yb-$yperp));
194: $poly->addPt($xb-$xperp,$height-($yb+$yperp));
195: $im->filledPolygon($poly,$black);
196: } elsif ($ps) {
197: $im->polygon({filled=>1},
198: $xa,$ya,
199: $xb+$xperp,$yb-$yperp,
200: $xb-$xperp,$yb+$yperp);
201: }
202: }
203: elsif (@bondType[$i] == 1) {
204: if ($png) {
205: $im->line($xa,$height-$ya,$xb,$height-$yb,gdAntiAliased);
206: } elsif ($ps) {
207: $im->line($xa,$ya,$xb,$yb);
208: }
209: }
210: elsif (@bondType[$i] == 2 &&
211: ((@adjacent[@atomA[$i]] == 1 && @adjacent[@atomB[$i]] > 2)||
212: (@adjacent[@atomB[$i]] == 1 && @adjacent[@atomA[$i]] > 2))) {
213: # centered bond
214: my $xperp = $doubleWidth*$sina;
215: my $yperp = $doubleWidth*$cosa;
216: if ($png) {
217: $im->line($xa+$xperp,$height-($ya-$yperp),
218: $xb+$xperp,$height-($yb-$yperp),
219: gdAntiAliased);
220: $im->line($xa-$xperp,$height-($ya+$yperp),
221: $xb-$xperp,$height-($yb+$yperp),
222: gdAntiAliased);
223: } elsif ($ps) {
224: $im->line($xa+$xperp,$ya-$yperp,$xb+$xperp,$yb-$yperp);
225: $im->line($xa-$xperp,$ya+$yperp,$xb-$xperp,$yb+$yperp);
226: }
227: }
228: elsif (@bondType[$i] == 2) {
229: my $xperp = 2*$doubleWidth*$sina;
230: my $yperp = 2*$doubleWidth*$cosa;
231: if ($png) {
232: $im->line($xa,$height-$ya,$xb,$height-$yb,gdAntiAliased);
233: $im->line($xa+0.1*$dx-$xperp,$height-($ya+0.1*$dy+$yperp),
234: $xb-0.1*$dx-$xperp,$height-($yb-0.1*$dy+$yperp),
235: gdAntiAliased);
236: } elsif ($ps) {
237: $im->line($xa,$ya,$xb,$yb);
238: $im->line($xa+0.1*$dx-$xperp,$ya+0.1*$dy+$yperp,
239: $xb-0.1*$dx-$xperp,$yb-0.1*$dy+$yperp);
240:
241: }
242: }
243: elsif (@bondType[$i] == 3) {
244: my $xperp = $tripleWidth*$sina;
245: my $yperp = $tripleWidth*$cosa;
246: if ($png) {
247: $im->line($xa,$height-$ya,$xb,$height-$yb,gdAntiAliased);
248: $im->line($xa+$xperp,$height-($ya-$yperp),
249: $xb+$xperp,$height-($yb-$yperp),
250: gdAntiAliased);
251: $im->line($xa-$xperp,$height-($ya+$yperp),
252: $xb-$xperp,$height-($yb+$yperp),
253: gdAntiAliased);
254: } elsif ($ps) {
255: $im->line($xa,$ya,$xb,$yb);
256: $im->line($xa+$xperp,$ya-$yperp,$xb+$xperp,$yb-$yperp);
257: $im->line($xa-$xperp,$ya+$yperp,$xb-$xperp,$yb+$yperp);
258: }
259: }
260: }
261:
262: # Write labels
263:
264: my %valence = ("C",4,"N",3,"P",3,"O",2,"S",2);
265: my %font_width = (" ",250,"+",564,"-",500,"0",500,"1",500,"2",500,"3",500,"4",500,"5",500,"6",500,"7",500,"8",500,"9",500,"A",722,"B",667,"C",667,"D",722,"E",611,"F",556,"G",722,"H",722,"I",333,"J",389,"K",722,"L",611,"M",889,"N",722,"O",722,"P",556,"Q",722,"R",667,"S",556,"T",611,"U",722,"V",722,"W",944,"X",722,"Y",722,"Z",611,"a",444,"b",500,"c",444,"d",500,"e",444,"f",333,"g",500,"h",500,"i",278,"j",278,"k",500,"l",278,"m",778,"n",500,"o",500,"p",500,"q",500,"r",333,"s",389,"t",278,"u",500,"v",500,"w",722,"x",500,"y",500,"z",444);
266: my $font = '/usr/share/fonts/default/Type1/n021003l.pfb';
267: my $pointsize = 20;
268: my ($ptsize,@bounds);
269: if ($png) {
270: @bounds = GD::Image->stringTTF($black,$font,100,0,0,0,"H");
271: $ptsize = 100*0.662*$pointsize*(2.54/72)*$scale/(@bounds[3]-@bounds[5]);
272: }
273:
274: for (my $i = 0; $i < $natoms; $i++) {
275: my ($formula,$sign,$charge) =
276: (@name[$i] =~ /(\w+)([\+|\-])?(\d)?/);
277: if ($png) {
278: $sign = "–" if ($sign eq "-"); # replace by n-dash
279: }
280: if ($formula ne "C" || $sign ne ""||
281: @adjacent[$i] < 2 || (@adjacent[$i] == 2 && @bonds[$i] == 4)) {
282: # don't show C, unless charged, terminal, or linear
283: my $nH = 0;
284: if (exists $valence{$formula}) {
285: $nH = $valence{$formula} - @bonds[$i];
286: $nH += (($charge eq "")? 1 : $charge) if ($sign eq "+");
287: $nH -= (($charge eq "")? 1 : $charge) if ($sign eq "-");
288: }
289: $formula .= "H" if ($nH > 0);
290: $formula .= $nH if ($nH > 1);
291: my @formula = $formula=~ /[A-Z][a-z]?\d*/g;
292:
293: my $PI = 3.1415;
294: my $bondAngle;
295: if (abs(@bondsy[$i]) < 0.01 && abs(@bondsx[$i]) < 0.01) {
296: $bondAngle = -$PI;
297: }
298: else {
299: $bondAngle = atan2(@bondsy[$i],@bondsx[$i]);
300: }
301:
302: my $direction;
303: if (@adjacent[$i] < 2) {
304: $direction = (@bondsx[$i] < 0.01) ? "r" : "l";
305: }
306: else {
307: if ($bondAngle >= -$PI/4 && $bondAngle <= $PI/4) {
308: $direction = "l";
309: }
310: elsif ($bondAngle > $PI/4 && $bondAngle < 3*$PI/4) {
311: $direction = "d";
312: }
313: elsif ($bondAngle < -$PI/4 && $bondAngle > -3*$PI/4) {
314: $direction = "u";
315: }
316: else {
317: $direction = "r";
318: }
319: }
320:
321: if ($direction eq "r") { # direction = right
322: @formula[0] =~ /([A-Z][a-z]?)(\d*)/;
323: my $carrige = @x[$i]-stringWidth($1)/2;
324: foreach (@formula) {
325: $_ =~ /([A-Z][a-z]?)(\d*)/;
326: $carrige = printElement ($1,$2,$carrige,@y[$i]);
327: }
328: printCharge ($sign,$charge,$carrige,@y[$i]) if ($sign ne "");
329: }
330: elsif ($direction eq "l") { # direction = left, reverse hydrogens
331: @formula[0] =~ /([A-Z][a-z]?)(\d*)/;
332: my $carrige = @x[$i]+
333: stringWidth($1)/2+stringWidth($2)-stringWidth($formula);
334: foreach (reverse @formula) {
335: $_ =~ /([A-Z][a-z]?)(\d*)/;
336: $carrige = printElement ($1,$2,$carrige,@y[$i]);
337: }
338: printCharge ($sign,$charge,$carrige,@y[$i]) if ($sign ne "");
339: }
340: elsif ($direction eq "u") { # direction = up
341: (shift @formula) =~ /([A-Z][a-z]?)(\d*)/;
342: my $carrige = @x[$i]-stringWidth($1)/2;
343: $carrige = printElement ($1,$2,$carrige,@y[$i]);
344: my $y = (@formula > 0) ? @y[$i] + fm2cm(800) : @y[$i];
345: $carrige =
346: (@formula > 0) ? @x[$i]-stringWidth($1)/2 : $carrige;
347: foreach (@formula) {
348: $_ =~ /([A-Z][a-z]?)(\d*)/;
349: $carrige = printElement ($1,$2,$carrige,$y);
350: }
351: printCharge ($sign,$charge,$carrige,$y) if ($sign ne "");
352: }
353: else { # direction = down
354: (shift @formula) =~ /([A-Z][a-z]?)(\d*)/;
355: my $carrige = @x[$i]-stringWidth($1)/2;
356: $carrige = printElement ($1,$2,$carrige,@y[$i]);
357: my $y = (@formula > 0) ? @y[$i] + fm2cm(-800) : @y[$i];
358: $carrige =
359: (@formula > 0) ? @x[$i]-stringWidth($1)/2 : $carrige;
360: foreach (@formula) {
361: $_ =~ /([A-Z][a-z]?)(\d*)/;
362: $carrige = printElement ($1,$2,$carrige,$y);
363: }
364: printCharge ($sign,$charge,$carrige,$y) if ($sign ne "");
365: }
366: }
367: }
368:
369: if ($png) {
370: # make sure we are writing to a binary stream
371: binmode STDOUT;
372:
373: # Convert the image to PNG and print it on standard output
374: print "Content-type: image/png\n\n";
375: print $im->png;
376: } elsif ($ps) {
377: my $psfile = "/home/httpd/perl/tmp/".$id.'.eps';
378: $im->output($psfile);
379: print "Content-type: text/html\n\n";
380: print (<<HTML)
381: <html>
382: <body>
383: Wrote eps file $psfile
384: </body>
385: </html>
386: HTML
387: }
388:
389: sub stringWidth {
390: my ($string) = @_;
391: my $width = 0;
392: while ($string =~ /[A-Za-z]/g) {
393: if ($png) {
394: my @bounds = GD::Image->stringTTF($black,$font,$ptsize,0,0,0,$&);
395: $width += @bounds[2]-@bounds[0]+2;
396: } elsif ($ps) {
397: $width += $font_width{$&};
398: }
399: }
400: while ($string =~ /[\d+-]/g) {
401: if ($png) {
402: my @bounds=GD::Image->stringTTF($black,$font,0.6*$ptsize,0,0,0,$&);
403: $width += @bounds[2]-@bounds[0]+2;
404: } elsif ($ps) {
405: $width += 0.6*$font_width{$&};
406: }
407: }
408:
409: return $width;
410: }
411:
412: sub fm2cm { #font metrics to cm
413: my ($fm) = @_;
414: if ($png) {
415: return $scale*(2.54/72)*$pointsize*$fm/1000;
416: } elsif ($ps) {
417: return (2.54/72)*$pointsize*$fm/1000;
418: }
419: }
420:
421: sub printElement {
422: if ($png) {
423: return &printElement_png(@_);
424: } elsif ($ps) {
425: return &printElement_ps(@_);
426: }
427: }
428:
429: sub printElement_png { #element symbol + optional subscript
430: my ($element,$subscript,$x,$y) = @_;
431: my $yy = 662;
432:
433: my @bounds = GD::Image->stringTTF($black,$font,$ptsize,0,
434: $x,$height-($y+fm2cm(-$yy/2)),$element);
435: $im->filledRectangle(
436: @bounds[6]-1,@bounds[7]-fm2cm(135),
437: @bounds[2]+1,@bounds[3]+fm2cm(135),$white);
438:
439: $im->stringTTF($black,$font,$ptsize,0,
440: $x,$height-($y+fm2cm(-$yy/2)),$element);
441: $x = @bounds[2] + 1;
442:
443: if ($subscript ne "") {
444: @bounds = GD::Image->stringTTF($black,$font,0.6*$ptsize,0,
445: $x,$height-($y+fm2cm(-0.8*$yy)),$subscript);
446: $im->filledRectangle(
447: @bounds[6]-1,@bounds[7]-fm2cm(45),
448: @bounds[2]+1,@bounds[3]+fm2cm(45),$white);
449: $im->stringTTF($black,$font,0.6*$ptsize,0,
450: $x,$height-($y+fm2cm(-0.8*$yy)),$subscript);
451: }
452: $x = @bounds[2] + 1;
453: }
454:
455: sub printElement_ps { #element symbol + optional subscript
456: my ($element,$subscript,$x,$y) = @_;
457: $height = 662;
458:
459: $im->setcolour("white");
460: $im->box({filled=>1},
461: $x+fm2cm(-30),$y+fm2cm(-$height/2-150),
462: $x+fm2cm(stringWidth($element)+50),$y+fm2cm(+$height/2+150));
463: $im->setcolour("black");
464: $im->setfont("Times-Roman",$pointsize);
465: $im->text($x,$y+fm2cm(-$height/2),$element);
466: $x += fm2cm(stringWidth($element));
467:
468: if ($subscript ne "") {
469: $im->setcolour("white");
470: $im->box({filled=>1},
471: $x,$y+fm2cm(-0.8*$height-45),
472: $x+fm2cm(stringWidth($subscript)+50),$y+fm2cm(-0.2*$height+45));
473: $im->setcolour("black");
474: $im->setfont("Times-Roman",0.6*$pointsize);
475: $im->text($x,$y+fm2cm(-0.8*$height),$subscript);
476: }
477: $x += fm2cm(stringWidth($subscript));
478: }
479:
480: sub printCharge {
481: if ($png) {
482: return &printCharge_png(@_);
483: } elsif ($ps) {
484: return &printCharge_ps(@_);
485: }
486: }
487:
488: sub printCharge_png {
489: my ($sign,$charge,$x,$y) = @_;
490: my $yy = 662;
491:
492: $charge = "" if ($charge == 1);
493: $charge .= $sign;
494:
495: my @bounds = GD::Image->stringTTF($black,$font,0.6*$ptsize,0,
496: $x,$height-($y+fm2cm(0.2*$yy)),$charge);
497: $im->filledRectangle(
498: @bounds[6]-1,@bounds[7]-fm2cm(45),
499: @bounds[2]+1,@bounds[3]+fm2cm(45),$white);
500:
501: $im->stringTTF($black,$font,0.6*$ptsize,0,$x,$height-($y+fm2cm(0.2*$yy)),$charge);
502: $x = @bounds[2] + 1;
503: }
504:
505: sub printCharge_ps {
506: my ($sign,$charge,$x,$y) = @_;
507: $height = 662;
508:
509: $charge = "" if ($charge == 1);
510: $charge .= $sign;
511:
512: $im->setcolour("white");
513: $im->box({filled=>1},
514: $x,$y+fm2cm(0.2*$height-45),
515: $x+fm2cm(stringWidth($charge)+50),$y+fm2cm(0.8*$height+45));
516:
517: if ($sign eq "-") { # replace by n-dash
518: chop $charge;
519: $charge .= "\xb1";
520: }
521: $im->setcolour("black");
522: $im->setfont("Times-Roman",0.6*$pointsize);
523: $im->text($x,$y+fm2cm(0.2*$height),$charge);
524: $x += fm2cm(stringWidth($charge));
525: }
526:
527:
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