File:
[LON-CAPA] /
loncom /
homework /
convertjme.pl
Revision
1.15:
download - view:
text,
annotated -
select for diffs
Wed May 25 22:31:51 2005 UTC (19 years, 3 months ago) by
albertel
Branches:
MAIN
CVS tags:
version_2_9_X,
version_2_9_99_0,
version_2_9_1,
version_2_9_0,
version_2_8_X,
version_2_8_99_1,
version_2_8_99_0,
version_2_8_2,
version_2_8_1,
version_2_8_0,
version_2_7_X,
version_2_7_99_1,
version_2_7_99_0,
version_2_7_1,
version_2_7_0,
version_2_6_X,
version_2_6_99_1,
version_2_6_99_0,
version_2_6_3,
version_2_6_2,
version_2_6_1,
version_2_6_0,
version_2_5_X,
version_2_5_99_1,
version_2_5_99_0,
version_2_5_2,
version_2_5_1,
version_2_5_0,
version_2_4_X,
version_2_4_99_0,
version_2_4_2,
version_2_4_1,
version_2_4_0,
version_2_3_X,
version_2_3_99_0,
version_2_3_2,
version_2_3_1,
version_2_3_0,
version_2_2_X,
version_2_2_99_1,
version_2_2_99_0,
version_2_2_2,
version_2_2_1,
version_2_2_0,
version_2_1_X,
version_2_1_99_3,
version_2_1_99_2,
version_2_1_99_1,
version_2_1_99_0,
version_2_1_3,
version_2_1_2,
version_2_1_1,
version_2_1_0,
version_2_10_X,
version_2_10_1,
version_2_10_0_RC2,
version_2_10_0_RC1,
version_2_10_0,
version_2_0_X,
version_2_0_99_1,
version_2_0_2,
version_2_0_1,
version_2_0_0,
version_1_99_3,
version_1_99_2,
version_1_99_1,
version_1_99_0,
loncapaMITrelate_1,
bz6209-base,
bz6209,
bz5969,
bz2851,
PRINT_INCOMPLETE_base,
PRINT_INCOMPLETE,
HEAD,
GCI_3,
GCI_2,
GCI_1,
BZ5971-printing-apage,
BZ5434-fox
- some more $ENV -> $env ceanups
#!/usr/bin/perl
# The LearningOnline Network with CAPA
# Dynamically converts JME strings into either a png or ps file.
#
# $Id: convertjme.pl,v 1.15 2005/05/25 22:31:51 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;
### 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;
use GD;
use PostScript::Simple;
if ($loncapa) {
if (! &LONCAPA::loncgi::check_cookie_and_load_env()) {
print <<END;
Content-type: text/html
<html>
<head><title>Bad Cookie</title></head>
<body>
Your cookie information is incorrect.
</body>
</html>
END
exit;
}
}
sub unescape {
my $str=shift;
$str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
return $str;
}
# read the width and the JME string from the cgi query
my ($id,$width,$ps,$png,@JMEstring);
if ($loncapa) {
$id=$ENV{'QUERY_STRING'};
$width = $Apache::lonnet::env{'cgi.'.$id.'.WIDTH'};
if (!$width) { $width = 400; }
$png = $Apache::lonnet::env{'cgi.'.$id.'.PNG'};
$ps = $Apache::lonnet::env{'cgi.'.$id.'.PS'};
@JMEstring=&unescape($Apache::lonnet::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;
}
# 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 = '/home/httpd/html/adm/fonts/DejaVuSerif-Roman.ttf';
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;
# Draw arrow
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));
}
}
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
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]]++;
$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");
}
}
# 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) {
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
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);
}
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";
}
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]);
}
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(900) : $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(-900) : $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 "");
}
}
}
}
if ($loncapa) {
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 "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
}
} 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) {
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) {
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;
}
sub fm2cm { #font metrics to cm
my ($fm) = @_;
return $scale*(2.54/72)*$pointsize*$fm/1000;
}
sub printElement {
if ($png) {
return &printElement_png(@_);
} elsif ($ps) {
return &printElement_ps(@_);
}
}
sub printElement_png { #element symbol + optional subscript
my ($element,$subscript,$x,$y) = @_;
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);
$im->stringTTF($black,$font,$ptsize,0,
$x,$height-($y+fm2cm(-$yy/2)),$element);
$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);
$im->stringTTF($black,$font,0.6*$ptsize,0,
$x,$height-($y+fm2cm(-0.8*$yy)),$subscript);
}
$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) = @_;
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);
$im->stringTTF($black,$font,0.6*$ptsize,0,$x,$height-($y+fm2cm(0.2*$yy)),$charge);
$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;
}
}
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>