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