File:  [LON-CAPA] / loncom / homework / convertjme.pl
Revision 1.6: download - view: text, annotated - select for diffs
Sat Oct 18 07:16:48 2003 UTC (20 years, 7 months ago) by albertel
Branches: MAIN
CVS tags: HEAD
- be more resilent in parsing the JME string

    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.6 2003/10/18 07:16:48 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: 
   32: 
   33: use strict;
   34: use lib '/home/httpd/lib/perl';
   35: use GD;
   36: use PostScript::Simple;
   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: }
   58: 
   59: # read the width and the JME string from the cgi query
   60: my $id=$ENV{'QUERY_STRING'};
   61: my $width = $ENV{'cgi.'.$id.'.WIDTH'};
   62: if (!$width) { $width = 400; }
   63: my $png = $ENV{'cgi.'.$id.'.PNG'};
   64: my $ps = $ENV{'cgi.'.$id.'.PS'};
   65: 
   66: #get objects
   67: my ($reactants,$solution,$products)=split('>',&unescape($ENV{'cgi.'.$id.'.JME'}));
   68: 
   69: my @reactant_structs=split(/\|/,$reactants);
   70: my @solution_structs=split(/\|/,$solution);
   71: my @product_structs=split(/\|/,$products);
   72: 
   73: my $draw_arrow;
   74: if (@solution_structs || @product_structs) { $draw_arrow=1; }
   75: 
   76: my @all_structs=(@reactant_structs,@solution_structs,@product_structs);
   77: 
   78: #get size of image and initialize image and globals
   79: my ($xmin,$xmax,$ymin,$ymax,$maxName,$height,$scale) =
   80:     &determine_size(@all_structs);
   81: 
   82: 
   83: # Create a new PostScript object
   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);
   90: #$gdAntiAliased = $im->colorAllocate(1,1,1);
   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: }
  100: 
  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
  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: }
  121: 
  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;
  189: 	    if ($png) {
  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);
  195: 	    } elsif ($ps) {
  196: 		$im->polygon({filled=>1},
  197: 			     $xa,$ya,
  198: 			     $xb+$xperp,$yb-$yperp,
  199: 			     $xb-$xperp,$yb+$yperp);
  200: 	    }
  201: 	}
  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: 	    }
  208: 	}
  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: 	    }
  226: 	}
  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: 	    }
  240: 	}
  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: 	}   
  258:     }
  259: 
  260: # Write labels
  261: 
  262:     for (my $i = 0; $i < $natoms; $i++) {
  263: 	my ($formula,$sign,$charge) =
  264: 	    (@name[$i] =~ /(\w+)([\+|\-])?(\d)?/);
  265: 	if ($png) {
  266: 	    $sign = "&#8211;" if ($sign eq "-");  # replace by n-dash
  267: 	}
  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;
  285: 	    }
  286: 	    else {
  287: 		$bondAngle = atan2(@bondsy[$i],@bondsx[$i]);
  288: 	    }
  289: 
  290: 	    my $direction;
  291: 	    if (@adjacent[$i] < 2) {
  292: 		$direction = (@bondsx[$i] < 0.01) ? "r" : "l";
  293: 	    }
  294: 	    else {
  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: 		}
  307: 	    }
  308: 		
  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;
  331: 		$carrige = printElement ($1,$2,$carrige,@y[$i]);
  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 ""); 
  340: 	    }
  341: 	    else { # direction = down
  342: 		(shift @formula) =~ /([A-Z][a-z]?)(\d*)/;
  343: 		my $carrige = @x[$i]-stringWidth($1)/2;
  344: 		$carrige = printElement ($1,$2,$carrige,@y[$i]);
  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 ""); 
  353: 	    }
  354: 	}
  355:     }
  356: }
  357: if ($png) {
  358: # make sure we are writing to a binary stream
  359:     binmode STDOUT;
  360: 
  361: # Convert the image to PNG and print it on standard output
  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: 
  377: sub stringWidth {
  378:     my ($string) = @_;
  379:     my $width = 0;
  380:     while ($string =~ /[A-Za-z]/g) {
  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: 	}
  387:     }
  388:     while ($string =~ /[\d+-]/g) {
  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: 	}
  395:     }
  396:     
  397:     return $width;
  398: }
  399: 
  400: sub fm2cm {  #font metrics to cm
  401:     my ($fm) = @_;
  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:     }
  415: }
  416: 
  417: sub printElement_png {  #element symbol + optional subscript
  418:     my ($element,$subscript,$x,$y) = @_;
  419:     my $yy = 662;
  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: 
  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: 
  468: sub printCharge {
  469:     if ($png) {
  470: 	return &printCharge_png(@_);
  471:     } elsif ($ps) {
  472: 	return &printCharge_ps(@_);
  473:     }
  474: }
  475: 
  476: sub printCharge_png {
  477:     my ($sign,$charge,$x,$y) = @_;
  478:     my $yy = 662;
  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: 
  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: }
  514: 
  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:     $struct=~s/^\s*//;
  546:     $struct=~s/\s*$//;
  547:     my @JMEstring = split(/ +/,$struct);
  548: # parse JME string
  549:     my $natoms= shift @JMEstring;
  550:     my $nbonds= shift @JMEstring;
  551:     for (my $i = 0; $i < $natoms; $i++) {
  552: 	$$name[$i] = shift @JMEstring;
  553: 	$$x[$i] = shift @JMEstring;
  554: 	$$y[$i] = shift @JMEstring;
  555:     }
  556: 
  557:     for (my $i = 0; $i < $nbonds; $i++) {
  558: 	$$atomA[$i] = (shift @JMEstring)-1;
  559: 	$$atomB[$i] = (shift @JMEstring)-1;
  560: 	$$bondType[$i] = shift @JMEstring;
  561:     }
  562: }
  563: 

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>