[LON-CAPA-cvs] cvs: loncom /homework convertjme.pl
albertel
lon-capa-cvs@mail.lon-capa.org
Thu, 16 Oct 2003 19:46:37 -0000
This is a MIME encoded message
--albertel1066333597
Content-Type: text/plain
albertel Thu Oct 16 15:46:37 2003 EDT
Added files:
/loncom/homework convertjme.pl
Log:
- adding Guy A. conversion script
--albertel1066333597
Content-Type: text/plain
Content-Disposition: attachment; filename="albertel-20031016154637.txt"
Index: loncom/homework/convertjme.pl
+++ loncom/homework/convertjme.pl
#!/usr/bin/perl
# Coded by Guy Ashkenazi, guy@fh.huji.ac.il
# Based on the work of Peter Ertl, peter.ertl@pharma.novartis.com
use GD;
# read the width and the JME string from the cgi query
%data = &read_input;
@JMEstring = split (/ /,$data{JME});
$width = $data{WIDTH};
#print "Content-type: text/plain\n\n";
# parse JME string
$natoms= shift @JMEstring;
$nbonds= shift @JMEstring;
for ($i = 0; $i < $natoms; $i++) {
@name[$i] = shift @JMEstring;
@x[$i] = shift @JMEstring;
@y[$i] = shift @JMEstring;
}
for ($i = 0; $i < $nbonds; $i++) {
@atomA[$i] = (shift @JMEstring)-1;
@atomB[$i] = (shift @JMEstring)-1;
@bondType[$i] = shift @JMEstring;
}
# Find border and move lower left corner to (1.5,1.0)
$xmin = $xmax = @x[0];
$ymin = $ymax = $y[0];
$maxName = 0;
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);
}
$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;
}
# 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;
@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
$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);
}
}
# 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";
}
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);
}
printCharge ($sign,$charge,$carrige,$y) if ($sign ne "");
}
}
}
# 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;
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;
}
while ($string =~ /[\d+-]/g) {
my @bounds = GD::Image->stringTTF($black,$font,0.6*$ptsize,0,0,0,$&);
$width += @bounds[2]-@bounds[0]+2;
}
return $width;
}
sub fm2cm { #font metrics to cm
my ($fm) = @_;
return $scale*(2.54/72)*$pointsize*$fm/1000;
}
sub printElement { #element symbol + optional subscript
my ($element,$subscript,$x,$y) = @_;
$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 printCharge {
my ($sign,$charge,$x,$y) = @_;
$yy = 662;
$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 dienice {
my($errmsg) = @_;
print "Content-type: text/html\n\n";
print "<h2>Error</h2>\n";
print "$errmsg<p>\n";
print "</body></html>\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<br>\n";
#}
#open(STDERR,">errorlog");
--albertel1066333597--