loncom/homework/convertjme.pl - view

File: [LON-CAPA] / loncom / homework / convertjme.pl
Revision 1.9: download - view: text, annotated - select for diffs
Mon Dec 8 18:36:58 2003 UTC (20 years, 6 months ago) by albertel
Branches: MAIN
CVS tags: version_1_3_1, version_1_3_0, version_1_2_X, version_1_2_99_1, version_1_2_99_0, version_1_2_1, version_1_2_0, version_1_1_X, version_1_1_99_5, version_1_1_99_4, version_1_1_99_3, version_1_1_99_2, version_1_1_99_1, version_1_1_99_0, version_1_1_3, version_1_1_2, version_1_1_1, version_1_1_0, version_1_0_99_3, version_1_0_99_2, version_1_0_99_1, HEAD

- new version for Guy Ashkenazi

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.9 2003/12/08 18:36:58 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 = $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: @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 %valence = ("C",4,"N",3,"P",3,"O",2,"S",2); 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 = '/usr/share/fonts/default/Type1/n021003l.pfb'; 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: my $nH = 0; 337: if (exists $valence{$formula}) { 338: $nH = $valence{$formula} - $bonds[$i]; 339: $nH += (($charge eq "")? 1 : $charge) if ($sign eq "+"); 340: $nH -= (($charge eq "")? 1 : $charge) if ($sign eq "-"); 341: } 342: $formula .= "H" if ($nH > 0); 343: $formula .= $nH if ($nH > 1); 344: my @formula = $formula=~ /[A-Z][a-z]?\d*/g; 345: 346: my $PI = 3.1415; 347: my $bondAngle; 348: if (abs($bondsy[$i]) < 0.01 && abs($bondsx[$i]) < 0.01) { 349: $bondAngle = -$PI; 350: } 351: else { 352: $bondAngle = atan2($bondsy[$i],$bondsx[$i]); 353: } 354: 355: my $direction; 356: if ($adjacent[$i] < 2) { 357: $direction = ($bondsx[$i] < 0.01) ? "r" : "l"; 358: } 359: else { 360: if ($bondAngle >= -$PI/4 && $bondAngle <= $PI/4) { 361: $direction = "l"; 362: } 363: elsif ($bondAngle > $PI/4 && $bondAngle < 3*$PI/4) { 364: $direction = "d"; 365: } 366: elsif ($bondAngle < -$PI/4 && $bondAngle > -3*$PI/4) { 367: $direction = "u"; 368: } 369: else { 370: $direction = "r"; 371: } 372: } 373: 374: if ($direction eq "r") { # direction = right 375: $formula[0] =~ /([A-Z][a-z]?)(\d*)/; 376: my $carrige = $x[$i]-stringWidth($1)/2; 377: foreach (@formula) { 378: $_ =~ /([A-Z][a-z]?)(\d*)/; 379: $carrige = printElement ($1,$2,$carrige,$y[$i]); 380: } 381: printCharge ($sign,$charge,$carrige,$y[$i]) if ($sign ne ""); 382: } 383: elsif ($direction eq "l") { # direction = left, reverse hydrogens 384: $formula[0] =~ /([A-Z][a-z]?)(\d*)/; 385: my $carrige = $x[$i]+ 386: stringWidth($1)/2+stringWidth($2)-stringWidth($formula); 387: foreach (reverse @formula) { 388: $_ =~ /([A-Z][a-z]?)(\d*)/; 389: $carrige = printElement ($1,$2,$carrige,$y[$i]); 390: } 391: printCharge ($sign,$charge,$carrige,$y[$i]) if ($sign ne ""); 392: } 393: elsif ($direction eq "u") { # direction = up 394: (shift @formula) =~ /([A-Z][a-z]?)(\d*)/; 395: my $carrige = $x[$i]-stringWidth($1)/2; 396: $carrige = printElement ($1,$2,$carrige,$y[$i]); 397: my $y = (@formula > 0) ? $y[$i] + fm2cm(800) : $y[$i]; 398: $carrige = 399: (@formula > 0) ? $x[$i]-stringWidth($1)/2 : $carrige; 400: foreach (@formula) { 401: $_ =~ /([A-Z][a-z]?)(\d*)/; 402: $carrige = printElement ($1,$2,$carrige,$y); 403: } 404: printCharge ($sign,$charge,$carrige,$y) if ($sign ne ""); 405: } 406: else { # direction = down 407: (shift @formula) =~ /([A-Z][a-z]?)(\d*)/; 408: my $carrige = $x[$i]-stringWidth($1)/2; 409: $carrige = printElement ($1,$2,$carrige,$y[$i]); 410: my $y = (@formula > 0) ? $y[$i] + fm2cm(-800) : $y[$i]; 411: $carrige = 412: (@formula > 0) ? $x[$i]-stringWidth($1)/2 : $carrige; 413: foreach (@formula) { 414: $_ =~ /([A-Z][a-z]?)(\d*)/; 415: $carrige = printElement ($1,$2,$carrige,$y); 416: } 417: printCharge ($sign,$charge,$carrige,$y) if ($sign ne ""); 418: } 419: } 420: } 421: } 422: 423: if ($loncapa) { 424: if ($png) { 425: # make sure we are writing to a binary stream 426: binmode STDOUT; 427: 428: # Convert the image to PNG and print it on standard output 429: print "Content-type: image/png\n\n"; 430: print $im->png; 431: } elsif ($ps) { 432: my $psfile = "/home/httpd/perl/tmp/".$id.'.eps'; 433: $im->output($psfile); 434: print "Content-type: text/html\n\n"; 435: print (<<HTML) 436: <html> 437: <body> 438: Wrote eps file $psfile 439: </body> 440: </html> 441: HTML 442: } 443: } else { 444: if ($png) { 445: # make sure we are writing to a binary stream 446: binmode STDOUT; 447: # Convert the image to PNG and print it on standard output 448: print $im->png; 449: } elsif ($ps) { 450: $im->output("file.ps"); 451: } 452: } 453: 454: sub stringWidth { 455: my ($string) = @_; 456: my $width = 0; 457: while ($string =~ /[A-Za-z]/g) { 458: if ($png) { 459: my @bounds = GD::Image->stringTTF($black,$font,$ptsize,0,0,0,$&); 460: $width += $bounds[2]-$bounds[0]+2; 461: } elsif ($ps) { 462: $width += fm2cm($font_width{$&}); 463: } 464: } 465: while ($string =~ /[\d+-]/g) { 466: if ($png) { 467: my @bounds=GD::Image->stringTTF($black,$font,0.6*$ptsize,0,0,0,$&); 468: $width += $bounds[2]-$bounds[0]+2; 469: } elsif ($ps) { 470: $width += fm2cm(0.6*$font_width{$&}); 471: } 472: } 473: 474: return $width; 475: } 476: 477: sub fm2cm { #font metrics to cm 478: my ($fm) = @_; 479: return $scale*(2.54/72)*$pointsize*$fm/1000; 480: } 481: 482: sub printElement { 483: if ($png) { 484: return &printElement_png(@_); 485: } elsif ($ps) { 486: return &printElement_ps(@_); 487: } 488: } 489: 490: sub printElement_png { #element symbol + optional subscript 491: my ($element,$subscript,$x,$y) = @_; 492: my $yy = 662; 493: 494: my @bounds = GD::Image->stringTTF($black,$font,$ptsize,0, 495: $x,$height-($y+fm2cm(-$yy/2)),$element); 496: $im->filledRectangle( 497: $bounds[6]-1,$bounds[7]-fm2cm(135), 498: $bounds[2]+1,$bounds[3]+fm2cm(135),$white); 499: 500: $im->stringTTF($black,$font,$ptsize,0, 501: $x,$height-($y+fm2cm(-$yy/2)),$element); 502: $x = $bounds[2] + 1; 503: 504: if ($subscript ne "") { 505: @bounds = GD::Image->stringTTF($black,$font,0.6*$ptsize,0, 506: $x,$height-($y+fm2cm(-0.8*$yy)),$subscript); 507: $im->filledRectangle( 508: $bounds[6]-1,$bounds[7]-fm2cm(45), 509: $bounds[2]+1,$bounds[3]+fm2cm(45),$white); 510: $im->stringTTF($black,$font,0.6*$ptsize,0, 511: $x,$height-($y+fm2cm(-0.8*$yy)),$subscript); 512: } 513: $x = $bounds[2] + 1; 514: } 515: 516: sub printElement_ps { #element symbol + optional subscript 517: my ($element,$subscript,$x,$y) = @_; 518: $height = 662; 519: 520: $im->setcolour("white"); 521: $im->box({filled=>1}, 522: $x+fm2cm(-30),$y+fm2cm(-$height/2-150), 523: $x+stringWidth($element)+fm2cm(50),$y+fm2cm(+$height/2+150)); 524: $im->setcolour("black"); 525: $im->setfont("Times-Roman",$pointsize); 526: $im->text($x,$y+fm2cm(-$height/2),$element); 527: $x += stringWidth($element); 528: 529: if ($subscript ne "") { 530: $im->setcolour("white"); 531: $im->box({filled=>1}, 532: $x,$y+fm2cm(-0.8*$height-45), 533: $x+stringWidth($subscript)+fm2cm(50),$y+fm2cm(-0.2*$height+45)); 534: $im->setcolour("black"); 535: $im->setfont("Times-Roman",0.6*$pointsize); 536: $im->text($x,$y+fm2cm(-0.8*$height),$subscript); 537: } 538: $x += stringWidth($subscript); 539: } 540: 541: sub printCharge { 542: if ($png) { 543: return &printCharge_png(@_); 544: } elsif ($ps) { 545: return &printCharge_ps(@_); 546: } 547: } 548: 549: sub printCharge_png { 550: my ($sign,$charge,$x,$y) = @_; 551: my $yy = 662; 552: 553: $sign = "–" if ($sign eq "-"); # replace by n-dash 554: $charge = "" if ($charge == 1); 555: $charge .= $sign; 556: 557: my @bounds = GD::Image->stringTTF($black,$font,0.6*$ptsize,0, 558: $x,$height-($y+fm2cm(0.2*$yy)),$charge); 559: $im->filledRectangle( 560: $bounds[6]-1,$bounds[7]-fm2cm(45), 561: $bounds[2]+1,$bounds[3]+fm2cm(45),$white); 562: 563: $im->stringTTF($black,$font,0.6*$ptsize,0,$x,$height-($y+fm2cm(0.2*$yy)),$charge); 564: $x = $bounds[2] + 1; 565: } 566: 567: sub printCharge_ps { 568: my ($sign,$charge,$x,$y) = @_; 569: $height = 662; 570: 571: $charge = "" if ($charge == 1); 572: $charge .= $sign; 573: 574: $im->setcolour("white"); 575: $im->box({filled=>1}, 576: $x,$y+fm2cm(0.2*$height-45), 577: $x+stringWidth($charge)+fm2cm(50),$y+fm2cm(0.8*$height+45)); 578: 579: if ($sign eq "-") { # replace by n-dash 580: chop $charge; 581: $charge .= "\xb1"; 582: } 583: $im->setcolour("black"); 584: $im->setfont("Times-Roman",0.6*$pointsize); 585: $im->text($x,$y+fm2cm(0.2*$height),$charge); 586: $x += stringWidth($charge); 587: } 588: 589: sub determine_size { 590: # Find border 591: my (@all_structs)=@_; 592: my $xmin = my $ymin = 1e20; 593: my $xmax = my $ymax = -1e20; 594: my $maxName = 0; 595: foreach my $struct (@all_structs) { 596: my (@name,@x,@y,@atomA,@atomB,@bondType,$natoms,$nbonds); 597: &parse_struct($struct,\@name,\@x,\@y,\@atomA,\@atomB,\@bondType); 598: $natoms=scalar(@x); 599: $nbonds=scalar(@bondType); 600: for (my $i = 0; $i < $natoms; $i++) { 601: $xmax = $x[$i] if ($x[$i] > $xmax); 602: $xmin = $x[$i] if ($x[$i] < $xmin); 603: $ymax = $y[$i] if ($y[$i] > $ymax); 604: $ymin = $y[$i] if ($y[$i] < $ymin); 605: $name[$i] =~ /(\@{1,2})?(\w+)([\+|\-])?(\d)?/; 606: $maxName = length $2 if (length $2 > $maxName); 607: } 608: } 609: $maxName = ($maxName-3 < 0) ? 0 : $maxName-3; 610: 611: my $scale; 612: if ($png) { 613: $scale = $width / ($xmax-$xmin+3+$maxName); 614: } elsif ($ps) { 615: $scale = 1; 616: } 617: my $height = $scale * ($ymax-$ymin+2); 618: 619: return ($xmin,$xmax,$ymin,$ymax,$maxName,$height,$scale); 620: 621: } 622: 623: sub parse_struct { 624: my ($struct,$name,$x,$y,$atomA,$atomB,$bondType)=@_; 625: $struct=~s/^\s*//; 626: $struct=~s/\s*$//; 627: my @JMEstring = split(/ +/,$struct); 628: # parse JME string 629: my $natoms= shift @JMEstring; 630: my $nbonds= shift @JMEstring; 631: for (my $i = 0; $i < $natoms; $i++) { 632: $$name[$i] = shift @JMEstring; 633: $$x[$i] = shift @JMEstring; 634: $$y[$i] = shift @JMEstring; 635: } 636: 637: for (my $i = 0; $i < $nbonds; $i++) { 638: $$atomA[$i] = (shift @JMEstring)-1; 639: $$atomB[$i] = (shift @JMEstring)-1; 640: $$bondType[$i] = shift @JMEstring; 641: } 642: } 643: