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

Diff for /loncom/homework/convertjme.pl between versions 1.6 and 1.7

version 1.6, 2003/10/18 07:16:48 version 1.7, 2003/10/20 16:14:08
Line 36  use GD; Line 36  use GD;
 use PostScript::Simple;  use PostScript::Simple;
 use LONCAPA::loncgi();  use LONCAPA::loncgi();
   
 if (! &LONCAPA::loncgi::check_cookie_and_load_env()) {  if ($loncapa) {
     print <<END;      if (! &LONCAPA::loncgi::check_cookie_and_load_env()) {
    print <<END;
 Content-type: text/html  Content-type: text/html
   
 <html>  <html>
Line 47  Your cookie information is incorrect. Line 48  Your cookie information is incorrect.
 </body>  </body>
 </html>  </html>
 END  END
     exit;          exit;
       }
 }  }
   
 sub unescape {  sub unescape {
Line 57  sub unescape { Line 59  sub unescape {
 }  }
   
 # read the width and the JME string from the cgi query  # read the width and the JME string from the cgi query
 my $id=$ENV{'QUERY_STRING'};  my ($id,$width,$ps,$png,@JMEstring);
 my $width = $ENV{'cgi.'.$id.'.WIDTH'};  if ($loncapa) {
 if (!$width) { $width = 400; }      $id=$ENV{'QUERY_STRING'};
 my $png = $ENV{'cgi.'.$id.'.PNG'};      $width = $ENV{'cgi.'.$id.'.WIDTH'};
 my $ps = $ENV{'cgi.'.$id.'.PS'};      if (!$width) { $width = 400; }
       $png = $ENV{'cgi.'.$id.'.PNG'};
       $ps = $ENV{'cgi.'.$id.'.PS'};
       @JMEstring=&unescape($ENV{'cgi.'.$id.'.JME'});
   } else {
       my @JMEstring = @ARGV;
       $width = shift @JMEstring;
       $png = 1;
       $ps = 1;
   }
   
 #get objects  #get objects
 my ($reactants,$solution,$products)=split('>',&unescape($ENV{'cgi.'.$id.'.JME'}));  my ($reactants,$modulators,$products)=split('>',$JMEstring[0]);
   
 my @reactant_structs=split(/\|/,$reactants);  my @reactant_structs=split(/\|/,$reactants);
 my @solution_structs=split(/\|/,$solution);  my @modulator_structs=split(/\|/,$modulators);
 my @product_structs=split(/\|/,$products);  my @product_structs=split(/\|/,$products);
   
 my $draw_arrow;  
 if (@solution_structs || @product_structs) { $draw_arrow=1; }  
   
 my @all_structs=(@reactant_structs,@solution_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
 my ($xmin,$xmax,$ymin,$ymax,$maxName,$height,$scale) =  my ($xmin,$xmax,$ymin,$ymax,$maxName,$height,$scale) =
     &determine_size(@all_structs);      &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  # Create a new PostScript object
 my ($im,$white,$black,$gray);  my ($im,$white,$black,$gray);
   my $gdAntiAliased;
 if ($png) {  if ($png) {
     $im = new GD::Image($width,$height);       $im = new GD::Image($width,$height); 
     $white = $im->colorAllocate(255,255,255);      $white = $im->colorAllocate(255,255,255);
     $black = $im->colorAllocate(0,0,0);      $black = $im->colorAllocate(0,0,0);
     $gray = $im->colorAllocate(200,200,200);      $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) {  } elsif ($ps) {
     $im = new PostScript::Simple(xsize => $xmax-$xmin+3+$maxName,      $im = new PostScript::Simple(xsize => $xmax-$xmin+3+$maxName,
  ysize => $ymax-$ymin+2,   ysize => $ymax-$ymin+2,
Line 111  if ($png) { Line 145  if ($png) {
 #set bond sizes  #set bond sizes
 my $doubleWidth;  my $doubleWidth;
 my $tripleWidth;  my $tripleWidth;
 if ($png) {  $doubleWidth = 0.10*$scale;
     $doubleWidth = 0.10*$scale;  $tripleWidth = 0.15*$scale;
     $tripleWidth = 0.15*$scale;  
 } elsif ($ps) {  # Draw arrow
     $doubleWidth = 0.10;  
     $tripleWidth = 0.15;  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));
       }
 }  }
   
   
Line 127  foreach my $struct (@all_structs) { Line 181  foreach my $struct (@all_structs) {
     $natoms=scalar(@x);      $natoms=scalar(@x);
     $nbonds=scalar(@bondType);      $nbonds=scalar(@bondType);
   
   # Scale and move lower left corner to (1.5,1.0)
   
     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);
  if ($png) {  @x[$i] *= $scale; }   $x[$i] *= $scale; 
  @y[$i] += (1.0-$ymin);   $y[$i] += (1.0-$ymin);
  if ($png) { @y[$i] *= $scale; }   $y[$i] *= $scale;
     }      }
       
 # Count bonds  # Count bonds
   
     my @bonds = map {0} 0..$natoms-1;      my @bonds = map {0} 0..$natoms-1;
Line 141  foreach my $struct (@all_structs) { Line 197  foreach my $struct (@all_structs) {
     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;
     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;
   
  @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]];
     }      }
   
 # 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]];
  my $ya = @y[@atomA[$i]];   my $ya = $y[$atomA[$i]];
  my $xb = @x[@atomB[$i]];   my $xb = $x[$atomB[$i]];
  my $yb = @y[@atomB[$i]];   my $yb = $y[$atomB[$i]];
   
  my ($sina,$cosa,$dx,$dy);   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;
     my $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 (my $t = 0; $t <= 1; $t += 0.1) {      for (my $t = 0; $t <= 1; $t += 0.1) {
  my $xab = $xa + $t*$dx;    my $xab = $xa + $t*$dx; 
  my $yab = $ya + $t*$dy;    my $yab = $ya + $t*$dy; 
Line 177  foreach my $struct (@all_structs) { Line 233  foreach my $struct (@all_structs) {
  if ($png) {   if ($png) {
     $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) {   } elsif ($ps) {
     $im->line($xab+$xperp,$yab-$yperp,$xab-$xperp,$yab+$yperp);      $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;
     if ($png) {      if ($png) {
Line 199  foreach my $struct (@all_structs) { Line 255  foreach my $struct (@all_structs) {
      $xb-$xperp,$yb+$yperp);       $xb-$xperp,$yb+$yperp);
     }      }
  }   }
  elsif (@bondType[$i] == 1) {   elsif ($bondType[$i] == 1) {
     if ($png) {      if ($png) {
  $im->line($xa,$height-$ya,$xb,$height-$yb,gdAntiAliased);   $im->line($xa,$height-$ya,$xb,$height-$yb,$gdAntiAliased);
     } elsif ($ps) {      } elsif ($ps) {
  $im->line($xa,$ya,$xb,$yb);   $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)||
  (@adjacent[@atomB[$i]] == 1 && @adjacent[@atomA[$i]] > 2))) {   ($adjacent[$atomB[$i]] == 1 && $adjacent[$atomA[$i]] > 2))) {
     # centered bond      # centered bond
     my $xperp = $doubleWidth*$sina;      my $xperp = $doubleWidth*$sina;
     my $yperp = $doubleWidth*$cosa;      my $yperp = $doubleWidth*$cosa;
     if ($png) {      if ($png) {
  $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);
  $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) {      } elsif ($ps) {
  $im->line($xa+$xperp,$ya-$yperp,$xb+$xperp,$yb-$yperp);   $im->line($xa+$xperp,$ya-$yperp,$xb+$xperp,$yb-$yperp);
  $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;
     if ($png) {      if ($png) {
  $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 ($ps) {      } elsif ($ps) {
  $im->line($xa,$ya,$xb,$yb);   $im->line($xa,$ya,$xb,$yb);
  $im->line($xa+0.1*$dx-$xperp,$ya+0.1*$dy+$yperp,   $im->line($xa+0.1*$dx-$xperp,$ya+0.1*$dy+$yperp,
   $xb-0.1*$dx-$xperp,$yb-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;
     if ($png) {      if ($png) {
  $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),
   gdAntiAliased);    $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) {      } elsif ($ps) {
  $im->line($xa,$ya,$xb,$yb);   $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);
Line 261  foreach my $struct (@all_structs) { Line 317  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) {   if ($png) {
     $sign = "&#8211;" if ($sign eq "-");  # replace by n-dash      $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
     my $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 "+");
  $nH -= (($charge eq "")? 1 : $charge) if ($sign eq "-");   $nH -= (($charge eq "")? 1 : $charge) if ($sign eq "-");
     }      }
Line 280  foreach my $struct (@all_structs) { Line 336  foreach my $struct (@all_structs) {
           
     my $PI = 3.1415;      my $PI = 3.1415;
     my $bondAngle;      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;
     }      }
     else {      else {
  $bondAngle = atan2(@bondsy[$i],@bondsx[$i]);   $bondAngle = atan2($bondsy[$i],$bondsx[$i]);
     }      }
   
     my $direction;      my $direction;
     if (@adjacent[$i] < 2) {      if ($adjacent[$i] < 2) {
  $direction = (@bondsx[$i] < 0.01) ? "r" : "l";   $direction = ($bondsx[$i] < 0.01) ? "r" : "l";
     }      }
     else {      else {
  if  ($bondAngle >= -$PI/4 && $bondAngle <= $PI/4) {   if  ($bondAngle >= -$PI/4 && $bondAngle <= $PI/4) {
Line 307  foreach my $struct (@all_structs) { Line 363  foreach my $struct (@all_structs) {
     }      }
   
     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*)/;
  my $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*)/;
  my $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*)/;
  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(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) {
     $_ =~ /([A-Z][a-z]?)(\d*)/;      $_ =~ /([A-Z][a-z]?)(\d*)/;
     $carrige = printElement ($1,$2,$carrige,$y);      $carrige = printElement ($1,$2,$carrige,$y);
Line 340  foreach my $struct (@all_structs) { Line 396  foreach my $struct (@all_structs) {
     }      }
     else { # direction = down      else { # direction = down
  (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(-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) {
     $_ =~ /([A-Z][a-z]?)(\d*)/;      $_ =~ /([A-Z][a-z]?)(\d*)/;
     $carrige = printElement ($1,$2,$carrige,$y);      $carrige = printElement ($1,$2,$carrige,$y);
Line 354  foreach my $struct (@all_structs) { Line 410  foreach my $struct (@all_structs) {
  }   }
     }      }
 }  }
 if ($png) {  
   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) {      } elsif ($ps) {
     my $psfile = "/home/httpd/perl/tmp/".$id.'.eps';   my $psfile = "/home/httpd/perl/tmp/".$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)
 <html>      <html>
 <body>      <body>
 Wrote eps file $psfile      Wrote eps file $psfile
 </body>      </body>
 </html>      </html>
 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 {
Line 380  sub stringWidth { Line 448  sub stringWidth {
     while ($string =~ /[A-Za-z]/g) {      while ($string =~ /[A-Za-z]/g) {
  if ($png) {   if ($png) {
     my @bounds = GD::Image->stringTTF($black,$font,$ptsize,0,0,0,$&);      my @bounds = GD::Image->stringTTF($black,$font,$ptsize,0,0,0,$&);
     $width += @bounds[2]-@bounds[0]+2;      $width += $bounds[2]-$bounds[0]+2;
  } elsif ($ps) {   } elsif ($ps) {
     $width += $font_width{$&};      $width += fm2cm($font_width{$&});
  }   }
     }      }
     while ($string =~ /[\d+-]/g) {      while ($string =~ /[\d+-]/g) {
  if ($png) {   if ($png) {
     my @bounds=GD::Image->stringTTF($black,$font,0.6*$ptsize,0,0,0,$&);      my @bounds=GD::Image->stringTTF($black,$font,0.6*$ptsize,0,0,0,$&);
     $width += @bounds[2]-@bounds[0]+2;      $width += $bounds[2]-$bounds[0]+2;
  } elsif ($ps) {   } elsif ($ps) {
     $width += 0.6*$font_width{$&};      $width += fm2cm(0.6*$font_width{$&});
  }   }
     }      }
           
Line 399  sub stringWidth { Line 467  sub stringWidth {
   
 sub fm2cm {  #font metrics to cm  sub fm2cm {  #font metrics to cm
     my ($fm) = @_;      my ($fm) = @_;
     if ($png) {      return $scale*(2.54/72)*$pointsize*$fm/1000;
  return $scale*(2.54/72)*$pointsize*$fm/1000;  
     } elsif ($ps) {  
  return (2.54/72)*$pointsize*$fm/1000;  
     }  
 }  }
   
 sub printElement {  sub printElement {
Line 421  sub printElement_png {  #element symbol Line 485  sub printElement_png {  #element symbol
     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  sub printElement_ps {  #element symbol + optional subscript
     my ($element,$subscript,$x,$y) = @_;      my ($element,$subscript,$x,$y) = @_;
     $height = 662;      $height = 662;
       
     $im->setcolour("white");      $im->setcolour("white");
     $im->box({filled=>1},      $im->box({filled=>1},
     $x+fm2cm(-30),$y+fm2cm(-$height/2-150),      $x+fm2cm(-30),$y+fm2cm(-$height/2-150),
     $x+fm2cm(stringWidth($element)+50),$y+fm2cm(+$height/2+150));      $x+stringWidth($element)+fm2cm(50),$y+fm2cm(+$height/2+150));
     $im->setcolour("black");      $im->setcolour("black");
     $im->setfont("Times-Roman",$pointsize);      $im->setfont("Times-Roman",$pointsize);
     $im->text($x,$y+fm2cm(-$height/2),$element);      $im->text($x,$y+fm2cm(-$height/2),$element);
     $x += fm2cm(stringWidth($element));      $x += stringWidth($element);
   
     if ($subscript ne "") {      if ($subscript ne "") {
  $im->setcolour("white");   $im->setcolour("white");
  $im->box({filled=>1},   $im->box({filled=>1},
  $x,$y+fm2cm(-0.8*$height-45),   $x,$y+fm2cm(-0.8*$height-45),
  $x+fm2cm(stringWidth($subscript)+50),$y+fm2cm(-0.2*$height+45));   $x+stringWidth($subscript)+fm2cm(50),$y+fm2cm(-0.2*$height+45));
  $im->setcolour("black");   $im->setcolour("black");
  $im->setfont("Times-Roman",0.6*$pointsize);   $im->setfont("Times-Roman",0.6*$pointsize);
  $im->text($x,$y+fm2cm(-0.8*$height),$subscript);   $im->text($x,$y+fm2cm(-0.8*$height),$subscript);
     }      }
     $x += fm2cm(stringWidth($subscript));      $x += stringWidth($subscript);
 }  }
   
 sub printCharge {  sub printCharge {
Line 483  sub printCharge_png { Line 547  sub printCharge_png {
     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 {  sub printCharge_ps {
Line 500  sub printCharge_ps { Line 564  sub printCharge_ps {
     $im->setcolour("white");      $im->setcolour("white");
     $im->box({filled=>1},      $im->box({filled=>1},
     $x,$y+fm2cm(0.2*$height-45),      $x,$y+fm2cm(0.2*$height-45),
     $x+fm2cm(stringWidth($charge)+50),$y+fm2cm(0.8*$height+45));      $x+stringWidth($charge)+fm2cm(50),$y+fm2cm(0.8*$height+45));
   
     if ($sign eq "-") { # replace by n-dash      if ($sign eq "-") { # replace by n-dash
  chop $charge;   chop $charge;
Line 509  sub printCharge_ps { Line 573  sub printCharge_ps {
     $im->setcolour("black");      $im->setcolour("black");
     $im->setfont("Times-Roman",0.6*$pointsize);      $im->setfont("Times-Roman",0.6*$pointsize);
     $im->text($x,$y+fm2cm(0.2*$height),$charge);      $im->text($x,$y+fm2cm(0.2*$height),$charge);
     $x += fm2cm(stringWidth($charge));      $x += stringWidth($charge);
 }  }
   
 sub determine_size {  sub determine_size {
 # Find border and move lower left corner to (1.5,1.0)  # Find border 
     my (@all_structs)=@_;      my (@all_structs)=@_;
     my $xmin = my $ymin = 1e20;      my $xmin = my $ymin = 1e20;
     my $xmax = my $ymax = -1e20;      my $xmax = my $ymax = -1e20;
Line 523  sub determine_size { Line 587  sub determine_size {
  &parse_struct($struct,\@name,\@x,\@y,\@atomA,\@atomB,\@bondType);   &parse_struct($struct,\@name,\@x,\@y,\@atomA,\@atomB,\@bondType);
  $natoms=scalar(@x);   $natoms=scalar(@x);
  $nbonds=scalar(@bondType);   $nbonds=scalar(@bondType);
  for (my $i = 1; $i < $natoms; $i++) {   for (my $i = 0; $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);
     $ymin = @y[$i] if (@y[$i] < $ymin);      $ymin = $y[$i] if ($y[$i] < $ymin);
     @name[$i] =~ /(\@{1,2})?(\w+)([\+|\-])?(\d)?/;      $name[$i] =~ /(\@{1,2})?(\w+)([\+|\-])?(\d)?/;
     $maxName = length $2 if (length $2 > $maxName);      $maxName = length $2 if (length $2 > $maxName);
  }   }
  $maxName = ($maxName-3 < 0) ? 0 : $maxName-3;  
     }      }
     my $scale = $width / ($xmax-$xmin+3+$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);      my $height = $scale * ($ymax-$ymin+2);
   
     return ($xmin,$xmax,$ymin,$ymax,$maxName,$height,$scale);      return ($xmin,$xmax,$ymin,$ymax,$maxName,$height,$scale);
Removed from v.1.6  
changed lines
  Added in v.1.7

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