--- loncom/homework/convertjme.pl 2003/10/16 19:46:36 1.1 +++ loncom/homework/convertjme.pl 2005/01/25 14:55:15 1.10 @@ -1,279 +1,476 @@ #!/usr/bin/perl - +# The LearningOnline Network with CAPA +# Dynamically converts JME strings into either a png or ps file. +# +# $Id: convertjme.pl,v 1.10 2005/01/25 14:55:15 albertel Exp $ +# +# Copyright Michigan State University Board of Trustees +# +# This file is part of the LearningOnline Network with CAPA (LON-CAPA). +# +# LON-CAPA is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# LON-CAPA is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with LON-CAPA; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +# +# /home/httpd/html/adm/gpl.txt +# +# http://www.lon-capa.org/ # Coded by Guy Ashkenazi, guy@fh.huji.ac.il # Based on the work of Peter Ertl, peter.ertl@pharma.novartis.com -use GD; +use strict; -# read the width and the JME string from the cgi query -%data = &read_input; -@JMEstring = split (/ /,$data{JME}); -$width = $data{WIDTH}; +### FOR LON-CAPA set $loncapa to 1 and uncomment both uses +### For standalone operation, set $loncapa to 0, and comment out both uses +my $loncapa=1; +use lib '/home/httpd/lib/perl'; +use LONCAPA::loncgi(); -#print "Content-type: text/plain\n\n"; -# parse JME string +use GD; +use PostScript::Simple; -$natoms= shift @JMEstring; -$nbonds= shift @JMEstring; +if ($loncapa) { + if (! &LONCAPA::loncgi::check_cookie_and_load_env()) { + print < +Bad Cookie + +Your cookie information is incorrect. + + +END + exit; + } +} -for ($i = 0; $i < $natoms; $i++) { - @name[$i] = shift @JMEstring; - @x[$i] = shift @JMEstring; - @y[$i] = shift @JMEstring; +sub unescape { + my $str=shift; + $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; + return $str; } -for ($i = 0; $i < $nbonds; $i++) { - @atomA[$i] = (shift @JMEstring)-1; - @atomB[$i] = (shift @JMEstring)-1; - @bondType[$i] = shift @JMEstring; +# read the width and the JME string from the cgi query +my ($id,$width,$ps,$png,@JMEstring); +if ($loncapa) { + $id=$ENV{'QUERY_STRING'}; + $width = $ENV{'cgi.'.$id.'.WIDTH'}; + if (!$width) { $width = 400; } + $png = $ENV{'cgi.'.$id.'.PNG'}; + $ps = $ENV{'cgi.'.$id.'.PS'}; + @JMEstring=&unescape($ENV{'cgi.'.$id.'.JME'}); +} else { + @JMEstring = @ARGV; + $width = shift @JMEstring; + $png = 1; + $ps = 1; +} + +#get objects +my ($reactants,$modulators,$products)=split('>',$JMEstring[0]); + +my @reactant_structs=split(/\|/,$reactants); +my @modulator_structs=split(/\|/,$modulators); +my @product_structs=split(/\|/,$products); + + +my @all_structs=(@reactant_structs,@modulator_structs,@product_structs); + +#get size of image and initialize image and globals +my ($xmin,$xmax,$ymin,$ymax,$maxName,$height,$scale) = + &determine_size(@all_structs); + +my $draw_arrow; +if (@modulator_structs || @product_structs) { $draw_arrow=1; } +my ($arrow_x1,$arrow_x2,$arrow_y) = (-1e20,1e20,0); +if ($draw_arrow) { + foreach my $struct (@reactant_structs) { + my @bounds = &determine_size($struct); + if ($arrow_x1 < $bounds[1]) { + $arrow_x1 = $bounds[1]; + $arrow_y = ($bounds[2] + $bounds[3]) / 2; + } + } + foreach my $struct (@product_structs) { + my @bounds = &determine_size($struct); + $arrow_x2 = $bounds[0] if ($arrow_x2 > $bounds[0]); + } + + $arrow_x1 += (1.5+$maxName/2-$xmin); + $arrow_x1 *= $scale; + $arrow_x2 += (1.5+$maxName/2-$xmin); + $arrow_x2 *= $scale; + $arrow_y += (1.0-$ymin); + $arrow_y *= $scale; } -# Find border and move lower left corner to (1.5,1.0) +# Create a new PostScript object +my ($im,$white,$black,$gray); +my $gdAntiAliased; +if ($png) { + $im = new GD::Image($width,$height); + $white = $im->colorAllocate(255,255,255); + $black = $im->colorAllocate(0,0,0); + $gray = $im->colorAllocate(200,200,200); + $gdAntiAliased = $im->colorAllocate(1,1,1); + # $im->setAntiAliased($black); +} elsif ($ps) { + $im = new PostScript::Simple(xsize => $xmax-$xmin+3+$maxName, + ysize => $ymax-$ymin+2, + clip => 1, + eps => 1, + color => 0, + units => "cm"); +} + +my %electrons = ("C",4,"N",5,"P",5,"O",6,"S",6); +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; +$doubleWidth = 0.10*$scale; +$tripleWidth = 0.15*$scale; -$xmin = $xmax = @x[0]; -$ymin = $ymax = $y[0]; -$maxName = 0; +# Draw arrow -for ($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); +if ($draw_arrow) { + my $dx = $arrow_x2 - $arrow_x1; + if ($png) { + $im->line($arrow_x1+0.25*$dx,$height-$arrow_y, + $arrow_x2-0.25*$dx,$height-$arrow_y, + $gdAntiAliased); + $im->line($arrow_x2-0.25*$dx,$height-$arrow_y, + $arrow_x2-0.25*$dx-fm2cm(500),$height-$arrow_y-fm2cm(300), + $gdAntiAliased); + $im->line($arrow_x2-0.25*$dx,$height-$arrow_y, + $arrow_x2-0.25*$dx-fm2cm(500),$height-$arrow_y+fm2cm(300), + $gdAntiAliased); + + } elsif ($ps) { + $im->line($arrow_x1+0.25*$dx,$arrow_y, + $arrow_x2-0.25*$dx,$arrow_y); + $im->line($arrow_x2-0.25*$dx,$arrow_y, + $arrow_x2-0.25*$dx-fm2cm(500),$arrow_y-fm2cm(250)); + $im->line($arrow_x2-0.25*$dx,$arrow_y, + $arrow_x2-0.25*$dx-fm2cm(500),$arrow_y+fm2cm(250)); + } } -$maxName = ($maxName-3 < 0) ? 0 : $maxName-3; -$scale = $width / ($xmax-$xmin+3+$maxName); -$height = $scale * ($ymax-$ymin+2); -for ($i = 0; $i < $natoms; $i++) { - @x[$i] += (1.5+$maxName/2-$xmin); - @x[$i] *= $scale; - @y[$i] += (1.0-$ymin); - @y[$i] *= $scale; -} +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); + +# Scale and move lower left corner to (1.5,1.0) + + for (my $i = 0; $i < $natoms; $i++) { + $x[$i] += (1.5+$maxName/2-$xmin); + $x[$i] *= $scale; + $y[$i] += (1.0-$ymin); + $y[$i] *= $scale; + } + # Count bonds -@bonds = map {0} 0..$natoms-1; -@adjacent = map {0} 0..$natoms-1; -@bondsx = map {0} 0..$natoms-1; -@bondsy = map {0} 0..$natoms-1; -for ($i = 0; $i < $nbonds; $i++) { - @bonds[@atomA[$i]] += (@bondType[$i]>0) ? @bondType[$i] : 1; - @bonds[@atomB[$i]] += (@bondType[$i]>0) ? @bondType[$i] : 1; + 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; + my @aldehyde = 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]]++; + $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]]; -} + $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]]; + + if ( @bondType[$i] == 2) { + @aldehyde[@atomA[$i]] ++ if (@name[@atomB[$i]] eq "O"); + @aldehyde[@atomB[$i]] ++ if (@name[@atomA[$i]] eq "O"); + } -# Create a new PostScript object -$im = new GD::Image($width,$height); -$white = $im->colorAllocate(255,255,255); -$black = $im->colorAllocate(0,0,0); -$gray = $im->colorAllocate(200,200,200); -#$gdAntiAliased = $im->colorAllocate(1,1,1); -$im->setAntiAliased($black); + } + # Draw bonds -$doubleWidth = 0.10*$scale; -$tripleWidth = 0.15*$scale; - -for ($i = 0; $i < $nbonds; $i++) { - $xa = @x[@atomA[$i]]; - $ya = @y[@atomA[$i]]; - $xb = @x[@atomB[$i]]; - $yb = @y[@atomB[$i]]; - - if (@bondType[$i] != 1) { - $dx = $xb-$xa; - $dy = $yb-$ya; - $dd = sqrt($dx*$dx + $dy*$dy); - $sina=$dy/$dd; - $cosa=$dx/$dd; - } - if (@bondType[$i] == -2) { - for ($t = 0; $t <= 1; $t += 0.1) { - $xab = $xa + $t*$dx; - $yab = $ya + $t*$dy; - $xperp = $tripleWidth*$sina*$t; - $yperp = $tripleWidth*$cosa*$t; - $im->line($xab+$xperp,$height-($yab-$yperp), - $xab-$xperp,$height-($yab+$yperp), - gdAntiAliased); - } - } - elsif (@bondType[$i] == -1) { - $xperp = $tripleWidth*$sina; - $yperp = $tripleWidth*$cosa; - $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 (@bondType[$i] == 1) { - $im->line($xa,$height-$ya,$xb,$height-$yb,gdAntiAliased); - } - elsif (@bondType[$i] == 2 && - ((@adjacent[@atomA[$i]] == 1 && @adjacent[@atomB[$i]] > 2)|| - (@adjacent[@atomB[$i]] == 1 && @adjacent[@atomA[$i]] > 2))) { - # centered bond - $xperp = $doubleWidth*$sina; - $yperp = $doubleWidth*$cosa; - $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 (@bondType[$i] == 2) { - $xperp = 2*$doubleWidth*$sina; - $yperp = 2*$doubleWidth*$cosa; - $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 (@bondType[$i] == 3) { - $xperp = $tripleWidth*$sina; - $yperp = $tripleWidth*$cosa; - $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); - } -} + 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) { + 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] == 2 && + (($adjacent[$atomA[$i]] == 1 && $adjacent[$atomB[$i]] > 2)|| + ($adjacent[$atomB[$i]] == 1 && $adjacent[$atomA[$i]] > 2)|| + @name[@atomA[$i]] eq "O" || @name[@atomB[$i]] eq "O")) { + # 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] == 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 -%valence = ("C",4,"N",3,"P",3,"O",2,"S",2); - -$font = '/usr/share/fonts/default/Type1/n021003l.pfb'; -$pointsize = 20; -@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 ($i = 0; $i < $natoms; $i++) { - my ($formula,$sign,$charge) = - (@name[$i] =~ /(\w+)([\+|\-])?(\d)?/); - $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 - $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); - @formula = $formula=~ /[A-Z][a-z]?\d*/g; - - $PI = 3.1415; - if (abs(@bondsy[$i]) < 0.01 && abs(@bondsx[$i]) < 0.01) { - $bondAngle = -$PI; - } - else { - $bondAngle = atan2(@bondsy[$i],@bondsx[$i]); - } - - 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 ($formula ne "C" || $sign ne ""|| + $adjacent[$i] < 2 || ($adjacent[$i] == 2 && $bonds[$i] == 4) || (@aldehyde[$i] == 1 && @bonds[$i] == 3)) { + # don't show C, unless charged, terminal, or linear + if (exists $electrons{$formula}) { + # add H atoms to satisfy minimum valence + my $e = $electrons{$formula}; + $e -= (($charge eq "")? 1 : $charge) if ($sign eq "+"); + $e += (($charge eq "")? 1 : $charge) if ($sign eq "-"); + my $valence = 4 - abs($e-4); + my $nH = $valence - @bonds[$i]; + $formula .= "H" if ($nH > 0); + $formula .= $nH if ($nH > 1); } - elsif ($bondAngle > $PI/4 && $bondAngle < 3*$PI/4) { - $direction = "d"; + 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*)/; - $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 ""); - } - elsif ($direction eq "l") { # direction = left, reverse hydrogens - @formula[0] =~ /([A-Z][a-z]?)(\d*)/; - $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*)/; - $carrige = @x[$i]-stringWidth($1)/2; - $carrige = printElement ($1,$2,$carrige,@y[$i]); - $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*)/; - $carrige = @x[$i]-stringWidth($1)/2; - $carrige = printElement ($1,$2,$carrige,@y[$i]); - $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); + 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 ""); + } + 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 ""); + } + 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 ($loncapa) { + if ($png) { # make sure we are writing to a binary stream -binmode STDOUT; + binmode STDOUT; # Convert the image to PNG and print it on standard output -print "Content-type: image/png\n\n"; -print $im->png; + print "Content-type: image/png\n\n"; + print $im->png; + } elsif ($ps) { + my $psfile = "/home/httpd/perl/tmp/".$id.'.eps'; + $im->output($psfile); + print "Content-type: text/html\n\n"; + print (< + + Wrote eps file $psfile + + +HTML + } +} else { + if ($png) { +# make sure we are writing to a binary stream + binmode STDOUT; +# Convert the image to PNG and print it on standard output + print $im->png; + } elsif ($ps) { + $im->output("file.ps"); + } +} + sub stringWidth { my ($string) = @_; my $width = 0; while ($string =~ /[A-Za-z]/g) { - my @bounds = GD::Image->stringTTF($black,$font,$ptsize,0,0,0,$&); - $width += @bounds[2]-@bounds[0]+2; + if ($png) { + my @bounds = GD::Image->stringTTF($black,$font,$ptsize,0,0,0,$&); + $width += $bounds[2]-$bounds[0]+2; + } elsif ($ps) { + $width += fm2cm($font_width{$&}); + } } while ($string =~ /[\d+-]/g) { - my @bounds = GD::Image->stringTTF($black,$font,0.6*$ptsize,0,0,0,$&); - $width += @bounds[2]-@bounds[0]+2; + if ($png) { + my @bounds=GD::Image->stringTTF($black,$font,0.6*$ptsize,0,0,0,$&); + $width += $bounds[2]-$bounds[0]+2; + } elsif ($ps) { + $width += fm2cm(0.6*$font_width{$&}); + } } return $width; @@ -284,84 +481,165 @@ sub fm2cm { #font metrics to cm return $scale*(2.54/72)*$pointsize*$fm/1000; } -sub printElement { #element symbol + optional subscript +sub printElement { + if ($png) { + return &printElement_png(@_); + } elsif ($ps) { + return &printElement_ps(@_); + } +} + +sub printElement_png { #element symbol + optional subscript my ($element,$subscript,$x,$y) = @_; - $yy = 662; + my $yy = 662; my @bounds = GD::Image->stringTTF($black,$font,$ptsize,0, $x,$height-($y+fm2cm(-$yy/2)),$element); $im->filledRectangle( - @bounds[6]-1,@bounds[7]-fm2cm(135), - @bounds[2]+1,@bounds[3]+fm2cm(135),$white); + $bounds[6]-1,$bounds[7]-fm2cm(135), + $bounds[2]+1,$bounds[3]+fm2cm(135),$white); $im->stringTTF($black,$font,$ptsize,0, $x,$height-($y+fm2cm(-$yy/2)),$element); - $x = @bounds[2] + 1; + $x = $bounds[2] + 1; if ($subscript ne "") { @bounds = GD::Image->stringTTF($black,$font,0.6*$ptsize,0, $x,$height-($y+fm2cm(-0.8*$yy)),$subscript); $im->filledRectangle( - @bounds[6]-1,@bounds[7]-fm2cm(45), - @bounds[2]+1,@bounds[3]+fm2cm(45),$white); + $bounds[6]-1,$bounds[7]-fm2cm(45), + $bounds[2]+1,$bounds[3]+fm2cm(45),$white); $im->stringTTF($black,$font,0.6*$ptsize,0, $x,$height-($y+fm2cm(-0.8*$yy)),$subscript); } - $x = @bounds[2] + 1; + $x = $bounds[2] + 1; +} + +sub printElement_ps { #element symbol + optional subscript + my ($element,$subscript,$x,$y) = @_; + $height = 662; + + $im->setcolour("white"); + $im->box({filled=>1}, + $x+fm2cm(-30),$y+fm2cm(-$height/2-150), + $x+stringWidth($element)+fm2cm(50),$y+fm2cm(+$height/2+150)); + $im->setcolour("black"); + $im->setfont("Times-Roman",$pointsize); + $im->text($x,$y+fm2cm(-$height/2),$element); + $x += stringWidth($element); + + if ($subscript ne "") { + $im->setcolour("white"); + $im->box({filled=>1}, + $x,$y+fm2cm(-0.8*$height-45), + $x+stringWidth($subscript)+fm2cm(50),$y+fm2cm(-0.2*$height+45)); + $im->setcolour("black"); + $im->setfont("Times-Roman",0.6*$pointsize); + $im->text($x,$y+fm2cm(-0.8*$height),$subscript); + } + $x += stringWidth($subscript); } sub printCharge { + if ($png) { + return &printCharge_png(@_); + } elsif ($ps) { + return &printCharge_ps(@_); + } +} + +sub printCharge_png { my ($sign,$charge,$x,$y) = @_; - $yy = 662; + my $yy = 662; + $sign = "–" if ($sign eq "-"); # replace by n-dash $charge = "" if ($charge == 1); $charge .= $sign; my @bounds = GD::Image->stringTTF($black,$font,0.6*$ptsize,0, $x,$height-($y+fm2cm(0.2*$yy)),$charge); $im->filledRectangle( - @bounds[6]-1,@bounds[7]-fm2cm(45), - @bounds[2]+1,@bounds[3]+fm2cm(45),$white); + $bounds[6]-1,$bounds[7]-fm2cm(45), + $bounds[2]+1,$bounds[3]+fm2cm(45),$white); $im->stringTTF($black,$font,0.6*$ptsize,0,$x,$height-($y+fm2cm(0.2*$yy)),$charge); - $x = @bounds[2] + 1; + $x = $bounds[2] + 1; +} + +sub printCharge_ps { + my ($sign,$charge,$x,$y) = @_; + $height = 662; + + $charge = "" if ($charge == 1); + $charge .= $sign; + + $im->setcolour("white"); + $im->box({filled=>1}, + $x,$y+fm2cm(0.2*$height-45), + $x+stringWidth($charge)+fm2cm(50),$y+fm2cm(0.8*$height+45)); + + if ($sign eq "-") { # replace by n-dash + chop $charge; + $charge .= "\xb1"; + } + $im->setcolour("black"); + $im->setfont("Times-Roman",0.6*$pointsize); + $im->text($x,$y+fm2cm(0.2*$height),$charge); + $x += stringWidth($charge); +} + +sub determine_size { +# Find border + 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 = 0; $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; + if ($png) { + $scale = $width / ($xmax-$xmin+3+$maxName); + } elsif ($ps) { + $scale = 1; + } + 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)=@_; + $struct=~s/^\s*//; + $struct=~s/\s*$//; + 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; + } } -sub dienice { - my($errmsg) = @_; - print "Content-type: text/html\n\n"; - print "

Error

\n"; - print "$errmsg

\n"; - print "\n"; - system("/bin/rm temp/$SNUM.*"); - exit; -} - -sub read_input -{ - local ($buffer, @pairs, $pair, $name, $value, %FORM); - # Read in text - $ENV{'REQUEST_METHOD'} =~ tr/a-z/A-Z/; - if ($ENV{'REQUEST_METHOD'} eq "POST") - { - read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); - } else - { - $buffer = $ENV{'QUERY_STRING'}; - } - # Split information into name/value pairs - @pairs = split(/&/, $buffer); - foreach $pair (@pairs) - { - ($name, $value) = split(/=/, $pair); - $value =~ tr/+/ /; - $value =~ s/%(..)/pack("C", hex($1))/eg; - $FORM{$name} = $value; - } - %FORM; -} - -#while (($key,$value) = each %ENV) { -# print "$key = $value
\n"; -#} -#open(STDERR,">errorlog");