--- loncom/homework/convertjme.pl 2003/10/17 22:24:51 1.4 +++ loncom/homework/convertjme.pl 2003/10/18 06:51:08 1.5 @@ -2,7 +2,7 @@ # The LearningOnline Network with CAPA # Dynamically converts JME strings into either a png or ps file. # -# $Id: convertjme.pl,v 1.4 2003/10/17 22:24:51 albertel Exp $ +# $Id: convertjme.pl,v 1.5 2003/10/18 06:51:08 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -58,73 +58,27 @@ sub unescape { # read the width and the JME string from the cgi query my $id=$ENV{'QUERY_STRING'}; -my @JMEstring = split(/ /,&unescape($ENV{'cgi.'.$id.'.JME'})); my $width = $ENV{'cgi.'.$id.'.WIDTH'}; +if (!$width) { $width = 400; } my $png = $ENV{'cgi.'.$id.'.PNG'}; my $ps = $ENV{'cgi.'.$id.'.PS'}; -if (!$width) { $width = 200; } -# parse JME string +#get objects +my ($reactants,$solution,$products)=split('>',&unescape($ENV{'cgi.'.$id.'.JME'})); -my $natoms= shift @JMEstring; -my $nbonds= shift @JMEstring; -my (@name,@x,@y); -for (my $i = 0; $i < $natoms; $i++) { - @name[$i] = shift @JMEstring; - @x[$i] = shift @JMEstring; - @y[$i] = shift @JMEstring; -} +my @reactant_structs=split(/\|/,$reactants); +my @solution_structs=split(/\|/,$solution); +my @product_structs=split(/\|/,$products); -my (@atomA,@atomB,@bondType); -for (my $i = 0; $i < $nbonds; $i++) { - @atomA[$i] = (shift @JMEstring)-1; - @atomB[$i] = (shift @JMEstring)-1; - @bondType[$i] = shift @JMEstring; -} +my $draw_arrow; +if (@solution_structs || @product_structs) { $draw_arrow=1; } -# Find border and move lower left corner to (1.5,1.0) +my @all_structs=(@reactant_structs,@solution_structs,@product_structs); -my $xmin = my $xmax = @x[0]; -my $ymin = my $ymax = $y[0]; -my $maxName = 0; - -for (my $i = 1; $i < $natoms; $i++) { - $xmax = @x[$i] if (@x[$i] > $xmax); - $xmin = @x[$i] if (@x[$i] < $xmin); - $ymax = @y[$i] if (@y[$i] > $ymax); - $ymin = @y[$i] if (@y[$i] < $ymin); - @name[$i] =~ /(\@{1,2})?(\w+)([\+|\-])?(\d)?/; - $maxName = length $2 if (length $2 > $maxName); -} -$maxName = ($maxName-3 < 0) ? 0 : $maxName-3; -my $scale = $width / ($xmax-$xmin+3+$maxName); -my $height = $scale * ($ymax-$ymin+2); - -for (my $i = 0; $i < $natoms; $i++) { - @x[$i] += (1.5+$maxName/2-$xmin); - if ($png) { @x[$i] *= $scale; } - @y[$i] += (1.0-$ymin); - if ($png) { @y[$i] *= $scale; } -} - -# Count bonds +#get size of image and initialize image and globals +my ($xmin,$xmax,$ymin,$ymax,$maxName,$height,$scale) = + &determine_size(@all_structs); -my @bonds = map {0} 0..$natoms-1; -my @adjacent = map {0} 0..$natoms-1; -my @bondsx = map {0} 0..$natoms-1; -my @bondsy = map {0} 0..$natoms-1; -for (my $i = 0; $i < $nbonds; $i++) { - @bonds[@atomA[$i]] += (@bondType[$i]>0) ? @bondType[$i] : 1; - @bonds[@atomB[$i]] += (@bondType[$i]>0) ? @bondType[$i] : 1; - - @adjacent[@atomA[$i]]++; - @adjacent[@atomB[$i]]++; - - @bondsx[@atomA[$i]] += @x[@atomB[$i]] - @x[@atomA[$i]]; - @bondsy[@atomA[$i]] += @y[@atomB[$i]] - @y[@atomA[$i]]; - @bondsx[@atomB[$i]] += @x[@atomA[$i]] - @x[@atomB[$i]]; - @bondsy[@atomB[$i]] += @y[@atomA[$i]] - @y[@atomB[$i]]; -} # Create a new PostScript object my ($im,$white,$black,$gray); @@ -144,7 +98,17 @@ if ($png) { units => "cm"); } -# Draw bonds +my %valence = ("C",4,"N",3,"P",3,"O",2,"S",2); +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); +my $font = '/usr/share/fonts/default/Type1/n021003l.pfb'; +my $pointsize = 20; +my ($ptsize,@bounds); +if ($png) { + @bounds = GD::Image->stringTTF($black,$font,100,0,0,0,"H"); + $ptsize = 100*0.662*$pointsize*(2.54/72)*$scale/(@bounds[3]-@bounds[5]); +} + +#set bond sizes my $doubleWidth; my $tripleWidth; if ($png) { @@ -155,217 +119,241 @@ if ($png) { $tripleWidth = 0.15; } -for (my $i = 0; $i < $nbonds; $i++) { - my $xa = @x[@atomA[$i]]; - my $ya = @y[@atomA[$i]]; - my $xb = @x[@atomB[$i]]; - my $yb = @y[@atomB[$i]]; - - my ($sina,$cosa,$dx,$dy); - if (@bondType[$i] != 1) { - $dx = $xb-$xa; - $dy = $yb-$ya; - my $dd = sqrt($dx*$dx + $dy*$dy); - $sina=$dy/$dd; - $cosa=$dx/$dd; - } - if (@bondType[$i] == -2) { - for (my $t = 0; $t <= 1; $t += 0.1) { - my $xab = $xa + $t*$dx; - my $yab = $ya + $t*$dy; - my $xperp = $tripleWidth*$sina*$t; - my $yperp = $tripleWidth*$cosa*$t; + +foreach my $struct (@all_structs) { + + my (@name,@x,@y,@atomA,@atomB,@bondType,$natoms,$nbonds); + &parse_struct($struct,\@name,\@x,\@y,\@atomA,\@atomB,\@bondType); + $natoms=scalar(@x); + $nbonds=scalar(@bondType); + + for (my $i = 0; $i < $natoms; $i++) { + @x[$i] += (1.5+$maxName/2-$xmin); + if ($png) { @x[$i] *= $scale; } + @y[$i] += (1.0-$ymin); + if ($png) { @y[$i] *= $scale; } + } + +# Count bonds + + my @bonds = map {0} 0..$natoms-1; + my @adjacent = map {0} 0..$natoms-1; + my @bondsx = map {0} 0..$natoms-1; + my @bondsy = map {0} 0..$natoms-1; + for (my $i = 0; $i < $nbonds; $i++) { + @bonds[@atomA[$i]] += (@bondType[$i]>0) ? @bondType[$i] : 1; + @bonds[@atomB[$i]] += (@bondType[$i]>0) ? @bondType[$i] : 1; + + @adjacent[@atomA[$i]]++; + @adjacent[@atomB[$i]]++; + + @bondsx[@atomA[$i]] += @x[@atomB[$i]] - @x[@atomA[$i]]; + @bondsy[@atomA[$i]] += @y[@atomB[$i]] - @y[@atomA[$i]]; + @bondsx[@atomB[$i]] += @x[@atomA[$i]] - @x[@atomB[$i]]; + @bondsy[@atomB[$i]] += @y[@atomA[$i]] - @y[@atomB[$i]]; + } + +# Draw bonds + for (my $i = 0; $i < $nbonds; $i++) { + my $xa = @x[@atomA[$i]]; + my $ya = @y[@atomA[$i]]; + my $xb = @x[@atomB[$i]]; + my $yb = @y[@atomB[$i]]; + + my ($sina,$cosa,$dx,$dy); + if (@bondType[$i] != 1) { + $dx = $xb-$xa; + $dy = $yb-$ya; + my $dd = sqrt($dx*$dx + $dy*$dy); + $sina=$dy/$dd; + $cosa=$dx/$dd; + } + if (@bondType[$i] == -2) { + for (my $t = 0; $t <= 1; $t += 0.1) { + my $xab = $xa + $t*$dx; + my $yab = $ya + $t*$dy; + my $xperp = $tripleWidth*$sina*$t; + my $yperp = $tripleWidth*$cosa*$t; + if ($png) { + $im->line($xab+$xperp,$height-($yab-$yperp), + $xab-$xperp,$height-($yab+$yperp), + gdAntiAliased); + } elsif ($ps) { + $im->line($xab+$xperp,$yab-$yperp,$xab-$xperp,$yab+$yperp); + } + } + } + elsif (@bondType[$i] == -1) { + my $xperp = $tripleWidth*$sina; + my $yperp = $tripleWidth*$cosa; if ($png) { - $im->line($xab+$xperp,$height-($yab-$yperp), - $xab-$xperp,$height-($yab+$yperp), - gdAntiAliased); + my $poly = new GD::Polygon; + $poly->addPt($xa,$height-$ya); + $poly->addPt($xb+$xperp,$height-($yb-$yperp)); + $poly->addPt($xb-$xperp,$height-($yb+$yperp)); + $im->filledPolygon($poly,$black); } elsif ($ps) { - $im->line($xab+$xperp,$yab-$yperp,$xab-$xperp,$yab+$yperp); + $im->polygon({filled=>1}, + $xa,$ya, + $xb+$xperp,$yb-$yperp, + $xb-$xperp,$yb+$yperp); } } - } - elsif (@bondType[$i] == -1) { - my $xperp = $tripleWidth*$sina; - my $yperp = $tripleWidth*$cosa; - if ($png) { - my $poly = new GD::Polygon; - $poly->addPt($xa,$height-$ya); - $poly->addPt($xb+$xperp,$height-($yb-$yperp)); - $poly->addPt($xb-$xperp,$height-($yb+$yperp)); - $im->filledPolygon($poly,$black); - } elsif ($ps) { - $im->polygon({filled=>1}, - $xa,$ya, - $xb+$xperp,$yb-$yperp, - $xb-$xperp,$yb+$yperp); - } - } - elsif (@bondType[$i] == 1) { - if ($png) { - $im->line($xa,$height-$ya,$xb,$height-$yb,gdAntiAliased); - } elsif ($ps) { - $im->line($xa,$ya,$xb,$yb); + elsif (@bondType[$i] == 1) { + if ($png) { + $im->line($xa,$height-$ya,$xb,$height-$yb,gdAntiAliased); + } elsif ($ps) { + $im->line($xa,$ya,$xb,$yb); + } } - } - elsif (@bondType[$i] == 2 && - ((@adjacent[@atomA[$i]] == 1 && @adjacent[@atomB[$i]] > 2)|| - (@adjacent[@atomB[$i]] == 1 && @adjacent[@atomA[$i]] > 2))) { - # centered bond - my $xperp = $doubleWidth*$sina; - my $yperp = $doubleWidth*$cosa; - if ($png) { - $im->line($xa+$xperp,$height-($ya-$yperp), - $xb+$xperp,$height-($yb-$yperp), - gdAntiAliased); - $im->line($xa-$xperp,$height-($ya+$yperp), - $xb-$xperp,$height-($yb+$yperp), - gdAntiAliased); - } elsif ($ps) { - $im->line($xa+$xperp,$ya-$yperp,$xb+$xperp,$yb-$yperp); - $im->line($xa-$xperp,$ya+$yperp,$xb-$xperp,$yb+$yperp); + elsif (@bondType[$i] == 2 && + ((@adjacent[@atomA[$i]] == 1 && @adjacent[@atomB[$i]] > 2)|| + (@adjacent[@atomB[$i]] == 1 && @adjacent[@atomA[$i]] > 2))) { + # centered bond + my $xperp = $doubleWidth*$sina; + my $yperp = $doubleWidth*$cosa; + if ($png) { + $im->line($xa+$xperp,$height-($ya-$yperp), + $xb+$xperp,$height-($yb-$yperp), + gdAntiAliased); + $im->line($xa-$xperp,$height-($ya+$yperp), + $xb-$xperp,$height-($yb+$yperp), + gdAntiAliased); + } elsif ($ps) { + $im->line($xa+$xperp,$ya-$yperp,$xb+$xperp,$yb-$yperp); + $im->line($xa-$xperp,$ya+$yperp,$xb-$xperp,$yb+$yperp); + } } - } - elsif (@bondType[$i] == 2) { - my $xperp = 2*$doubleWidth*$sina; - my $yperp = 2*$doubleWidth*$cosa; - if ($png) { - $im->line($xa,$height-$ya,$xb,$height-$yb,gdAntiAliased); - $im->line($xa+0.1*$dx-$xperp,$height-($ya+0.1*$dy+$yperp), - $xb-0.1*$dx-$xperp,$height-($yb-0.1*$dy+$yperp), - gdAntiAliased); - } elsif ($ps) { - $im->line($xa,$ya,$xb,$yb); - $im->line($xa+0.1*$dx-$xperp,$ya+0.1*$dy+$yperp, - $xb-0.1*$dx-$xperp,$yb-0.1*$dy+$yperp); - + elsif (@bondType[$i] == 2) { + my $xperp = 2*$doubleWidth*$sina; + my $yperp = 2*$doubleWidth*$cosa; + if ($png) { + $im->line($xa,$height-$ya,$xb,$height-$yb,gdAntiAliased); + $im->line($xa+0.1*$dx-$xperp,$height-($ya+0.1*$dy+$yperp), + $xb-0.1*$dx-$xperp,$height-($yb-0.1*$dy+$yperp), + gdAntiAliased); + } elsif ($ps) { + $im->line($xa,$ya,$xb,$yb); + $im->line($xa+0.1*$dx-$xperp,$ya+0.1*$dy+$yperp, + $xb-0.1*$dx-$xperp,$yb-0.1*$dy+$yperp); + } } + elsif (@bondType[$i] == 3) { + my $xperp = $tripleWidth*$sina; + my $yperp = $tripleWidth*$cosa; + if ($png) { + $im->line($xa,$height-$ya,$xb,$height-$yb,gdAntiAliased); + $im->line($xa+$xperp,$height-($ya-$yperp), + $xb+$xperp,$height-($yb-$yperp), + gdAntiAliased); + $im->line($xa-$xperp,$height-($ya+$yperp), + $xb-$xperp,$height-($yb+$yperp), + gdAntiAliased); + } elsif ($ps) { + $im->line($xa,$ya,$xb,$yb); + $im->line($xa+$xperp,$ya-$yperp,$xb+$xperp,$yb-$yperp); + $im->line($xa-$xperp,$ya+$yperp,$xb-$xperp,$yb+$yperp); + } + } } - elsif (@bondType[$i] == 3) { - my $xperp = $tripleWidth*$sina; - my $yperp = $tripleWidth*$cosa; - if ($png) { - $im->line($xa,$height-$ya,$xb,$height-$yb,gdAntiAliased); - $im->line($xa+$xperp,$height-($ya-$yperp), - $xb+$xperp,$height-($yb-$yperp), - gdAntiAliased); - $im->line($xa-$xperp,$height-($ya+$yperp), - $xb-$xperp,$height-($yb+$yperp), - gdAntiAliased); - } elsif ($ps) { - $im->line($xa,$ya,$xb,$yb); - $im->line($xa+$xperp,$ya-$yperp,$xb+$xperp,$yb-$yperp); - $im->line($xa-$xperp,$ya+$yperp,$xb-$xperp,$yb+$yperp); - } - } -} # Write labels -my %valence = ("C",4,"N",3,"P",3,"O",2,"S",2); -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); -my $font = '/usr/share/fonts/default/Type1/n021003l.pfb'; -my $pointsize = 20; -my ($ptsize,@bounds); -if ($png) { - @bounds = GD::Image->stringTTF($black,$font,100,0,0,0,"H"); - $ptsize = 100*0.662*$pointsize*(2.54/72)*$scale/(@bounds[3]-@bounds[5]); -} - -for (my $i = 0; $i < $natoms; $i++) { - my ($formula,$sign,$charge) = - (@name[$i] =~ /(\w+)([\+|\-])?(\d)?/); - if ($png) { - $sign = "–" if ($sign eq "-"); # replace by n-dash - } - if ($formula ne "C" || $sign ne ""|| - @adjacent[$i] < 2 || (@adjacent[$i] == 2 && @bonds[$i] == 4)) { - # don't show C, unless charged, terminal, or linear - my $nH = 0; - if (exists $valence{$formula}) { - $nH = $valence{$formula} - @bonds[$i]; - $nH += (($charge eq "")? 1 : $charge) if ($sign eq "+"); - $nH -= (($charge eq "")? 1 : $charge) if ($sign eq "-"); - } - $formula .= "H" if ($nH > 0); - $formula .= $nH if ($nH > 1); - my @formula = $formula=~ /[A-Z][a-z]?\d*/g; - - my $PI = 3.1415; - my $bondAngle; - if (abs(@bondsy[$i]) < 0.01 && abs(@bondsx[$i]) < 0.01) { - $bondAngle = -$PI; - } - else { - $bondAngle = atan2(@bondsy[$i],@bondsx[$i]); - } - - my $direction; - if (@adjacent[$i] < 2) { - $direction = (@bondsx[$i] < 0.01) ? "r" : "l"; - } - else { - if ($bondAngle >= -$PI/4 && $bondAngle <= $PI/4) { - $direction = "l"; + for (my $i = 0; $i < $natoms; $i++) { + my ($formula,$sign,$charge) = + (@name[$i] =~ /(\w+)([\+|\-])?(\d)?/); + if ($png) { + $sign = "–" if ($sign eq "-"); # replace by n-dash + } + if ($formula ne "C" || $sign ne ""|| + @adjacent[$i] < 2 || (@adjacent[$i] == 2 && @bonds[$i] == 4)) { + # don't show C, unless charged, terminal, or linear + my $nH = 0; + if (exists $valence{$formula}) { + $nH = $valence{$formula} - @bonds[$i]; + $nH += (($charge eq "")? 1 : $charge) if ($sign eq "+"); + $nH -= (($charge eq "")? 1 : $charge) if ($sign eq "-"); } - elsif ($bondAngle > $PI/4 && $bondAngle < 3*$PI/4) { - $direction = "d"; + $formula .= "H" if ($nH > 0); + $formula .= $nH if ($nH > 1); + my @formula = $formula=~ /[A-Z][a-z]?\d*/g; + + my $PI = 3.1415; + my $bondAngle; + if (abs(@bondsy[$i]) < 0.01 && abs(@bondsx[$i]) < 0.01) { + $bondAngle = -$PI; } - elsif ($bondAngle < -$PI/4 && $bondAngle > -3*$PI/4) { - $direction = "u"; + else { + $bondAngle = atan2(@bondsy[$i],@bondsx[$i]); + } + + my $direction; + if (@adjacent[$i] < 2) { + $direction = (@bondsx[$i] < 0.01) ? "r" : "l"; } else { - $direction = "r"; + if ($bondAngle >= -$PI/4 && $bondAngle <= $PI/4) { + $direction = "l"; + } + elsif ($bondAngle > $PI/4 && $bondAngle < 3*$PI/4) { + $direction = "d"; + } + elsif ($bondAngle < -$PI/4 && $bondAngle > -3*$PI/4) { + $direction = "u"; + } + else { + $direction = "r"; + } } - } - if ($direction eq "r") { # direction = right - @formula[0] =~ /([A-Z][a-z]?)(\d*)/; - my $carrige = @x[$i]-stringWidth($1)/2; - foreach (@formula) { - $_ =~ /([A-Z][a-z]?)(\d*)/; - $carrige = printElement ($1,$2,$carrige,@y[$i]); + if ($direction eq "r") { # direction = right + @formula[0] =~ /([A-Z][a-z]?)(\d*)/; + my $carrige = @x[$i]-stringWidth($1)/2; + foreach (@formula) { + $_ =~ /([A-Z][a-z]?)(\d*)/; + $carrige = printElement ($1,$2,$carrige,@y[$i]); + } + printCharge ($sign,$charge,$carrige,@y[$i]) if ($sign ne ""); } - printCharge ($sign,$charge,$carrige,@y[$i]) if ($sign ne ""); - } - elsif ($direction eq "l") { # direction = left, reverse hydrogens - @formula[0] =~ /([A-Z][a-z]?)(\d*)/; - my $carrige = @x[$i]+ - stringWidth($1)/2+stringWidth($2)-stringWidth($formula); - foreach (reverse @formula) { - $_ =~ /([A-Z][a-z]?)(\d*)/; + elsif ($direction eq "l") { # direction = left, reverse hydrogens + @formula[0] =~ /([A-Z][a-z]?)(\d*)/; + my $carrige = @x[$i]+ + stringWidth($1)/2+stringWidth($2)-stringWidth($formula); + foreach (reverse @formula) { + $_ =~ /([A-Z][a-z]?)(\d*)/; + $carrige = printElement ($1,$2,$carrige,@y[$i]); + } + printCharge ($sign,$charge,$carrige,@y[$i]) if ($sign ne ""); + } + elsif ($direction eq "u") { # direction = up + (shift @formula) =~ /([A-Z][a-z]?)(\d*)/; + my $carrige = @x[$i]-stringWidth($1)/2; $carrige = printElement ($1,$2,$carrige,@y[$i]); + my $y = (@formula > 0) ? @y[$i] + fm2cm(800) : @y[$i]; + $carrige = + (@formula > 0) ? @x[$i]-stringWidth($1)/2 : $carrige; + foreach (@formula) { + $_ =~ /([A-Z][a-z]?)(\d*)/; + $carrige = printElement ($1,$2,$carrige,$y); + } + printCharge ($sign,$charge,$carrige,$y) if ($sign ne ""); } - printCharge ($sign,$charge,$carrige,@y[$i]) if ($sign ne ""); - } - elsif ($direction eq "u") { # direction = up - (shift @formula) =~ /([A-Z][a-z]?)(\d*)/; - my $carrige = @x[$i]-stringWidth($1)/2; - $carrige = printElement ($1,$2,$carrige,@y[$i]); - my $y = (@formula > 0) ? @y[$i] + fm2cm(800) : @y[$i]; - $carrige = - (@formula > 0) ? @x[$i]-stringWidth($1)/2 : $carrige; - foreach (@formula) { - $_ =~ /([A-Z][a-z]?)(\d*)/; - $carrige = printElement ($1,$2,$carrige,$y); - } - printCharge ($sign,$charge,$carrige,$y) if ($sign ne ""); - } - else { # direction = down - (shift @formula) =~ /([A-Z][a-z]?)(\d*)/; - my $carrige = @x[$i]-stringWidth($1)/2; - $carrige = printElement ($1,$2,$carrige,@y[$i]); - my $y = (@formula > 0) ? @y[$i] + fm2cm(-800) : @y[$i]; - $carrige = - (@formula > 0) ? @x[$i]-stringWidth($1)/2 : $carrige; - foreach (@formula) { - $_ =~ /([A-Z][a-z]?)(\d*)/; - $carrige = printElement ($1,$2,$carrige,$y); + else { # direction = down + (shift @formula) =~ /([A-Z][a-z]?)(\d*)/; + my $carrige = @x[$i]-stringWidth($1)/2; + $carrige = printElement ($1,$2,$carrige,@y[$i]); + my $y = (@formula > 0) ? @y[$i] + fm2cm(-800) : @y[$i]; + $carrige = + (@formula > 0) ? @x[$i]-stringWidth($1)/2 : $carrige; + foreach (@formula) { + $_ =~ /([A-Z][a-z]?)(\d*)/; + $carrige = printElement ($1,$2,$carrige,$y); + } + printCharge ($sign,$charge,$carrige,$y) if ($sign ne ""); } - printCharge ($sign,$charge,$carrige,$y) if ($sign ne ""); } } } - if ($png) { # make sure we are writing to a binary stream binmode STDOUT; @@ -524,4 +512,51 @@ sub printCharge_ps { $x += fm2cm(stringWidth($charge)); } +sub determine_size { +# Find border and move lower left corner to (1.5,1.0) + my (@all_structs)=@_; + my $xmin = my $ymin = 1e20; + my $xmax = my $ymax = -1e20; + my $maxName = 0; + foreach my $struct (@all_structs) { + my (@name,@x,@y,@atomA,@atomB,@bondType,$natoms,$nbonds); + &parse_struct($struct,\@name,\@x,\@y,\@atomA,\@atomB,\@bondType); + $natoms=scalar(@x); + $nbonds=scalar(@bondType); + for (my $i = 1; $i < $natoms; $i++) { + $xmax = @x[$i] if (@x[$i] > $xmax); + $xmin = @x[$i] if (@x[$i] < $xmin); + $ymax = @y[$i] if (@y[$i] > $ymax); + $ymin = @y[$i] if (@y[$i] < $ymin); + @name[$i] =~ /(\@{1,2})?(\w+)([\+|\-])?(\d)?/; + $maxName = length $2 if (length $2 > $maxName); + } + $maxName = ($maxName-3 < 0) ? 0 : $maxName-3; + } + my $scale = $width / ($xmax-$xmin+3+$maxName); + my $height = $scale * ($ymax-$ymin+2); + + return ($xmin,$xmax,$ymin,$ymax,$maxName,$height,$scale); + +} + +sub parse_struct { + my ($struct,$name,$x,$y,$atomA,$atomB,$bondType)=@_; + my @JMEstring = split(/ /,$struct); + +# parse JME string + my $natoms= shift @JMEstring; + my $nbonds= shift @JMEstring; + for (my $i = 0; $i < $natoms; $i++) { + $$name[$i] = shift @JMEstring; + $$x[$i] = shift @JMEstring; + $$y[$i] = shift @JMEstring; + } + + for (my $i = 0; $i < $nbonds; $i++) { + $$atomA[$i] = (shift @JMEstring)-1; + $$atomB[$i] = (shift @JMEstring)-1; + $$bondType[$i] = shift @JMEstring; + } +}