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