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

Diff for /loncom/homework/convertjme.pl between versions 1.2 and 1.3

version 1.2, 2003/10/16 20:16:42 version 1.3, 2003/10/16 21:52:27
Line 6 Line 6
 use strict;  use strict;
 use lib '/home/httpd/lib/perl';  use lib '/home/httpd/lib/perl';
 use GD;  use GD;
   use PostScript::Simple;
 use LONCAPA::loncgi();  use LONCAPA::loncgi();
   
 if (! &LONCAPA::loncgi::check_cookie_and_load_env()) {  if (! &LONCAPA::loncgi::check_cookie_and_load_env()) {
Line 32  sub unescape { Line 33  sub unescape {
 my $id=$ENV{'QUERY_STRING'};  my $id=$ENV{'QUERY_STRING'};
 my @JMEstring = split(/ /,&unescape($ENV{'cgi.'.$id.'.JME'}));  my @JMEstring = split(/ /,&unescape($ENV{'cgi.'.$id.'.JME'}));
 my $width = $ENV{'cgi.'.$id.'.WIDTH'};  my $width = $ENV{'cgi.'.$id.'.WIDTH'};
   my $png = $ENV{'cgi.'.$id.'.PNG'};
   my $ps = $ENV{'cgi.'.$id.'.PS'};
 if (!$width) { $width = 200; }  if (!$width) { $width = 200; }
   
 # parse JME string  # parse JME string
Line 72  my $height = $scale * ($ymax-$ymin+2); Line 75  my $height = $scale * ($ymax-$ymin+2);
   
 for (my $i = 0; $i < $natoms; $i++) {  for (my $i = 0; $i < $natoms; $i++) {
     @x[$i] += (1.5+$maxName/2-$xmin);      @x[$i] += (1.5+$maxName/2-$xmin);
     @x[$i] *= $scale;      if ($png) {  @x[$i] *= $scale; }
     @y[$i] += (1.0-$ymin);      @y[$i] += (1.0-$ymin);
     @y[$i] *= $scale;      if ($png) { @y[$i] *= $scale; }
 }  }
   
 # Count bonds  # Count bonds
Line 97  for (my $i = 0; $i < $nbonds; $i++) { Line 100  for (my $i = 0; $i < $nbonds; $i++) {
 }  }
   
 # Create a new PostScript object  # Create a new PostScript object
 my $im = new GD::Image($width,$height);   my ($im,$white,$black,$gray);
 my $white = $im->colorAllocate(255,255,255);  if ($png) {
 my $black = $im->colorAllocate(0,0,0);      $im = new GD::Image($width,$height); 
 my $gray = $im->colorAllocate(200,200,200);      $white = $im->colorAllocate(255,255,255);
       $black = $im->colorAllocate(0,0,0);
       $gray = $im->colorAllocate(200,200,200);
 #$gdAntiAliased = $im->colorAllocate(1,1,1);  #$gdAntiAliased = $im->colorAllocate(1,1,1);
 $im->setAntiAliased($black);      $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");
   }
   
 # Draw bonds  # Draw bonds
 my $doubleWidth = 0.10*$scale;  my $doubleWidth;
 my $tripleWidth = 0.15*$scale;  my $tripleWidth;
   if ($png) {
       $doubleWidth = 0.10*$scale;
       $tripleWidth = 0.15*$scale;
   } elsif ($ps) {
       $doubleWidth = 0.10;
       $tripleWidth = 0.15;
   }
   
 for (my $i = 0; $i < $nbonds; $i++) {  for (my $i = 0; $i < $nbonds; $i++) {
     my $xa = @x[@atomA[$i]];      my $xa = @x[@atomA[$i]];
Line 128  for (my $i = 0; $i < $nbonds; $i++) { Line 148  for (my $i = 0; $i < $nbonds; $i++) {
     my $yab = $ya + $t*$dy;       my $yab = $ya + $t*$dy; 
     my $xperp = $tripleWidth*$sina*$t;      my $xperp = $tripleWidth*$sina*$t;
     my $yperp = $tripleWidth*$cosa*$t;      my $yperp = $tripleWidth*$cosa*$t;
     $im->line($xab+$xperp,$height-($yab-$yperp),      if ($png) {
       $xab-$xperp,$height-($yab+$yperp),   $im->line($xab+$xperp,$height-($yab-$yperp),
       gdAntiAliased);    $xab-$xperp,$height-($yab+$yperp),
     gdAntiAliased);
       } elsif ($ps) {
    $im->line($xab+$xperp,$yab-$yperp,$xab-$xperp,$yab+$yperp);
       }
  }   }
     }      }
     elsif (@bondType[$i] == -1) {      elsif (@bondType[$i] == -1) {
  my $xperp = $tripleWidth*$sina;   my $xperp = $tripleWidth*$sina;
  my $yperp = $tripleWidth*$cosa;   my $yperp = $tripleWidth*$cosa;
  my $poly = new GD::Polygon;   if ($png) {
  $poly->addPt($xa,$height-$ya);      my $poly = new GD::Polygon;
  $poly->addPt($xb+$xperp,$height-($yb-$yperp));      $poly->addPt($xa,$height-$ya);
  $poly->addPt($xb-$xperp,$height-($yb+$yperp));      $poly->addPt($xb+$xperp,$height-($yb-$yperp));
  $im->filledPolygon($poly,$black);      $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) {      elsif (@bondType[$i] == 1) {
  $im->line($xa,$height-$ya,$xb,$height-$yb,gdAntiAliased);   if ($png) {
       $im->line($xa,$height-$ya,$xb,$height-$yb,gdAntiAliased);
    } elsif ($ps) {
       $im->line($xa,$ya,$xb,$yb);
    }
     }      }
     elsif (@bondType[$i] == 2 &&      elsif (@bondType[$i] == 2 &&
    ((@adjacent[@atomA[$i]] == 1 && @adjacent[@atomB[$i]] > 2)||     ((@adjacent[@atomA[$i]] == 1 && @adjacent[@atomB[$i]] > 2)||
Line 151  for (my $i = 0; $i < $nbonds; $i++) { Line 186  for (my $i = 0; $i < $nbonds; $i++) {
  # centered bond   # centered bond
  my $xperp = $doubleWidth*$sina;   my $xperp = $doubleWidth*$sina;
  my $yperp = $doubleWidth*$cosa;   my $yperp = $doubleWidth*$cosa;
  $im->line($xa+$xperp,$height-($ya-$yperp),   if ($png) {
   $xb+$xperp,$height-($yb-$yperp),      $im->line($xa+$xperp,$height-($ya-$yperp),
   gdAntiAliased);        $xb+$xperp,$height-($yb-$yperp),
  $im->line($xa-$xperp,$height-($ya+$yperp),        gdAntiAliased);
   $xb-$xperp,$height-($yb+$yperp),      $im->line($xa-$xperp,$height-($ya+$yperp),
   gdAntiAliased);        $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) {      elsif (@bondType[$i] == 2) {
  my $xperp = 2*$doubleWidth*$sina;   my $xperp = 2*$doubleWidth*$sina;
  my $yperp = 2*$doubleWidth*$cosa;   my $yperp = 2*$doubleWidth*$cosa;
  $im->line($xa,$height-$ya,$xb,$height-$yb,gdAntiAliased);   if ($png) {
  $im->line($xa+0.1*$dx-$xperp,$height-($ya+0.1*$dy+$yperp),      $im->line($xa,$height-$ya,$xb,$height-$yb,gdAntiAliased);
   $xb-0.1*$dx-$xperp,$height-($yb-0.1*$dy+$yperp),      $im->line($xa+0.1*$dx-$xperp,$height-($ya+0.1*$dy+$yperp),
   gdAntiAliased);        $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) {      elsif (@bondType[$i] == 3) {
  my $xperp = $tripleWidth*$sina;   my $xperp = $tripleWidth*$sina;
  my $yperp = $tripleWidth*$cosa;   my $yperp = $tripleWidth*$cosa;
  $im->line($xa,$height-$ya,$xb,$height-$yb,gdAntiAliased);   if ($png) {
  $im->line($xa+$xperp,$height-($ya-$yperp),      $im->line($xa,$height-$ya,$xb,$height-$yb,gdAntiAliased);
   $xb+$xperp,$height-($yb-$yperp),      $im->line($xa+$xperp,$height-($ya-$yperp),
   gdAntiAliased);        $xb+$xperp,$height-($yb-$yperp),
  $im->line($xa-$xperp,$height-($ya+$yperp),        gdAntiAliased);
   $xb-$xperp,$height-($yb+$yperp),      $im->line($xa-$xperp,$height-($ya+$yperp),
   gdAntiAliased);        $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
   
 my %valence = ("C",4,"N",3,"P",3,"O",2,"S",2);  my %valence = ("C",4,"N",3,"P",3,"O",2,"S",2);
   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 = '/usr/share/fonts/default/Type1/n021003l.pfb';  my $font = '/usr/share/fonts/default/Type1/n021003l.pfb';
 my $pointsize = 20;  my $pointsize = 20;
 my @bounds = GD::Image->stringTTF($black,$font,100,0,0,0,"H");  my ($ptsize,@bounds);
 my $ptsize = 100*0.662*$pointsize*(2.54/72)*$scale/(@bounds[3]-@bounds[5]);  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]);
   }
   
 for (my $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      if ($png) {
        $sign = "&#8211;" if ($sign eq "-");  # replace by n-dash
       }
     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
Line 282  for (my $i = 0; $i < $natoms; $i++) { Line 339  for (my $i = 0; $i < $natoms; $i++) {
     }      }
 }  }
   
   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 = "/home/httpd/perl/tmp/".$id.'.eps';
       $im->output($psfile);
       print "Content-type: text/html\n\n";
       print (<<HTML)
   <html>
   <body>
   Wrote eps file $psfile
   </body>
   </html>
   HTML
   }
   
 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 += $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 += 0.6*$font_width{$&};
    }
     }      }
           
     return $width;      return $width;
Line 305  sub stringWidth { Line 384  sub stringWidth {
   
 sub fm2cm {  #font metrics to cm  sub fm2cm {  #font metrics to cm
     my ($fm) = @_;      my ($fm) = @_;
     return $scale*(2.54/72)*$pointsize*$fm/1000;      if ($png) {
    return $scale*(2.54/72)*$pointsize*$fm/1000;
       } elsif ($ps) {
    return (2.54/72)*$pointsize*$fm/1000;
       }
   }
   
   sub printElement {
       if ($png) {
    return &printElement_png(@_);
       } elsif ($ps) {
    return &printElement_ps(@_);
       }
 }  }
   
 sub printElement {  #element symbol + optional subscript  sub printElement_png {  #element symbol + optional subscript
     my ($element,$subscript,$x,$y) = @_;      my ($element,$subscript,$x,$y) = @_;
     my $yy = 662;      my $yy = 662;
   
Line 334  sub printElement {  #element symbol + op Line 425  sub printElement {  #element symbol + op
     $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+fm2cm(stringWidth($element)+50),$y+fm2cm(+$height/2+150));
       $im->setcolour("black");
       $im->setfont("Times-Roman",$pointsize);
       $im->text($x,$y+fm2cm(-$height/2),$element);
       $x += fm2cm(stringWidth($element));
   
       if ($subscript ne "") {
    $im->setcolour("white");
    $im->box({filled=>1},
    $x,$y+fm2cm(-0.8*$height-45),
    $x+fm2cm(stringWidth($subscript)+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 += fm2cm(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) = @_;
     my $yy = 662;      my $yy = 662;
   
Line 351  sub printCharge { Line 475  sub printCharge {
     $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+fm2cm(stringWidth($charge)+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 += fm2cm(stringWidth($charge));
   }
   
   
Removed from v.1.2  
changed lines
  Added in v.1.3

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