[BACK]Return to convertjme.pl CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / homework

Diff for /loncom/homework/convertjme.pl between versions 1.1 and 1.16

version 1.1, 2003/10/16 19:46:36 version 1.16, 2011/07/04 09:24:54
Line 1 Line 1
 #!/usr/bin/perl  #!/usr/bin/perl
   # The LearningOnline Network with CAPA
   # Dynamically converts JME strings into either a png or ps file.
   #
   # $Id$
   #
   # 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  # Coded by Guy Ashkenazi, guy@fh.huji.ac.il
 # Based on the work of Peter Ertl, peter.ertl@pharma.novartis.com  # Based on the work of Peter Ertl, peter.ertl@pharma.novartis.com
   
 use GD;  use strict;
   
 # 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";   ### 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 LONCAPA;
   
 # parse JME string  use GD;
   use PostScript::Simple;
   
 $natoms= shift @JMEstring;  if ($loncapa) {
 $nbonds= shift @JMEstring;      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;
       }
   }
   
 for ($i = 0; $i < $natoms; $i++) {  sub unescape {
     @name[$i] = shift @JMEstring;      my $str=shift;
     @x[$i] = shift @JMEstring;      $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
     @y[$i] = shift @JMEstring;      return $str;
 }  }
   
 for ($i = 0; $i < $nbonds; $i++) {  # read the width and the JME string from the cgi query
     @atomA[$i] = (shift @JMEstring)-1;  my ($id,$width,$ps,$png,@JMEstring);
     @atomB[$i] = (shift @JMEstring)-1;  if ($loncapa) {
     @bondType[$i] = shift @JMEstring;      $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;
 }  }
   
 # Find border and move lower left corner to (1.5,1.0)  # 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;
   
 $xmin = $xmax = @x[0];  # Draw arrow
 $ymin = $ymax = $y[0];  
 $maxName = 0;  
   
 for ($i = 1; $i < $natoms; $i++) {  if ($draw_arrow) {
     $xmax = @x[$i] if (@x[$i] > $xmax);      my $dx = $arrow_x2 - $arrow_x1;
     $xmin = @x[$i] if (@x[$i] < $xmin);      if ($png) {
     $ymax = @y[$i] if (@y[$i] > $ymax);   $im->line($arrow_x1+0.25*$dx,$height-$arrow_y,
     $ymin = @y[$i] if (@y[$i] < $ymin);    $arrow_x2-0.25*$dx,$height-$arrow_y,
     @name[$i] =~ /(\@{1,2})?(\w+)([\+|\-])?(\d)?/;    $gdAntiAliased);
     $maxName = length $2 if (length $2 > $maxName);   $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));
       }
 }  }
 $maxName = ($maxName-3 < 0) ? 0 : $maxName-3;  
   
 $scale = $width / ($xmax-$xmin+3+$maxName);  
 $height = $scale * ($ymax-$ymin+2);  
   
 for ($i = 0; $i < $natoms; $i++) {  foreach my $struct (@all_structs) {
     @x[$i] += (1.5+$maxName/2-$xmin);  
     @x[$i] *= $scale;      my (@name,@x,@y,@atomA,@atomB,@bondType,$natoms,$nbonds);
     @y[$i] += (1.0-$ymin);      &parse_struct($struct,\@name,\@x,\@y,\@atomA,\@atomB,\@bondType);
     @y[$i] *= $scale;      $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  # Count bonds
   
 @bonds = map {0} 0..$natoms-1;      my @bonds = map {0} 0..$natoms-1;
 @adjacent = map {0} 0..$natoms-1;      my @adjacent = map {0} 0..$natoms-1;
 @bondsx = map {0} 0..$natoms-1;      my @bondsx = map {0} 0..$natoms-1;
 @bondsy = map {0} 0..$natoms-1;      my @bondsy = map {0} 0..$natoms-1;
 for ($i = 0; $i < $nbonds; $i++) {      my @aldehyde = map {0} 0..$natoms-1;
     @bonds[@atomA[$i]] += (@bondType[$i]>0) ? @bondType[$i] : 1;      for (my $i = 0; $i < $nbonds; $i++) {
     @bonds[@atomB[$i]] += (@bondType[$i]>0) ? @bondType[$i] : 1;   $bonds[$atomA[$i]] += ($bondType[$i]>0) ? $bondType[$i] : 1;
    $bonds[$atomB[$i]] += ($bondType[$i]>0) ? $bondType[$i] : 1;
   
     @adjacent[@atomA[$i]]++;   $adjacent[$atomA[$i]]++;
     @adjacent[@atomB[$i]]++;   $adjacent[$atomB[$i]]++;
           
     @bondsx[@atomA[$i]] += @x[@atomB[$i]] - @x[@atomA[$i]];   $bondsx[$atomA[$i]] += $x[$atomB[$i]] - $x[$atomA[$i]];
     @bondsy[@atomA[$i]] += @y[@atomB[$i]] - @y[@atomA[$i]];   $bondsy[$atomA[$i]] += $y[$atomB[$i]] - $y[$atomA[$i]];
     @bondsx[@atomB[$i]] += @x[@atomA[$i]] - @x[@atomB[$i]];   $bondsx[$atomB[$i]] += $x[$atomA[$i]] - $x[$atomB[$i]];
     @bondsy[@atomB[$i]] += @y[@atomA[$i]] - @y[@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");
    }
   
 # 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  # Draw bonds
 $doubleWidth = 0.10*$scale;      for (my $i = 0; $i < $nbonds; $i++) {
 $tripleWidth = 0.15*$scale;   my $xa = $x[$atomA[$i]];
    my $ya = $y[$atomA[$i]];
 for ($i = 0; $i < $nbonds; $i++) {   my $xb = $x[$atomB[$i]];
     $xa = @x[@atomA[$i]];   my $yb = $y[$atomB[$i]];
     $ya = @y[@atomA[$i]];  
     $xb = @x[@atomB[$i]];   my ($sina,$cosa,$dx,$dy);
     $yb = @y[@atomB[$i]];   if ($bondType[$i] != 1) {
       $dx = $xb-$xa;
     if (@bondType[$i] != 1) {      $dy = $yb-$ya;
         $dx = $xb-$xa;      my $dd = sqrt($dx*$dx + $dy*$dy);
  $dy = $yb-$ya;      $sina=$dy/$dd;
         $dd = sqrt($dx*$dx + $dy*$dy);      $cosa=$dx/$dd;
         $sina=$dy/$dd;   }
         $cosa=$dx/$dd;   if    ($bondType[$i] == -2) {
     }      for (my $t = 0; $t <= 1; $t += 0.1) {
     if    (@bondType[$i] == -2) {   my $xab = $xa + $t*$dx; 
  for ($t = 0; $t <= 1; $t += 0.1) {   my $yab = $ya + $t*$dy; 
     $xab = $xa + $t*$dx;    my $xperp = $tripleWidth*$sina*$t;
     $yab = $ya + $t*$dy;    my $yperp = $tripleWidth*$cosa*$t;
     $xperp = $tripleWidth*$sina*$t;   if ($png) {
     $yperp = $tripleWidth*$cosa*$t;      $im->line($xab+$xperp,$height-($yab-$yperp),
     $im->line($xab+$xperp,$height-($yab-$yperp),        $xab-$xperp,$height-($yab+$yperp),
       $xab-$xperp,$height-($yab+$yperp),        $gdAntiAliased);
       gdAntiAliased);   } elsif ($ps) {
  }      $im->line($xab+$xperp,$yab-$yperp,$xab-$xperp,$yab+$yperp);
     }   }
     elsif (@bondType[$i] == -1) {      }
  $xperp = $tripleWidth*$sina;   }
  $yperp = $tripleWidth*$cosa;   elsif ($bondType[$i] == -1) {
  $poly = new GD::Polygon;      my $xperp = $tripleWidth*$sina;
  $poly->addPt($xa,$height-$ya);      my $yperp = $tripleWidth*$cosa;
  $poly->addPt($xb+$xperp,$height-($yb-$yperp));      if ($png) {
  $poly->addPt($xb-$xperp,$height-($yb+$yperp));   my $poly = new GD::Polygon;
  $im->filledPolygon($poly,$black);   $poly->addPt($xa,$height-$ya);
     }   $poly->addPt($xb+$xperp,$height-($yb-$yperp));
     elsif (@bondType[$i] == 1) {   $poly->addPt($xb-$xperp,$height-($yb+$yperp));
  $im->line($xa,$height-$ya,$xb,$height-$yb,gdAntiAliased);   $im->filledPolygon($poly,$black);
     }      } elsif ($ps) {
     elsif (@bondType[$i] == 2 &&   $im->polygon({filled=>1},
    ((@adjacent[@atomA[$i]] == 1 && @adjacent[@atomB[$i]] > 2)||       $xa,$ya,
     (@adjacent[@atomB[$i]] == 1 && @adjacent[@atomA[$i]] > 2))) {       $xb+$xperp,$yb-$yperp,
  # centered bond       $xb-$xperp,$yb+$yperp);
  $xperp = $doubleWidth*$sina;      }
  $yperp = $doubleWidth*$cosa;   }
  $im->line($xa+$xperp,$height-($ya-$yperp),   elsif ($bondType[$i] == 1) {
   $xb+$xperp,$height-($yb-$yperp),      if ($png) {
   gdAntiAliased);   $im->line($xa,$height-$ya,$xb,$height-$yb,$gdAntiAliased);
  $im->line($xa-$xperp,$height-($ya+$yperp),      } elsif ($ps) {
   $xb-$xperp,$height-($yb+$yperp),   $im->line($xa,$ya,$xb,$yb);
   gdAntiAliased);      }
     }   }
     elsif (@bondType[$i] == 2) {   elsif ($bondType[$i] == 2 &&
  $xperp = 2*$doubleWidth*$sina;         (($adjacent[$atomA[$i]] == 1 && $adjacent[$atomB[$i]] > 2)||
  $yperp = 2*$doubleWidth*$cosa;   ($adjacent[$atomB[$i]] == 1 && $adjacent[$atomA[$i]] > 2)||
  $im->line($xa,$height-$ya,$xb,$height-$yb,gdAntiAliased);   @name[@atomA[$i]] eq "O" || @name[@atomB[$i]] eq "O")) {
  $im->line($xa+0.1*$dx-$xperp,$height-($ya+0.1*$dy+$yperp),      # centered bond
   $xb-0.1*$dx-$xperp,$height-($yb-0.1*$dy+$yperp),      my $xperp = $doubleWidth*$sina;
   gdAntiAliased);      my $yperp = $doubleWidth*$cosa;
     }      if ($png) {
     elsif (@bondType[$i] == 3) {   $im->line($xa+$xperp,$height-($ya-$yperp),
  $xperp = $tripleWidth*$sina;    $xb+$xperp,$height-($yb-$yperp),
  $yperp = $tripleWidth*$cosa;    $gdAntiAliased);
  $im->line($xa,$height-$ya,$xb,$height-$yb,gdAntiAliased);   $im->line($xa-$xperp,$height-($ya+$yperp),
  $im->line($xa+$xperp,$height-($ya-$yperp),    $xb-$xperp,$height-($yb+$yperp),
   $xb+$xperp,$height-($yb-$yperp),    $gdAntiAliased);
   gdAntiAliased);      } elsif ($ps) {
  $im->line($xa-$xperp,$height-($ya+$yperp),   $im->line($xa+$xperp,$ya-$yperp,$xb+$xperp,$yb-$yperp);
   $xb-$xperp,$height-($yb+$yperp),   $im->line($xa-$xperp,$ya+$yperp,$xb-$xperp,$yb+$yperp);
   gdAntiAliased);      }
     }      }
 }   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  # Write labels
   
 %valence = ("C",4,"N",3,"P",3,"O",2,"S",2);      for (my $i = 0; $i < $natoms; $i++) {
    my ($formula,$sign,$charge) =
 $font = '/usr/share/fonts/default/Type1/n021003l.pfb';      ($name[$i] =~ /(\w+)([\+|\-])?(\d)?/);
 $pointsize = 20;   if ($formula ne "C" || $sign ne ""||
 @bounds = GD::Image->stringTTF($black,$font,100,0,0,0,"H");      $adjacent[$i] < 2 || ($adjacent[$i] == 2 && $bonds[$i] == 4) || (@aldehyde[$i] == 1 && @bonds[$i] == 3)) {
 $ptsize = 100*0.662*$pointsize*(2.54/72)*$scale/(@bounds[3]-@bounds[5]);      # don't show C, unless charged, terminal, or linear
       if (exists $electrons{$formula}) {
 for ($i = 0; $i < $natoms; $i++) {   # add H atoms to satisfy minimum valence
     my ($formula,$sign,$charge) =   my $e = $electrons{$formula};
  (@name[$i] =~ /(\w+)([\+|\-])?(\d)?/);   $e -= (($charge eq "")? 1 : $charge) if ($sign eq "+");
     $sign = "&#8211;" if ($sign eq "-");  # replace by n-dash   $e += (($charge eq "")? 1 : $charge) if ($sign eq "-");
        my $valence = 4 - abs($e-4);
     if ($formula ne "C" || $sign ne ""||   my $nH = $valence - @bonds[$i];
  @adjacent[$i] < 2 || (@adjacent[$i] == 2 && @bonds[$i] == 4)) {   $formula .= "H" if ($nH > 0);
  # don't show C, unless charged, terminal, or linear   $formula .= $nH if ($nH > 1);
  $nH = 0;      }
  if (exists $valence{$formula}) {      my @formula = $formula=~ /[A-Z][a-z]?\d*/g;
     $nH = $valence{$formula} - @bonds[$i];      
     $nH += (($charge eq "")? 1 : $charge) if ($sign eq "+");      my $PI = 3.1415;
     $nH -= (($charge eq "")? 1 : $charge) if ($sign eq "-");      my $bondAngle;
  }      if (abs($bondsy[$i]) < 0.01 && abs($bondsx[$i]) < 0.01) {
  $formula .= "H" if ($nH > 0);   $bondAngle = -$PI;
  $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) {      else {
  $direction = "d";   $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 {      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      if ($direction eq "r") {  # direction = right
     @formula[0] =~ /([A-Z][a-z]?)(\d*)/;   $formula[0] =~ /([A-Z][a-z]?)(\d*)/;
     $carrige = @x[$i]-stringWidth($1)/2;   my $carrige = $x[$i]-stringWidth($1)/2;
     foreach (@formula) {   foreach (@formula) {
  $_ =~ /([A-Z][a-z]?)(\d*)/;      $_ =~ /([A-Z][a-z]?)(\d*)/;
  $carrige = printElement ($1,$2,$carrige,@y[$i]);      $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      elsif ($direction eq "l") {  # direction = left, reverse hydrogens
     @formula[0] =~ /([A-Z][a-z]?)(\d*)/;   $formula[0] =~ /([A-Z][a-z]?)(\d*)/;
     $carrige = @x[$i]+   my $carrige = $x[$i]+
  stringWidth($1)/2+stringWidth($2)-stringWidth($formula);      stringWidth($1)/2+stringWidth($2)-stringWidth($formula);
     foreach (reverse @formula) {   foreach (reverse @formula) {
  $_ =~ /([A-Z][a-z]?)(\d*)/;      $_ =~ /([A-Z][a-z]?)(\d*)/;
  $carrige = printElement ($1,$2,$carrige,@y[$i]);      $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 "u") { # direction = up      elsif ($direction eq "u") { # direction = up
     (shift @formula) =~ /([A-Z][a-z]?)(\d*)/;   (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]);   $carrige = printElement ($1,$2,$carrige,$y[$i]);
     $y = (@formula > 0) ? @y[$i] + fm2cm(800) : @y[$i];   my $y = (@formula > 0) ? $y[$i] + fm2cm(900) : $y[$i];
     $carrige =   $carrige =
  (@formula > 0) ? @x[$i]-stringWidth($1)/2 : $carrige;      (@formula > 0) ? $x[$i]-stringWidth($1)/2 : $carrige;
     foreach (@formula) {   foreach (@formula) {
  $_ =~ /([A-Z][a-z]?)(\d*)/;      $_ =~ /([A-Z][a-z]?)(\d*)/;
  $carrige = printElement ($1,$2,$carrige,$y);      $carrige = printElement ($1,$2,$carrige,$y);
     }   }
     printCharge ($sign,$charge,$carrige,$y) if ($sign ne "");    printCharge ($sign,$charge,$carrige,$y) if ($sign ne ""); 
  }      }
  else { # direction = down      else { # direction = down
     (shift @formula) =~ /([A-Z][a-z]?)(\d*)/;   (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]);   $carrige = printElement ($1,$2,$carrige,$y[$i]);
     $y = (@formula > 0) ? @y[$i] + fm2cm(-800) : @y[$i];   my $y = (@formula > 0) ? $y[$i] + fm2cm(-900) : $y[$i];
     $carrige =   $carrige =
  (@formula > 0) ? @x[$i]-stringWidth($1)/2 : $carrige;      (@formula > 0) ? $x[$i]-stringWidth($1)/2 : $carrige;
     foreach (@formula) {   foreach (@formula) {
  $_ =~ /([A-Z][a-z]?)(\d*)/;      $_ =~ /([A-Z][a-z]?)(\d*)/;
  $carrige = printElement ($1,$2,$carrige,$y);      $carrige = printElement ($1,$2,$carrige,$y);
    }
    printCharge ($sign,$charge,$carrige,$y) if ($sign ne ""); 
     }      }
     printCharge ($sign,$charge,$carrige,$y) if ($sign ne "");   
  }   }
     }      }
   
 }  }
   
   if ($loncapa) {
       if ($png) {
 # make sure we are writing to a binary stream  # make sure we are writing to a binary stream
 binmode STDOUT;   binmode STDOUT;
   
 # Convert the image to PNG and print it on standard output  # Convert the image to PNG and print it on standard output
 print "Content-type: image/png\n\n";   print "Content-type: image/png\n\n";
 print $im->png;   print $im->png;
       } elsif ($ps) {
    my $psfile = LONCAPA::tempdir().$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 {  sub stringWidth {
     my ($string) = @_;      my ($string) = @_;
     my $width = 0;      my $width = 0;
     while ($string =~ /[A-Za-z]/g) {      while ($string =~ /[A-Za-z]/g) {
  my @bounds = GD::Image->stringTTF($black,$font,$ptsize,0,0,0,$&);   if ($png) {
  $width += @bounds[2]-@bounds[0]+2;      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) {      while ($string =~ /[\d+-]/g) {
  my @bounds = GD::Image->stringTTF($black,$font,0.6*$ptsize,0,0,0,$&);   if ($png) {
  $width += @bounds[2]-@bounds[0]+2;      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;      return $width;
Line 284  sub fm2cm {  #font metrics to cm Line 481  sub fm2cm {  #font metrics to cm
     return $scale*(2.54/72)*$pointsize*$fm/1000;      return $scale*(2.54/72)*$pointsize*$fm/1000;
 }  }
   
 sub printElement {  #element symbol + optional subscript  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 ($element,$subscript,$x,$y) = @_;
     $yy = 662;      my $yy = 662;
   
     my @bounds = GD::Image->stringTTF($black,$font,$ptsize,0,      my @bounds = GD::Image->stringTTF($black,$font,$ptsize,0,
    $x,$height-($y+fm2cm(-$yy/2)),$element);     $x,$height-($y+fm2cm(-$yy/2)),$element);
     $im->filledRectangle(      $im->filledRectangle(
  @bounds[6]-1,@bounds[7]-fm2cm(135),   $bounds[6]-1,$bounds[7]-fm2cm(135),
  @bounds[2]+1,@bounds[3]+fm2cm(135),$white);   $bounds[2]+1,$bounds[3]+fm2cm(135),$white);
   
     $im->stringTTF($black,$font,$ptsize,0,      $im->stringTTF($black,$font,$ptsize,0,
    $x,$height-($y+fm2cm(-$yy/2)),$element);     $x,$height-($y+fm2cm(-$yy/2)),$element);
     $x = @bounds[2] + 1;      $x = $bounds[2] + 1;
   
     if ($subscript ne "") {      if ($subscript ne "") {
  @bounds = GD::Image->stringTTF($black,$font,0.6*$ptsize,0,   @bounds = GD::Image->stringTTF($black,$font,0.6*$ptsize,0,
    $x,$height-($y+fm2cm(-0.8*$yy)),$subscript);     $x,$height-($y+fm2cm(-0.8*$yy)),$subscript);
  $im->filledRectangle(   $im->filledRectangle(
      @bounds[6]-1,@bounds[7]-fm2cm(45),       $bounds[6]-1,$bounds[7]-fm2cm(45),
      @bounds[2]+1,@bounds[3]+fm2cm(45),$white);       $bounds[2]+1,$bounds[3]+fm2cm(45),$white);
  $im->stringTTF($black,$font,0.6*$ptsize,0,   $im->stringTTF($black,$font,0.6*$ptsize,0,
  $x,$height-($y+fm2cm(-0.8*$yy)),$subscript);   $x,$height-($y+fm2cm(-0.8*$yy)),$subscript);
     }      }
     $x = @bounds[2] + 1;      $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 {  sub printCharge {
       if ($png) {
    return &printCharge_png(@_);
       } elsif ($ps) {
    return &printCharge_ps(@_);
       }
   }
   
   sub printCharge_png {
     my ($sign,$charge,$x,$y) = @_;      my ($sign,$charge,$x,$y) = @_;
     $yy = 662;      my $yy = 662;
   
       $sign = "&#8722;" if ($sign eq "-");  # replace by n-dash
     $charge = "" if ($charge == 1);      $charge = "" if ($charge == 1);
     $charge .= $sign;      $charge .= $sign;
           
     my @bounds = GD::Image->stringTTF($black,$font,0.6*$ptsize,0,      my @bounds = GD::Image->stringTTF($black,$font,0.6*$ptsize,0,
        $x,$height-($y+fm2cm(0.2*$yy)),$charge);         $x,$height-($y+fm2cm(0.2*$yy)),$charge);
     $im->filledRectangle(      $im->filledRectangle(
  @bounds[6]-1,@bounds[7]-fm2cm(45),   $bounds[6]-1,$bounds[7]-fm2cm(45),
  @bounds[2]+1,@bounds[3]+fm2cm(45),$white);   $bounds[2]+1,$bounds[3]+fm2cm(45),$white);
   
     $im->stringTTF($black,$font,0.6*$ptsize,0,$x,$height-($y+fm2cm(0.2*$yy)),$charge);      $im->stringTTF($black,$font,0.6*$ptsize,0,$x,$height-($y+fm2cm(0.2*$yy)),$charge);
     $x = @bounds[2] + 1;      $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;
       }
 }  }
   
 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");  
Removed from v.1.1  
changed lines
  Added in v.1.16

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>