[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.2

version 1.1, 2003/10/16 19:46:36 version 1.2, 2003/10/16 20:16:42
Line 3 Line 3
 # 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 strict;
   use lib '/home/httpd/lib/perl';
 use GD;  use GD;
   use LONCAPA::loncgi();
   
 # read the width and the JME string from the cgi query  if (! &LONCAPA::loncgi::check_cookie_and_load_env()) {
 %data = &read_input;      print <<END;
 @JMEstring = split (/ /,$data{JME});  Content-type: text/html
 $width = $data{WIDTH};  
   <html>
   <head><title>Bad Cookie</title></head>
   <body>
   Your cookie information is incorrect. 
   </body>
   </html>
   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;  # parse JME string
 $nbonds= shift @JMEstring;  
   
 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;      @name[$i] = shift @JMEstring;
     @x[$i] = shift @JMEstring;      @x[$i] = shift @JMEstring;
     @y[$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;      @atomA[$i] = (shift @JMEstring)-1;
     @atomB[$i] = (shift @JMEstring)-1;      @atomB[$i] = (shift @JMEstring)-1;
     @bondType[$i] = shift @JMEstring;      @bondType[$i] = shift @JMEstring;
Line 31  for ($i = 0; $i < $nbonds; $i++) { Line 54  for ($i = 0; $i < $nbonds; $i++) {
   
 # Find border and move lower left corner to (1.5,1.0)  # Find border and move lower left corner to (1.5,1.0)
   
 $xmin = $xmax = @x[0];  my $xmin = my $xmax = @x[0];
 $ymin = $ymax = $y[0];  my $ymin = my $ymax = $y[0];
 $maxName = 0;  my $maxName = 0;
   
 for ($i = 1; $i < $natoms; $i++) {  for (my $i = 1; $i < $natoms; $i++) {
     $xmax = @x[$i] if (@x[$i] > $xmax);      $xmax = @x[$i] if (@x[$i] > $xmax);
     $xmin = @x[$i] if (@x[$i] < $xmin);      $xmin = @x[$i] if (@x[$i] < $xmin);
     $ymax = @y[$i] if (@y[$i] > $ymax);      $ymax = @y[$i] if (@y[$i] > $ymax);
Line 44  for ($i = 1; $i < $natoms; $i++) { Line 67  for ($i = 1; $i < $natoms; $i++) {
     $maxName = length $2 if (length $2 > $maxName);      $maxName = length $2 if (length $2 > $maxName);
 }  }
 $maxName = ($maxName-3 < 0) ? 0 : $maxName-3;  $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);  for (my $i = 0; $i < $natoms; $i++) {
 $height = $scale * ($ymax-$ymin+2);  
   
 for ($i = 0; $i < $natoms; $i++) {  
     @x[$i] += (1.5+$maxName/2-$xmin);      @x[$i] += (1.5+$maxName/2-$xmin);
     @x[$i] *= $scale;      @x[$i] *= $scale;
     @y[$i] += (1.0-$ymin);      @y[$i] += (1.0-$ymin);
Line 57  for ($i = 0; $i < $natoms; $i++) { Line 79  for ($i = 0; $i < $natoms; $i++) {
   
 # 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++) {  for (my $i = 0; $i < $nbonds; $i++) {
     @bonds[@atomA[$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;      @bonds[@atomB[$i]] += (@bondType[$i]>0) ? @bondType[$i] : 1;
   
Line 75  for ($i = 0; $i < $nbonds; $i++) { Line 97  for ($i = 0; $i < $nbonds; $i++) {
 }  }
   
 # Create a new PostScript object  # Create a new PostScript object
 $im = new GD::Image($width,$height);   my $im = new GD::Image($width,$height); 
 $white = $im->colorAllocate(255,255,255);  my $white = $im->colorAllocate(255,255,255);
 $black = $im->colorAllocate(0,0,0);  my $black = $im->colorAllocate(0,0,0);
 $gray = $im->colorAllocate(200,200,200);  my $gray = $im->colorAllocate(200,200,200);
 #$gdAntiAliased = $im->colorAllocate(1,1,1);  #$gdAntiAliased = $im->colorAllocate(1,1,1);
 $im->setAntiAliased($black);  $im->setAntiAliased($black);
   
 # Draw bonds  # Draw bonds
 $doubleWidth = 0.10*$scale;  my $doubleWidth = 0.10*$scale;
 $tripleWidth = 0.15*$scale;  my $tripleWidth = 0.15*$scale;
   
 for ($i = 0; $i < $nbonds; $i++) {  for (my $i = 0; $i < $nbonds; $i++) {
     $xa = @x[@atomA[$i]];      my $xa = @x[@atomA[$i]];
     $ya = @y[@atomA[$i]];      my $ya = @y[@atomA[$i]];
     $xb = @x[@atomB[$i]];      my $xb = @x[@atomB[$i]];
     $yb = @y[@atomB[$i]];      my $yb = @y[@atomB[$i]];
   
       my ($sina,$cosa,$dx,$dy);
     if (@bondType[$i] != 1) {      if (@bondType[$i] != 1) {
         $dx = $xb-$xa;          $dx = $xb-$xa;
  $dy = $yb-$ya;   $dy = $yb-$ya;
         $dd = sqrt($dx*$dx + $dy*$dy);          my $dd = sqrt($dx*$dx + $dy*$dy);
         $sina=$dy/$dd;          $sina=$dy/$dd;
         $cosa=$dx/$dd;          $cosa=$dx/$dd;
     }      }
     if    (@bondType[$i] == -2) {      if    (@bondType[$i] == -2) {
  for ($t = 0; $t <= 1; $t += 0.1) {   for (my $t = 0; $t <= 1; $t += 0.1) {
     $xab = $xa + $t*$dx;       my $xab = $xa + $t*$dx; 
     $yab = $ya + $t*$dy;       my $yab = $ya + $t*$dy; 
     $xperp = $tripleWidth*$sina*$t;      my $xperp = $tripleWidth*$sina*$t;
     $yperp = $tripleWidth*$cosa*$t;      my $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 (@bondType[$i] == -1) {      elsif (@bondType[$i] == -1) {
  $xperp = $tripleWidth*$sina;   my $xperp = $tripleWidth*$sina;
  $yperp = $tripleWidth*$cosa;   my $yperp = $tripleWidth*$cosa;
  $poly = new GD::Polygon;   my $poly = new GD::Polygon;
  $poly->addPt($xa,$height-$ya);   $poly->addPt($xa,$height-$ya);
  $poly->addPt($xb+$xperp,$height-($yb-$yperp));   $poly->addPt($xb+$xperp,$height-($yb-$yperp));
  $poly->addPt($xb-$xperp,$height-($yb+$yperp));   $poly->addPt($xb-$xperp,$height-($yb+$yperp));
Line 126  for ($i = 0; $i < $nbonds; $i++) { Line 149  for ($i = 0; $i < $nbonds; $i++) {
    ((@adjacent[@atomA[$i]] == 1 && @adjacent[@atomB[$i]] > 2)||     ((@adjacent[@atomA[$i]] == 1 && @adjacent[@atomB[$i]] > 2)||
     (@adjacent[@atomB[$i]] == 1 && @adjacent[@atomA[$i]] > 2))) {      (@adjacent[@atomB[$i]] == 1 && @adjacent[@atomA[$i]] > 2))) {
  # centered bond   # centered bond
  $xperp = $doubleWidth*$sina;   my $xperp = $doubleWidth*$sina;
  $yperp = $doubleWidth*$cosa;   my $yperp = $doubleWidth*$cosa;
  $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);
Line 136  for ($i = 0; $i < $nbonds; $i++) { Line 159  for ($i = 0; $i < $nbonds; $i++) {
   gdAntiAliased);    gdAntiAliased);
     }      }
     elsif (@bondType[$i] == 2) {      elsif (@bondType[$i] == 2) {
  $xperp = 2*$doubleWidth*$sina;   my $xperp = 2*$doubleWidth*$sina;
  $yperp = 2*$doubleWidth*$cosa;   my $yperp = 2*$doubleWidth*$cosa;
  $im->line($xa,$height-$ya,$xb,$height-$yb,gdAntiAliased);   $im->line($xa,$height-$ya,$xb,$height-$yb,gdAntiAliased);
  $im->line($xa+0.1*$dx-$xperp,$height-($ya+0.1*$dy+$yperp),   $im->line($xa+0.1*$dx-$xperp,$height-($ya+0.1*$dy+$yperp),
   $xb-0.1*$dx-$xperp,$height-($yb-0.1*$dy+$yperp),    $xb-0.1*$dx-$xperp,$height-($yb-0.1*$dy+$yperp),
   gdAntiAliased);    gdAntiAliased);
     }      }
     elsif (@bondType[$i] == 3) {      elsif (@bondType[$i] == 3) {
  $xperp = $tripleWidth*$sina;   my $xperp = $tripleWidth*$sina;
  $yperp = $tripleWidth*$cosa;   my $yperp = $tripleWidth*$cosa;
  $im->line($xa,$height-$ya,$xb,$height-$yb,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),
Line 158  for ($i = 0; $i < $nbonds; $i++) { Line 181  for ($i = 0; $i < $nbonds; $i++) {
   
 # Write labels  # 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';  my $font = '/usr/share/fonts/default/Type1/n021003l.pfb';
 $pointsize = 20;  my $pointsize = 20;
 @bounds = GD::Image->stringTTF($black,$font,100,0,0,0,"H");  my @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 $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) =      my ($formula,$sign,$charge) =
  (@name[$i] =~ /(\w+)([\+|\-])?(\d)?/);   (@name[$i] =~ /(\w+)([\+|\-])?(\d)?/);
     $sign = "&#8211;" if ($sign eq "-");  # replace by n-dash      $sign = "&#8211;" if ($sign eq "-");  # replace by n-dash
Line 173  for ($i = 0; $i < $natoms; $i++) { Line 196  for ($i = 0; $i < $natoms; $i++) {
     if ($formula ne "C" || $sign ne ""||      if ($formula ne "C" || $sign ne ""||
  @adjacent[$i] < 2 || (@adjacent[$i] == 2 && @bonds[$i] == 4)) {   @adjacent[$i] < 2 || (@adjacent[$i] == 2 && @bonds[$i] == 4)) {
  # don't show C, unless charged, terminal, or linear   # don't show C, unless charged, terminal, or linear
  $nH = 0;   my $nH = 0;
  if (exists $valence{$formula}) {   if (exists $valence{$formula}) {
     $nH = $valence{$formula} - @bonds[$i];      $nH = $valence{$formula} - @bonds[$i];
     $nH += (($charge eq "")? 1 : $charge) if ($sign eq "+");      $nH += (($charge eq "")? 1 : $charge) if ($sign eq "+");
Line 181  for ($i = 0; $i < $natoms; $i++) { Line 204  for ($i = 0; $i < $natoms; $i++) {
  }   }
  $formula .= "H" if ($nH > 0);   $formula .= "H" if ($nH > 0);
  $formula .= $nH if ($nH > 1);   $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) {   if (abs(@bondsy[$i]) < 0.01 && abs(@bondsx[$i]) < 0.01) {
     $bondAngle = -$PI;      $bondAngle = -$PI;
  }   }
Line 191  for ($i = 0; $i < $natoms; $i++) { Line 215  for ($i = 0; $i < $natoms; $i++) {
     $bondAngle = atan2(@bondsy[$i],@bondsx[$i]);      $bondAngle = atan2(@bondsy[$i],@bondsx[$i]);
  }   }
   
    my $direction;
  if (@adjacent[$i] < 2) {   if (@adjacent[$i] < 2) {
     $direction = (@bondsx[$i] < 0.01) ? "r" : "l";      $direction = (@bondsx[$i] < 0.01) ? "r" : "l";
  }   }
Line 211  for ($i = 0; $i < $natoms; $i++) { Line 236  for ($i = 0; $i < $natoms; $i++) {
   
  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]);
Line 220  for ($i = 0; $i < $natoms; $i++) { Line 245  for ($i = 0; $i < $natoms; $i++) {
  }   }
  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*)/;
Line 230  for ($i = 0; $i < $natoms; $i++) { Line 255  for ($i = 0; $i < $natoms; $i++) {
  }   }
  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(800) : @y[$i];
     $carrige =      $carrige =
  (@formula > 0) ? @x[$i]-stringWidth($1)/2 : $carrige;   (@formula > 0) ? @x[$i]-stringWidth($1)/2 : $carrige;
     foreach (@formula) {      foreach (@formula) {
Line 243  for ($i = 0; $i < $natoms; $i++) { Line 268  for ($i = 0; $i < $natoms; $i++) {
  }   }
  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(-800) : @y[$i];
     $carrige =      $carrige =
  (@formula > 0) ? @x[$i]-stringWidth($1)/2 : $carrige;   (@formula > 0) ? @x[$i]-stringWidth($1)/2 : $carrige;
     foreach (@formula) {      foreach (@formula) {
Line 255  for ($i = 0; $i < $natoms; $i++) { Line 280  for ($i = 0; $i < $natoms; $i++) {
     printCharge ($sign,$charge,$carrige,$y) if ($sign ne "");       printCharge ($sign,$charge,$carrige,$y) if ($sign ne ""); 
  }   }
     }      }
   
 }  }
   
 # make sure we are writing to a binary stream  # make sure we are writing to a binary stream
Line 286  sub fm2cm {  #font metrics to cm Line 310  sub fm2cm {  #font metrics to cm
   
 sub printElement {  #element symbol + optional subscript  sub printElement {  #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);
Line 312  sub printElement {  #element symbol + op Line 336  sub printElement {  #element symbol + op
   
 sub printCharge {  sub printCharge {
     my ($sign,$charge,$x,$y) = @_;      my ($sign,$charge,$x,$y) = @_;
     $yy = 662;      my $yy = 662;
   
     $charge = "" if ($charge == 1);      $charge = "" if ($charge == 1);
     $charge .= $sign;      $charge .= $sign;
Line 327  sub printCharge { Line 351  sub printCharge {
     $x = @bounds[2] + 1;      $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");  
Removed from v.1.1  
changed lines
  Added in v.1.2

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