version 1.8, 2003/10/20 16:25:33
|
version 1.17, 2024/06/02 10:52:01
|
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 132 if ($png) {
|
Line 131 if ($png) {
|
ysize => $ymax-$ymin+2, |
ysize => $ymax-$ymin+2, |
clip => 1, |
clip => 1, |
eps => 1, |
eps => 1, |
color => 0, |
colour => 1, |
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 = "–" 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 = "−" if ($sign eq "-"); # replace by n-dash |
$charge = "" if ($charge == 1); |
$charge = "" if ($charge == 1); |
$charge .= $sign; |
$charge .= $sign; |
|
|