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

version 1.8, 2003/10/20 16:25:33 version 1.16, 2011/07/04 09:24:54
Line 34  use strict; Line 34  use strict;
 ### For standalone operation, set $loncapa to 0, and comment out both uses  ### For standalone operation, set $loncapa to 0, and comment out both uses
 my $loncapa=1;  my $loncapa=1;
 use lib '/home/httpd/lib/perl';  use lib '/home/httpd/lib/perl';
 use LONCAPA::loncgi();  use LONCAPA::loncgi;
   use LONCAPA;
   
 use GD;  use GD;
 use PostScript::Simple;  use PostScript::Simple;
Line 66  sub unescape { Line 66  sub unescape {
 my ($id,$width,$ps,$png,@JMEstring);  my ($id,$width,$ps,$png,@JMEstring);
 if ($loncapa) {  if ($loncapa) {
     $id=$ENV{'QUERY_STRING'};      $id=$ENV{'QUERY_STRING'};
     $width = $ENV{'cgi.'.$id.'.WIDTH'};      $width = $Apache::lonnet::env{'cgi.'.$id.'.WIDTH'};
     if (!$width) { $width = 400; }      if (!$width) { $width = 400; }
     $png = $ENV{'cgi.'.$id.'.PNG'};      $png = $Apache::lonnet::env{'cgi.'.$id.'.PNG'};
     $ps = $ENV{'cgi.'.$id.'.PS'};      $ps = $Apache::lonnet::env{'cgi.'.$id.'.PS'};
     @JMEstring=&unescape($ENV{'cgi.'.$id.'.JME'});      @JMEstring=&unescape($Apache::lonnet::env{'cgi.'.$id.'.JME'});
 } else {  } else {
     my @JMEstring = @ARGV;      @JMEstring = @ARGV;
     $width = shift @JMEstring;      $width = shift @JMEstring;
     $png = 1;      $png = 1;
     $ps = 1;      $ps = 1;
Line 86  my @modulator_structs=split(/\|/,$modula Line 86  my @modulator_structs=split(/\|/,$modula
 my @product_structs=split(/\|/,$products);  my @product_structs=split(/\|/,$products);
   
   
   
 my @all_structs=(@reactant_structs,@modulator_structs,@product_structs);  my @all_structs=(@reactant_structs,@modulator_structs,@product_structs);
   
 #get size of image and initialize image and globals  #get size of image and initialize image and globals
Line 136  if ($png) { Line 135  if ($png) {
  units => "cm");   units => "cm");
 }  }
   
 my %valence = ("C",4,"N",3,"P",3,"O",2,"S",2);  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_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 = '/home/httpd/html/adm/fonts/DejaVuSerif-Roman.ttf';
 my $pointsize = 20;  my $pointsize = 20;
 my ($ptsize,@bounds);  my ($ptsize,@bounds);
 if ($png) {  if ($png) {
Line 200  foreach my $struct (@all_structs) { Line 199  foreach my $struct (@all_structs) {
     my @adjacent = map {0} 0..$natoms-1;      my @adjacent = map {0} 0..$natoms-1;
     my @bondsx = map {0} 0..$natoms-1;      my @bondsx = map {0} 0..$natoms-1;
     my @bondsy = 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++) {      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 211  foreach my $struct (@all_structs) { Line 211  foreach my $struct (@all_structs) {
  $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");
    }
   
     }      }
   
      
 # Draw bonds  # Draw bonds
     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 268  foreach my $struct (@all_structs) { Line 275  foreach my $struct (@all_structs) {
  }   }
  elsif ($bondType[$i] == 2 &&   elsif ($bondType[$i] == 2 &&
        (($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)||
    @name[@atomA[$i]] eq "O" || @name[@atomB[$i]] eq "O")) {
     # centered bond      # centered bond
     my $xperp = $doubleWidth*$sina;      my $xperp = $doubleWidth*$sina;
     my $yperp = $doubleWidth*$cosa;      my $yperp = $doubleWidth*$cosa;
Line 322  foreach my $struct (@all_structs) { Line 330  foreach my $struct (@all_structs) {
     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)?/);
  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) || (@aldehyde[$i] == 1 && @bonds[$i] == 3)) {
     # don't show C, unless charged, terminal, or linear      # don't show C, unless charged, terminal, or linear
     my $nH = 0;      if (exists $electrons{$formula}) {
     if (exists $valence{$formula}) {   # add H atoms to satisfy minimum valence
  $nH = $valence{$formula} - $bonds[$i];   my $e = $electrons{$formula};
  $nH += (($charge eq "")? 1 : $charge) if ($sign eq "+");   $e -= (($charge eq "")? 1 : $charge) if ($sign eq "+");
  $nH -= (($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);
     }      }
     $formula .= "H" if ($nH > 0);  
     $formula .= $nH if ($nH > 1);  
     my @formula = $formula=~ /[A-Z][a-z]?\d*/g;      my @formula = $formula=~ /[A-Z][a-z]?\d*/g;
           
     my $PI = 3.1415;      my $PI = 3.1415;
Line 389  foreach my $struct (@all_structs) { Line 396  foreach my $struct (@all_structs) {
  (shift @formula) =~ /([A-Z][a-z]?)(\d*)/;   (shift @formula) =~ /([A-Z][a-z]?)(\d*)/;
  my $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]);
  my $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) {
Line 402  foreach my $struct (@all_structs) { Line 409  foreach my $struct (@all_structs) {
  (shift @formula) =~ /([A-Z][a-z]?)(\d*)/;   (shift @formula) =~ /([A-Z][a-z]?)(\d*)/;
  my $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]);
  my $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) {
Line 424  if ($loncapa) { Line 431  if ($loncapa) {
  print "Content-type: image/png\n\n";   print "Content-type: image/png\n\n";
  print $im->png;   print $im->png;
     } elsif ($ps) {      } elsif ($ps) {
  my $psfile = "/home/httpd/perl/tmp/".$id.'.eps';   my $psfile = LONCAPA::tempdir().$id.'.eps';
  $im->output($psfile);   $im->output($psfile);
  print "Content-type: text/html\n\n";   print "Content-type: text/html\n\n";
  print (<<HTML)   print (<<HTML)
Line 545  sub printCharge_png { Line 552  sub printCharge_png {
     my ($sign,$charge,$x,$y) = @_;      my ($sign,$charge,$x,$y) = @_;
     my $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;
           

Removed from v.1.8  
changed lines
  Added in v.1.16


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