--- loncom/homework/convertjme.pl 2003/10/16 19:46:36 1.1 +++ loncom/homework/convertjme.pl 2003/10/16 20:16:42 1.2 @@ -3,27 +3,50 @@ # 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 LONCAPA::loncgi(); -# read the width and the JME string from the cgi query -%data = &read_input; -@JMEstring = split (/ /,$data{JME}); -$width = $data{WIDTH}; +if (! &LONCAPA::loncgi::check_cookie_and_load_env()) { + print < +Bad Cookie + +Your cookie information is incorrect. + + +END + exit; +} -#print "Content-type: text/plain\n\n"; +sub unescape { + my $str=shift; + $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; + return $str; +} -# parse JME string +# 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; } -$natoms= shift @JMEstring; -$nbonds= shift @JMEstring; +# parse JME string -for ($i = 0; $i < $natoms; $i++) { +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; } -for ($i = 0; $i < $nbonds; $i++) { +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; @@ -31,11 +54,11 @@ for ($i = 0; $i < $nbonds; $i++) { # Find border and move lower left corner to (1.5,1.0) -$xmin = $xmax = @x[0]; -$ymin = $ymax = $y[0]; -$maxName = 0; +my $xmin = my $xmax = @x[0]; +my $ymin = my $ymax = $y[0]; +my $maxName = 0; -for ($i = 1; $i < $natoms; $i++) { +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); @@ -44,11 +67,10 @@ for ($i = 1; $i < $natoms; $i++) { $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); -$scale = $width / ($xmax-$xmin+3+$maxName); -$height = $scale * ($ymax-$ymin+2); - -for ($i = 0; $i < $natoms; $i++) { +for (my $i = 0; $i < $natoms; $i++) { @x[$i] += (1.5+$maxName/2-$xmin); @x[$i] *= $scale; @y[$i] += (1.0-$ymin); @@ -57,11 +79,11 @@ for ($i = 0; $i < $natoms; $i++) { # 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++) { +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; @@ -75,45 +97,46 @@ for ($i = 0; $i < $nbonds; $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); +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); # Draw bonds -$doubleWidth = 0.10*$scale; -$tripleWidth = 0.15*$scale; +my $doubleWidth = 0.10*$scale; +my $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]]; +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; - $dd = sqrt($dx*$dx + $dy*$dy); + my $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; + 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) { - $xperp = $tripleWidth*$sina; - $yperp = $tripleWidth*$cosa; - $poly = new GD::Polygon; + 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)); @@ -126,8 +149,8 @@ for ($i = 0; $i < $nbonds; $i++) { ((@adjacent[@atomA[$i]] == 1 && @adjacent[@atomB[$i]] > 2)|| (@adjacent[@atomB[$i]] == 1 && @adjacent[@atomA[$i]] > 2))) { # centered bond - $xperp = $doubleWidth*$sina; - $yperp = $doubleWidth*$cosa; + my $xperp = $doubleWidth*$sina; + my $yperp = $doubleWidth*$cosa; $im->line($xa+$xperp,$height-($ya-$yperp), $xb+$xperp,$height-($yb-$yperp), gdAntiAliased); @@ -136,16 +159,16 @@ for ($i = 0; $i < $nbonds; $i++) { gdAntiAliased); } elsif (@bondType[$i] == 2) { - $xperp = 2*$doubleWidth*$sina; - $yperp = 2*$doubleWidth*$cosa; + 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) { - $xperp = $tripleWidth*$sina; - $yperp = $tripleWidth*$cosa; + 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), @@ -158,14 +181,14 @@ for ($i = 0; $i < $nbonds; $i++) { # Write labels -%valence = ("C",4,"N",3,"P",3,"O",2,"S",2); +my %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]); +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 ($i = 0; $i < $natoms; $i++) { +for (my $i = 0; $i < $natoms; $i++) { my ($formula,$sign,$charge) = (@name[$i] =~ /(\w+)([\+|\-])?(\d)?/); $sign = "–" if ($sign eq "-"); # replace by n-dash @@ -173,7 +196,7 @@ for ($i = 0; $i < $natoms; $i++) { 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; + my $nH = 0; if (exists $valence{$formula}) { $nH = $valence{$formula} - @bonds[$i]; $nH += (($charge eq "")? 1 : $charge) if ($sign eq "+"); @@ -181,9 +204,10 @@ for ($i = 0; $i < $natoms; $i++) { } $formula .= "H" if ($nH > 0); $formula .= $nH if ($nH > 1); - @formula = $formula=~ /[A-Z][a-z]?\d*/g; + my @formula = $formula=~ /[A-Z][a-z]?\d*/g; - $PI = 3.1415; + my $PI = 3.1415; + my $bondAngle; if (abs(@bondsy[$i]) < 0.01 && abs(@bondsx[$i]) < 0.01) { $bondAngle = -$PI; } @@ -191,6 +215,7 @@ for ($i = 0; $i < $natoms; $i++) { $bondAngle = atan2(@bondsy[$i],@bondsx[$i]); } + my $direction; if (@adjacent[$i] < 2) { $direction = (@bondsx[$i] < 0.01) ? "r" : "l"; } @@ -211,7 +236,7 @@ for ($i = 0; $i < $natoms; $i++) { if ($direction eq "r") { # direction = right @formula[0] =~ /([A-Z][a-z]?)(\d*)/; - $carrige = @x[$i]-stringWidth($1)/2; + my $carrige = @x[$i]-stringWidth($1)/2; foreach (@formula) { $_ =~ /([A-Z][a-z]?)(\d*)/; $carrige = printElement ($1,$2,$carrige,@y[$i]); @@ -220,7 +245,7 @@ for ($i = 0; $i < $natoms; $i++) { } elsif ($direction eq "l") { # direction = left, reverse hydrogens @formula[0] =~ /([A-Z][a-z]?)(\d*)/; - $carrige = @x[$i]+ + my $carrige = @x[$i]+ stringWidth($1)/2+stringWidth($2)-stringWidth($formula); foreach (reverse @formula) { $_ =~ /([A-Z][a-z]?)(\d*)/; @@ -230,9 +255,9 @@ for ($i = 0; $i < $natoms; $i++) { } elsif ($direction eq "u") { # direction = up (shift @formula) =~ /([A-Z][a-z]?)(\d*)/; - $carrige = @x[$i]-stringWidth($1)/2; + my $carrige = @x[$i]-stringWidth($1)/2; $carrige = printElement ($1,$2,$carrige,@y[$i]); - $y = (@formula > 0) ? @y[$i] + fm2cm(800) : @y[$i]; + my $y = (@formula > 0) ? @y[$i] + fm2cm(800) : @y[$i]; $carrige = (@formula > 0) ? @x[$i]-stringWidth($1)/2 : $carrige; foreach (@formula) { @@ -243,9 +268,9 @@ for ($i = 0; $i < $natoms; $i++) { } else { # direction = down (shift @formula) =~ /([A-Z][a-z]?)(\d*)/; - $carrige = @x[$i]-stringWidth($1)/2; + my $carrige = @x[$i]-stringWidth($1)/2; $carrige = printElement ($1,$2,$carrige,@y[$i]); - $y = (@formula > 0) ? @y[$i] + fm2cm(-800) : @y[$i]; + my $y = (@formula > 0) ? @y[$i] + fm2cm(-800) : @y[$i]; $carrige = (@formula > 0) ? @x[$i]-stringWidth($1)/2 : $carrige; foreach (@formula) { @@ -255,7 +280,6 @@ for ($i = 0; $i < $natoms; $i++) { printCharge ($sign,$charge,$carrige,$y) if ($sign ne ""); } } - } # make sure we are writing to a binary stream @@ -286,7 +310,7 @@ sub fm2cm { #font metrics to cm sub printElement { #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); @@ -312,7 +336,7 @@ sub printElement { #element symbol + op sub printCharge { my ($sign,$charge,$x,$y) = @_; - $yy = 662; + my $yy = 662; $charge = "" if ($charge == 1); $charge .= $sign; @@ -327,41 +351,5 @@ sub printCharge { $x = @bounds[2] + 1; } -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");