--- loncom/homework/convertjme.pl 2003/10/16 20:16:42 1.2
+++ loncom/homework/convertjme.pl 2003/10/18 06:51:08 1.5
@@ -1,11 +1,39 @@
#!/usr/bin/perl
-
+# The LearningOnline Network with CAPA
+# Dynamically converts JME strings into either a png or ps file.
+#
+# $Id: convertjme.pl,v 1.5 2003/10/18 06:51:08 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 strict;
use lib '/home/httpd/lib/perl';
use GD;
+use PostScript::Simple;
use LONCAPA::loncgi();
if (! &LONCAPA::loncgi::check_cookie_and_load_env()) {
@@ -30,274 +58,340 @@ 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 = 200; }
+if (!$width) { $width = 400; }
+my $png = $ENV{'cgi.'.$id.'.PNG'};
+my $ps = $ENV{'cgi.'.$id.'.PS'};
-# parse JME string
+#get objects
+my ($reactants,$solution,$products)=split('>',&unescape($ENV{'cgi.'.$id.'.JME'}));
+
+my @reactant_structs=split(/\|/,$reactants);
+my @solution_structs=split(/\|/,$solution);
+my @product_structs=split(/\|/,$products);
+
+my $draw_arrow;
+if (@solution_structs || @product_structs) { $draw_arrow=1; }
-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 @all_structs=(@reactant_structs,@solution_structs,@product_structs);
+
+#get size of image and initialize image and globals
+my ($xmin,$xmax,$ymin,$ymax,$maxName,$height,$scale) =
+ &determine_size(@all_structs);
+
+
+# Create a new PostScript object
+my ($im,$white,$black,$gray);
+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 (@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 %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) {
+ $doubleWidth = 0.10*$scale;
+ $tripleWidth = 0.15*$scale;
+} elsif ($ps) {
+ $doubleWidth = 0.10;
+ $tripleWidth = 0.15;
}
-# Find border and move lower left corner to (1.5,1.0)
-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);
- @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);
+
+ 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;
+ 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]]++;
+ @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 = new GD::Image($width,$height);
-my $white = $im->colorAllocate(255,255,255);
-my $black = $im->colorAllocate(0,0,0);
-my $gray = $im->colorAllocate(200,200,200);
-#$gdAntiAliased = $im->colorAllocate(1,1,1);
-$im->setAntiAliased($black);
+ @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
-my $doubleWidth = 0.10*$scale;
-my $tripleWidth = 0.15*$scale;
-
-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;
- $im->line($xab+$xperp,$height-($yab-$yperp),
- $xab-$xperp,$height-($yab+$yperp),
- gdAntiAliased);
- }
- }
- elsif (@bondType[$i] == -1) {
- my $xperp = $tripleWidth*$sina;
- my $yperp = $tripleWidth*$cosa;
- 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 (@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
- my $xperp = $doubleWidth*$sina;
- my $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) {
- my $xperp = 2*$doubleWidth*$sina;
- my $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) {
- my $xperp = $tripleWidth*$sina;
- my $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))) {
+ # 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
-my %valence = ("C",4,"N",3,"P",3,"O",2,"S",2);
-
-my $font = '/usr/share/fonts/default/Type1/n021003l.pfb';
-my $pointsize = 20;
-my @bounds = GD::Image->stringTTF($black,$font,100,0,0,0,"H");
-my $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)?/);
- $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 "-");
+ }
+ $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 = "d";
+ else {
+ $bondAngle = atan2(@bondsy[$i],@bondsx[$i]);
}
- elsif ($bondAngle < -$PI/4 && $bondAngle > -3*$PI/4) {
- $direction = "u";
+
+ 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;
+ 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 (<<HTML)
+<html>
+<body>
+Wrote eps file $psfile
+</body>
+</html>
+HTML
+}
+
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 += $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 += 0.6*$font_width{$&};
+ }
}
return $width;
@@ -305,10 +399,22 @@ sub stringWidth {
sub fm2cm { #font metrics to cm
my ($fm) = @_;
- return $scale*(2.54/72)*$pointsize*$fm/1000;
+ if ($png) {
+ return $scale*(2.54/72)*$pointsize*$fm/1000;
+ } elsif ($ps) {
+ return (2.54/72)*$pointsize*$fm/1000;
+ }
+}
+
+sub printElement {
+ if ($png) {
+ return &printElement_png(@_);
+ } elsif ($ps) {
+ return &printElement_ps(@_);
+ }
}
-sub printElement { #element symbol + optional subscript
+sub printElement_png { #element symbol + optional subscript
my ($element,$subscript,$x,$y) = @_;
my $yy = 662;
@@ -334,7 +440,40 @@ sub printElement { #element symbol + op
$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+fm2cm(stringWidth($element)+50),$y+fm2cm(+$height/2+150));
+ $im->setcolour("black");
+ $im->setfont("Times-Roman",$pointsize);
+ $im->text($x,$y+fm2cm(-$height/2),$element);
+ $x += fm2cm(stringWidth($element));
+
+ if ($subscript ne "") {
+ $im->setcolour("white");
+ $im->box({filled=>1},
+ $x,$y+fm2cm(-0.8*$height-45),
+ $x+fm2cm(stringWidth($subscript)+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 += fm2cm(stringWidth($subscript));
+}
+
sub printCharge {
+ if ($png) {
+ return &printCharge_png(@_);
+ } elsif ($ps) {
+ return &printCharge_ps(@_);
+ }
+}
+
+sub printCharge_png {
my ($sign,$charge,$x,$y) = @_;
my $yy = 662;
@@ -351,5 +490,73 @@ sub printCharge {
$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+fm2cm(stringWidth($charge)+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 += 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;
+ }
+}