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