Bad Cookie

#!/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 < Bad Cookie Your cookie information is incorrect. 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 (< 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) { 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; } }