Annotation of loncom/homework/convertjme.pl, revision 1.8
1.1 albertel 1: #!/usr/bin/perl
1.4 albertel 2: # The LearningOnline Network with CAPA
3: # Dynamically converts JME strings into either a png or ps file.
4: #
1.8 ! albertel 5: # $Id: convertjme.pl,v 1.7 2003/10/20 16:14:08 albertel Exp $
1.4 albertel 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/
1.1 albertel 28: # Coded by Guy Ashkenazi, guy@fh.huji.ac.il
29: # Based on the work of Peter Ertl, peter.ertl@pharma.novartis.com
1.4 albertel 30:
1.8 ! albertel 31: use strict;
! 32:
! 33: ### FOR LON-CAPA set $loncapa to 1 and uncomment both uses
! 34: ### For standalone operation, set $loncapa to 0, and comment out both uses
! 35: my $loncapa=1;
! 36: use lib '/home/httpd/lib/perl';
! 37: use LONCAPA::loncgi();
1.4 albertel 38:
1.1 albertel 39:
40: use GD;
1.3 albertel 41: use PostScript::Simple;
1.2 albertel 42:
1.7 albertel 43: if ($loncapa) {
44: if (! &LONCAPA::loncgi::check_cookie_and_load_env()) {
45: print <<END;
1.2 albertel 46: Content-type: text/html
47:
48: <html>
49: <head><title>Bad Cookie</title></head>
50: <body>
51: Your cookie information is incorrect.
52: </body>
53: </html>
54: END
1.7 albertel 55: exit;
56: }
1.2 albertel 57: }
58:
59: sub unescape {
60: my $str=shift;
61: $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
62: return $str;
63: }
1.1 albertel 64:
65: # read the width and the JME string from the cgi query
1.7 albertel 66: my ($id,$width,$ps,$png,@JMEstring);
67: if ($loncapa) {
68: $id=$ENV{'QUERY_STRING'};
69: $width = $ENV{'cgi.'.$id.'.WIDTH'};
70: if (!$width) { $width = 400; }
71: $png = $ENV{'cgi.'.$id.'.PNG'};
72: $ps = $ENV{'cgi.'.$id.'.PS'};
73: @JMEstring=&unescape($ENV{'cgi.'.$id.'.JME'});
74: } else {
75: my @JMEstring = @ARGV;
76: $width = shift @JMEstring;
77: $png = 1;
78: $ps = 1;
79: }
1.1 albertel 80:
1.5 albertel 81: #get objects
1.7 albertel 82: my ($reactants,$modulators,$products)=split('>',$JMEstring[0]);
1.1 albertel 83:
1.5 albertel 84: my @reactant_structs=split(/\|/,$reactants);
1.7 albertel 85: my @modulator_structs=split(/\|/,$modulators);
1.5 albertel 86: my @product_structs=split(/\|/,$products);
1.1 albertel 87:
88:
1.7 albertel 89:
90: my @all_structs=(@reactant_structs,@modulator_structs,@product_structs);
1.1 albertel 91:
1.5 albertel 92: #get size of image and initialize image and globals
93: my ($xmin,$xmax,$ymin,$ymax,$maxName,$height,$scale) =
94: &determine_size(@all_structs);
1.1 albertel 95:
1.7 albertel 96: my $draw_arrow;
97: if (@modulator_structs || @product_structs) { $draw_arrow=1; }
98: my ($arrow_x1,$arrow_x2,$arrow_y) = (-1e20,1e20,0);
99: if ($draw_arrow) {
100: foreach my $struct (@reactant_structs) {
101: my @bounds = &determine_size($struct);
102: if ($arrow_x1 < $bounds[1]) {
103: $arrow_x1 = $bounds[1];
104: $arrow_y = ($bounds[2] + $bounds[3]) / 2;
105: }
106: }
107: foreach my $struct (@product_structs) {
108: my @bounds = &determine_size($struct);
109: $arrow_x2 = $bounds[0] if ($arrow_x2 > $bounds[0]);
110: }
111:
112: $arrow_x1 += (1.5+$maxName/2-$xmin);
113: $arrow_x1 *= $scale;
114: $arrow_x2 += (1.5+$maxName/2-$xmin);
115: $arrow_x2 *= $scale;
116: $arrow_y += (1.0-$ymin);
117: $arrow_y *= $scale;
118: }
1.1 albertel 119:
120: # Create a new PostScript object
1.3 albertel 121: my ($im,$white,$black,$gray);
1.7 albertel 122: my $gdAntiAliased;
1.3 albertel 123: if ($png) {
124: $im = new GD::Image($width,$height);
125: $white = $im->colorAllocate(255,255,255);
126: $black = $im->colorAllocate(0,0,0);
127: $gray = $im->colorAllocate(200,200,200);
1.7 albertel 128: $gdAntiAliased = $im->colorAllocate(1,1,1);
129: # $im->setAntiAliased($black);
1.3 albertel 130: } elsif ($ps) {
131: $im = new PostScript::Simple(xsize => $xmax-$xmin+3+$maxName,
132: ysize => $ymax-$ymin+2,
133: clip => 1,
134: eps => 1,
135: color => 0,
136: units => "cm");
137: }
1.1 albertel 138:
1.5 albertel 139: my %valence = ("C",4,"N",3,"P",3,"O",2,"S",2);
140: 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);
141: my $font = '/usr/share/fonts/default/Type1/n021003l.pfb';
142: my $pointsize = 20;
143: my ($ptsize,@bounds);
144: if ($png) {
145: @bounds = GD::Image->stringTTF($black,$font,100,0,0,0,"H");
146: $ptsize = 100*0.662*$pointsize*(2.54/72)*$scale/(@bounds[3]-@bounds[5]);
147: }
148:
149: #set bond sizes
1.3 albertel 150: my $doubleWidth;
151: my $tripleWidth;
1.7 albertel 152: $doubleWidth = 0.10*$scale;
153: $tripleWidth = 0.15*$scale;
154:
155: # Draw arrow
156:
157: if ($draw_arrow) {
158: my $dx = $arrow_x2 - $arrow_x1;
159: if ($png) {
160: $im->line($arrow_x1+0.25*$dx,$height-$arrow_y,
161: $arrow_x2-0.25*$dx,$height-$arrow_y,
162: $gdAntiAliased);
163: $im->line($arrow_x2-0.25*$dx,$height-$arrow_y,
164: $arrow_x2-0.25*$dx-fm2cm(500),$height-$arrow_y-fm2cm(300),
165: $gdAntiAliased);
166: $im->line($arrow_x2-0.25*$dx,$height-$arrow_y,
167: $arrow_x2-0.25*$dx-fm2cm(500),$height-$arrow_y+fm2cm(300),
168: $gdAntiAliased);
169:
170: } elsif ($ps) {
171: $im->line($arrow_x1+0.25*$dx,$arrow_y,
172: $arrow_x2-0.25*$dx,$arrow_y);
173: $im->line($arrow_x2-0.25*$dx,$arrow_y,
174: $arrow_x2-0.25*$dx-fm2cm(500),$arrow_y-fm2cm(250));
175: $im->line($arrow_x2-0.25*$dx,$arrow_y,
176: $arrow_x2-0.25*$dx-fm2cm(500),$arrow_y+fm2cm(250));
177: }
1.3 albertel 178: }
1.1 albertel 179:
1.5 albertel 180:
181: foreach my $struct (@all_structs) {
182:
183: my (@name,@x,@y,@atomA,@atomB,@bondType,$natoms,$nbonds);
184: &parse_struct($struct,\@name,\@x,\@y,\@atomA,\@atomB,\@bondType);
185: $natoms=scalar(@x);
186: $nbonds=scalar(@bondType);
187:
1.7 albertel 188: # Scale and move lower left corner to (1.5,1.0)
189:
1.5 albertel 190: for (my $i = 0; $i < $natoms; $i++) {
1.7 albertel 191: $x[$i] += (1.5+$maxName/2-$xmin);
192: $x[$i] *= $scale;
193: $y[$i] += (1.0-$ymin);
194: $y[$i] *= $scale;
1.5 albertel 195: }
1.7 albertel 196:
1.5 albertel 197: # Count bonds
198:
199: my @bonds = map {0} 0..$natoms-1;
200: my @adjacent = map {0} 0..$natoms-1;
201: my @bondsx = map {0} 0..$natoms-1;
202: my @bondsy = map {0} 0..$natoms-1;
203: for (my $i = 0; $i < $nbonds; $i++) {
1.7 albertel 204: $bonds[$atomA[$i]] += ($bondType[$i]>0) ? $bondType[$i] : 1;
205: $bonds[$atomB[$i]] += ($bondType[$i]>0) ? $bondType[$i] : 1;
1.5 albertel 206:
1.7 albertel 207: $adjacent[$atomA[$i]]++;
208: $adjacent[$atomB[$i]]++;
1.5 albertel 209:
1.7 albertel 210: $bondsx[$atomA[$i]] += $x[$atomB[$i]] - $x[$atomA[$i]];
211: $bondsy[$atomA[$i]] += $y[$atomB[$i]] - $y[$atomA[$i]];
212: $bondsx[$atomB[$i]] += $x[$atomA[$i]] - $x[$atomB[$i]];
213: $bondsy[$atomB[$i]] += $y[$atomA[$i]] - $y[$atomB[$i]];
1.5 albertel 214: }
215:
216: # Draw bonds
217: for (my $i = 0; $i < $nbonds; $i++) {
1.7 albertel 218: my $xa = $x[$atomA[$i]];
219: my $ya = $y[$atomA[$i]];
220: my $xb = $x[$atomB[$i]];
221: my $yb = $y[$atomB[$i]];
1.5 albertel 222:
223: my ($sina,$cosa,$dx,$dy);
1.7 albertel 224: if ($bondType[$i] != 1) {
1.5 albertel 225: $dx = $xb-$xa;
226: $dy = $yb-$ya;
227: my $dd = sqrt($dx*$dx + $dy*$dy);
228: $sina=$dy/$dd;
229: $cosa=$dx/$dd;
230: }
1.7 albertel 231: if ($bondType[$i] == -2) {
1.5 albertel 232: for (my $t = 0; $t <= 1; $t += 0.1) {
233: my $xab = $xa + $t*$dx;
234: my $yab = $ya + $t*$dy;
235: my $xperp = $tripleWidth*$sina*$t;
236: my $yperp = $tripleWidth*$cosa*$t;
237: if ($png) {
238: $im->line($xab+$xperp,$height-($yab-$yperp),
239: $xab-$xperp,$height-($yab+$yperp),
1.7 albertel 240: $gdAntiAliased);
1.5 albertel 241: } elsif ($ps) {
242: $im->line($xab+$xperp,$yab-$yperp,$xab-$xperp,$yab+$yperp);
243: }
244: }
245: }
1.7 albertel 246: elsif ($bondType[$i] == -1) {
1.5 albertel 247: my $xperp = $tripleWidth*$sina;
248: my $yperp = $tripleWidth*$cosa;
1.3 albertel 249: if ($png) {
1.5 albertel 250: my $poly = new GD::Polygon;
251: $poly->addPt($xa,$height-$ya);
252: $poly->addPt($xb+$xperp,$height-($yb-$yperp));
253: $poly->addPt($xb-$xperp,$height-($yb+$yperp));
254: $im->filledPolygon($poly,$black);
1.3 albertel 255: } elsif ($ps) {
1.5 albertel 256: $im->polygon({filled=>1},
257: $xa,$ya,
258: $xb+$xperp,$yb-$yperp,
259: $xb-$xperp,$yb+$yperp);
1.3 albertel 260: }
1.1 albertel 261: }
1.7 albertel 262: elsif ($bondType[$i] == 1) {
1.5 albertel 263: if ($png) {
1.7 albertel 264: $im->line($xa,$height-$ya,$xb,$height-$yb,$gdAntiAliased);
1.5 albertel 265: } elsif ($ps) {
266: $im->line($xa,$ya,$xb,$yb);
267: }
1.3 albertel 268: }
1.7 albertel 269: elsif ($bondType[$i] == 2 &&
270: (($adjacent[$atomA[$i]] == 1 && $adjacent[$atomB[$i]] > 2)||
271: ($adjacent[$atomB[$i]] == 1 && $adjacent[$atomA[$i]] > 2))) {
1.5 albertel 272: # centered bond
273: my $xperp = $doubleWidth*$sina;
274: my $yperp = $doubleWidth*$cosa;
275: if ($png) {
276: $im->line($xa+$xperp,$height-($ya-$yperp),
277: $xb+$xperp,$height-($yb-$yperp),
1.7 albertel 278: $gdAntiAliased);
1.5 albertel 279: $im->line($xa-$xperp,$height-($ya+$yperp),
280: $xb-$xperp,$height-($yb+$yperp),
1.7 albertel 281: $gdAntiAliased);
1.5 albertel 282: } elsif ($ps) {
283: $im->line($xa+$xperp,$ya-$yperp,$xb+$xperp,$yb-$yperp);
284: $im->line($xa-$xperp,$ya+$yperp,$xb-$xperp,$yb+$yperp);
285: }
1.3 albertel 286: }
1.7 albertel 287: elsif ($bondType[$i] == 2) {
1.5 albertel 288: my $xperp = 2*$doubleWidth*$sina;
289: my $yperp = 2*$doubleWidth*$cosa;
290: if ($png) {
1.7 albertel 291: $im->line($xa,$height-$ya,$xb,$height-$yb,$gdAntiAliased);
1.5 albertel 292: $im->line($xa+0.1*$dx-$xperp,$height-($ya+0.1*$dy+$yperp),
293: $xb-0.1*$dx-$xperp,$height-($yb-0.1*$dy+$yperp),
1.7 albertel 294: $gdAntiAliased);
1.5 albertel 295: } elsif ($ps) {
296: $im->line($xa,$ya,$xb,$yb);
297: $im->line($xa+0.1*$dx-$xperp,$ya+0.1*$dy+$yperp,
298: $xb-0.1*$dx-$xperp,$yb-0.1*$dy+$yperp);
299: }
1.3 albertel 300: }
1.7 albertel 301: elsif ($bondType[$i] == 3) {
1.5 albertel 302: my $xperp = $tripleWidth*$sina;
303: my $yperp = $tripleWidth*$cosa;
304: if ($png) {
1.7 albertel 305: $im->line($xa,$height-$ya,$xb,$height-$yb,$gdAntiAliased);
1.5 albertel 306: $im->line($xa+$xperp,$height-($ya-$yperp),
307: $xb+$xperp,$height-($yb-$yperp),
1.7 albertel 308: $gdAntiAliased);
1.5 albertel 309: $im->line($xa-$xperp,$height-($ya+$yperp),
310: $xb-$xperp,$height-($yb+$yperp),
1.7 albertel 311: $gdAntiAliased);
1.5 albertel 312: } elsif ($ps) {
313: $im->line($xa,$ya,$xb,$yb);
314: $im->line($xa+$xperp,$ya-$yperp,$xb+$xperp,$yb-$yperp);
315: $im->line($xa-$xperp,$ya+$yperp,$xb-$xperp,$yb+$yperp);
316: }
317: }
1.1 albertel 318: }
1.3 albertel 319:
1.5 albertel 320: # Write labels
321:
322: for (my $i = 0; $i < $natoms; $i++) {
323: my ($formula,$sign,$charge) =
1.7 albertel 324: ($name[$i] =~ /(\w+)([\+|\-])?(\d)?/);
1.3 albertel 325: if ($png) {
1.5 albertel 326: $sign = "–" if ($sign eq "-"); # replace by n-dash
1.3 albertel 327: }
1.5 albertel 328: if ($formula ne "C" || $sign ne ""||
1.7 albertel 329: $adjacent[$i] < 2 || ($adjacent[$i] == 2 && $bonds[$i] == 4)) {
1.5 albertel 330: # don't show C, unless charged, terminal, or linear
331: my $nH = 0;
332: if (exists $valence{$formula}) {
1.7 albertel 333: $nH = $valence{$formula} - $bonds[$i];
1.5 albertel 334: $nH += (($charge eq "")? 1 : $charge) if ($sign eq "+");
335: $nH -= (($charge eq "")? 1 : $charge) if ($sign eq "-");
336: }
337: $formula .= "H" if ($nH > 0);
338: $formula .= $nH if ($nH > 1);
339: my @formula = $formula=~ /[A-Z][a-z]?\d*/g;
340:
341: my $PI = 3.1415;
342: my $bondAngle;
1.7 albertel 343: if (abs($bondsy[$i]) < 0.01 && abs($bondsx[$i]) < 0.01) {
1.5 albertel 344: $bondAngle = -$PI;
1.1 albertel 345: }
1.5 albertel 346: else {
1.7 albertel 347: $bondAngle = atan2($bondsy[$i],$bondsx[$i]);
1.1 albertel 348: }
1.5 albertel 349:
350: my $direction;
1.7 albertel 351: if ($adjacent[$i] < 2) {
352: $direction = ($bondsx[$i] < 0.01) ? "r" : "l";
1.1 albertel 353: }
354: else {
1.5 albertel 355: if ($bondAngle >= -$PI/4 && $bondAngle <= $PI/4) {
356: $direction = "l";
357: }
358: elsif ($bondAngle > $PI/4 && $bondAngle < 3*$PI/4) {
359: $direction = "d";
360: }
361: elsif ($bondAngle < -$PI/4 && $bondAngle > -3*$PI/4) {
362: $direction = "u";
363: }
364: else {
365: $direction = "r";
366: }
1.1 albertel 367: }
368:
1.5 albertel 369: if ($direction eq "r") { # direction = right
1.7 albertel 370: $formula[0] =~ /([A-Z][a-z]?)(\d*)/;
371: my $carrige = $x[$i]-stringWidth($1)/2;
1.5 albertel 372: foreach (@formula) {
373: $_ =~ /([A-Z][a-z]?)(\d*)/;
1.7 albertel 374: $carrige = printElement ($1,$2,$carrige,$y[$i]);
1.5 albertel 375: }
1.7 albertel 376: printCharge ($sign,$charge,$carrige,$y[$i]) if ($sign ne "");
1.5 albertel 377: }
378: elsif ($direction eq "l") { # direction = left, reverse hydrogens
1.7 albertel 379: $formula[0] =~ /([A-Z][a-z]?)(\d*)/;
380: my $carrige = $x[$i]+
1.5 albertel 381: stringWidth($1)/2+stringWidth($2)-stringWidth($formula);
382: foreach (reverse @formula) {
383: $_ =~ /([A-Z][a-z]?)(\d*)/;
1.7 albertel 384: $carrige = printElement ($1,$2,$carrige,$y[$i]);
1.5 albertel 385: }
1.7 albertel 386: printCharge ($sign,$charge,$carrige,$y[$i]) if ($sign ne "");
1.5 albertel 387: }
388: elsif ($direction eq "u") { # direction = up
389: (shift @formula) =~ /([A-Z][a-z]?)(\d*)/;
1.7 albertel 390: my $carrige = $x[$i]-stringWidth($1)/2;
391: $carrige = printElement ($1,$2,$carrige,$y[$i]);
392: my $y = (@formula > 0) ? $y[$i] + fm2cm(800) : $y[$i];
1.5 albertel 393: $carrige =
1.7 albertel 394: (@formula > 0) ? $x[$i]-stringWidth($1)/2 : $carrige;
1.5 albertel 395: foreach (@formula) {
396: $_ =~ /([A-Z][a-z]?)(\d*)/;
397: $carrige = printElement ($1,$2,$carrige,$y);
398: }
399: printCharge ($sign,$charge,$carrige,$y) if ($sign ne "");
1.1 albertel 400: }
1.5 albertel 401: else { # direction = down
402: (shift @formula) =~ /([A-Z][a-z]?)(\d*)/;
1.7 albertel 403: my $carrige = $x[$i]-stringWidth($1)/2;
404: $carrige = printElement ($1,$2,$carrige,$y[$i]);
405: my $y = (@formula > 0) ? $y[$i] + fm2cm(-800) : $y[$i];
1.5 albertel 406: $carrige =
1.7 albertel 407: (@formula > 0) ? $x[$i]-stringWidth($1)/2 : $carrige;
1.5 albertel 408: foreach (@formula) {
409: $_ =~ /([A-Z][a-z]?)(\d*)/;
410: $carrige = printElement ($1,$2,$carrige,$y);
411: }
412: printCharge ($sign,$charge,$carrige,$y) if ($sign ne "");
1.1 albertel 413: }
414: }
415: }
416: }
1.7 albertel 417:
418: if ($loncapa) {
419: if ($png) {
1.1 albertel 420: # make sure we are writing to a binary stream
1.7 albertel 421: binmode STDOUT;
1.1 albertel 422:
423: # Convert the image to PNG and print it on standard output
1.7 albertel 424: print "Content-type: image/png\n\n";
425: print $im->png;
426: } elsif ($ps) {
427: my $psfile = "/home/httpd/perl/tmp/".$id.'.eps';
428: $im->output($psfile);
429: print "Content-type: text/html\n\n";
430: print (<<HTML)
431: <html>
432: <body>
433: Wrote eps file $psfile
434: </body>
435: </html>
1.3 albertel 436: HTML
1.7 albertel 437: }
438: } else {
439: if ($png) {
440: # make sure we are writing to a binary stream
441: binmode STDOUT;
442: # Convert the image to PNG and print it on standard output
443: print $im->png;
444: } elsif ($ps) {
445: $im->output("file.ps");
446: }
1.3 albertel 447: }
448:
1.1 albertel 449: sub stringWidth {
450: my ($string) = @_;
451: my $width = 0;
452: while ($string =~ /[A-Za-z]/g) {
1.3 albertel 453: if ($png) {
454: my @bounds = GD::Image->stringTTF($black,$font,$ptsize,0,0,0,$&);
1.7 albertel 455: $width += $bounds[2]-$bounds[0]+2;
1.3 albertel 456: } elsif ($ps) {
1.7 albertel 457: $width += fm2cm($font_width{$&});
1.3 albertel 458: }
1.1 albertel 459: }
460: while ($string =~ /[\d+-]/g) {
1.3 albertel 461: if ($png) {
462: my @bounds=GD::Image->stringTTF($black,$font,0.6*$ptsize,0,0,0,$&);
1.7 albertel 463: $width += $bounds[2]-$bounds[0]+2;
1.3 albertel 464: } elsif ($ps) {
1.7 albertel 465: $width += fm2cm(0.6*$font_width{$&});
1.3 albertel 466: }
1.1 albertel 467: }
468:
469: return $width;
470: }
471:
472: sub fm2cm { #font metrics to cm
473: my ($fm) = @_;
1.7 albertel 474: return $scale*(2.54/72)*$pointsize*$fm/1000;
1.3 albertel 475: }
476:
477: sub printElement {
478: if ($png) {
479: return &printElement_png(@_);
480: } elsif ($ps) {
481: return &printElement_ps(@_);
482: }
1.1 albertel 483: }
484:
1.3 albertel 485: sub printElement_png { #element symbol + optional subscript
1.1 albertel 486: my ($element,$subscript,$x,$y) = @_;
1.2 albertel 487: my $yy = 662;
1.1 albertel 488:
489: my @bounds = GD::Image->stringTTF($black,$font,$ptsize,0,
490: $x,$height-($y+fm2cm(-$yy/2)),$element);
491: $im->filledRectangle(
1.7 albertel 492: $bounds[6]-1,$bounds[7]-fm2cm(135),
493: $bounds[2]+1,$bounds[3]+fm2cm(135),$white);
1.1 albertel 494:
495: $im->stringTTF($black,$font,$ptsize,0,
496: $x,$height-($y+fm2cm(-$yy/2)),$element);
1.7 albertel 497: $x = $bounds[2] + 1;
1.1 albertel 498:
499: if ($subscript ne "") {
500: @bounds = GD::Image->stringTTF($black,$font,0.6*$ptsize,0,
501: $x,$height-($y+fm2cm(-0.8*$yy)),$subscript);
502: $im->filledRectangle(
1.7 albertel 503: $bounds[6]-1,$bounds[7]-fm2cm(45),
504: $bounds[2]+1,$bounds[3]+fm2cm(45),$white);
1.1 albertel 505: $im->stringTTF($black,$font,0.6*$ptsize,0,
506: $x,$height-($y+fm2cm(-0.8*$yy)),$subscript);
507: }
1.7 albertel 508: $x = $bounds[2] + 1;
1.1 albertel 509: }
510:
1.3 albertel 511: sub printElement_ps { #element symbol + optional subscript
512: my ($element,$subscript,$x,$y) = @_;
513: $height = 662;
1.7 albertel 514:
1.3 albertel 515: $im->setcolour("white");
516: $im->box({filled=>1},
517: $x+fm2cm(-30),$y+fm2cm(-$height/2-150),
1.7 albertel 518: $x+stringWidth($element)+fm2cm(50),$y+fm2cm(+$height/2+150));
1.3 albertel 519: $im->setcolour("black");
520: $im->setfont("Times-Roman",$pointsize);
521: $im->text($x,$y+fm2cm(-$height/2),$element);
1.7 albertel 522: $x += stringWidth($element);
1.3 albertel 523:
524: if ($subscript ne "") {
525: $im->setcolour("white");
526: $im->box({filled=>1},
527: $x,$y+fm2cm(-0.8*$height-45),
1.7 albertel 528: $x+stringWidth($subscript)+fm2cm(50),$y+fm2cm(-0.2*$height+45));
1.3 albertel 529: $im->setcolour("black");
530: $im->setfont("Times-Roman",0.6*$pointsize);
531: $im->text($x,$y+fm2cm(-0.8*$height),$subscript);
532: }
1.7 albertel 533: $x += stringWidth($subscript);
1.3 albertel 534: }
535:
1.1 albertel 536: sub printCharge {
1.3 albertel 537: if ($png) {
538: return &printCharge_png(@_);
539: } elsif ($ps) {
540: return &printCharge_ps(@_);
541: }
542: }
543:
544: sub printCharge_png {
1.1 albertel 545: my ($sign,$charge,$x,$y) = @_;
1.2 albertel 546: my $yy = 662;
1.1 albertel 547:
548: $charge = "" if ($charge == 1);
549: $charge .= $sign;
550:
551: my @bounds = GD::Image->stringTTF($black,$font,0.6*$ptsize,0,
552: $x,$height-($y+fm2cm(0.2*$yy)),$charge);
553: $im->filledRectangle(
1.7 albertel 554: $bounds[6]-1,$bounds[7]-fm2cm(45),
555: $bounds[2]+1,$bounds[3]+fm2cm(45),$white);
1.1 albertel 556:
557: $im->stringTTF($black,$font,0.6*$ptsize,0,$x,$height-($y+fm2cm(0.2*$yy)),$charge);
1.7 albertel 558: $x = $bounds[2] + 1;
1.1 albertel 559: }
560:
1.3 albertel 561: sub printCharge_ps {
562: my ($sign,$charge,$x,$y) = @_;
563: $height = 662;
564:
565: $charge = "" if ($charge == 1);
566: $charge .= $sign;
567:
568: $im->setcolour("white");
569: $im->box({filled=>1},
570: $x,$y+fm2cm(0.2*$height-45),
1.7 albertel 571: $x+stringWidth($charge)+fm2cm(50),$y+fm2cm(0.8*$height+45));
1.3 albertel 572:
573: if ($sign eq "-") { # replace by n-dash
574: chop $charge;
575: $charge .= "\xb1";
576: }
577: $im->setcolour("black");
578: $im->setfont("Times-Roman",0.6*$pointsize);
579: $im->text($x,$y+fm2cm(0.2*$height),$charge);
1.7 albertel 580: $x += stringWidth($charge);
1.3 albertel 581: }
1.1 albertel 582:
1.5 albertel 583: sub determine_size {
1.7 albertel 584: # Find border
1.5 albertel 585: my (@all_structs)=@_;
586: my $xmin = my $ymin = 1e20;
587: my $xmax = my $ymax = -1e20;
588: my $maxName = 0;
589: foreach my $struct (@all_structs) {
590: my (@name,@x,@y,@atomA,@atomB,@bondType,$natoms,$nbonds);
591: &parse_struct($struct,\@name,\@x,\@y,\@atomA,\@atomB,\@bondType);
592: $natoms=scalar(@x);
593: $nbonds=scalar(@bondType);
1.7 albertel 594: for (my $i = 0; $i < $natoms; $i++) {
595: $xmax = $x[$i] if ($x[$i] > $xmax);
596: $xmin = $x[$i] if ($x[$i] < $xmin);
597: $ymax = $y[$i] if ($y[$i] > $ymax);
598: $ymin = $y[$i] if ($y[$i] < $ymin);
599: $name[$i] =~ /(\@{1,2})?(\w+)([\+|\-])?(\d)?/;
1.5 albertel 600: $maxName = length $2 if (length $2 > $maxName);
601: }
602: }
1.7 albertel 603: $maxName = ($maxName-3 < 0) ? 0 : $maxName-3;
604:
605: my $scale;
606: if ($png) {
607: $scale = $width / ($xmax-$xmin+3+$maxName);
608: } elsif ($ps) {
609: $scale = 1;
610: }
1.5 albertel 611: my $height = $scale * ($ymax-$ymin+2);
612:
613: return ($xmin,$xmax,$ymin,$ymax,$maxName,$height,$scale);
614:
615: }
616:
617: sub parse_struct {
618: my ($struct,$name,$x,$y,$atomA,$atomB,$bondType)=@_;
1.6 albertel 619: $struct=~s/^\s*//;
620: $struct=~s/\s*$//;
621: my @JMEstring = split(/ +/,$struct);
1.5 albertel 622: # parse JME string
623: my $natoms= shift @JMEstring;
624: my $nbonds= shift @JMEstring;
625: for (my $i = 0; $i < $natoms; $i++) {
626: $$name[$i] = shift @JMEstring;
627: $$x[$i] = shift @JMEstring;
628: $$y[$i] = shift @JMEstring;
629: }
630:
631: for (my $i = 0; $i < $nbonds; $i++) {
632: $$atomA[$i] = (shift @JMEstring)-1;
633: $$atomB[$i] = (shift @JMEstring)-1;
634: $$bondType[$i] = shift @JMEstring;
635: }
636: }
1.1 albertel 637:
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