--- loncom/homework/convertjme.pl 2003/10/16 20:16:42 1.2 +++ loncom/homework/convertjme.pl 2003/10/16 21:52:27 1.3 @@ -6,6 +6,7 @@ use strict; use lib '/home/httpd/lib/perl'; use GD; +use PostScript::Simple; use LONCAPA::loncgi(); if (! &LONCAPA::loncgi::check_cookie_and_load_env()) { @@ -32,6 +33,8 @@ sub unescape { my $id=$ENV{'QUERY_STRING'}; my @JMEstring = split(/ /,&unescape($ENV{'cgi.'.$id.'.JME'})); my $width = $ENV{'cgi.'.$id.'.WIDTH'}; +my $png = $ENV{'cgi.'.$id.'.PNG'}; +my $ps = $ENV{'cgi.'.$id.'.PS'}; if (!$width) { $width = 200; } # parse JME string @@ -72,9 +75,9 @@ my $height = $scale * ($ymax-$ymin+2); for (my $i = 0; $i < $natoms; $i++) { @x[$i] += (1.5+$maxName/2-$xmin); - @x[$i] *= $scale; + if ($png) { @x[$i] *= $scale; } @y[$i] += (1.0-$ymin); - @y[$i] *= $scale; + if ($png) { @y[$i] *= $scale; } } # Count bonds @@ -97,16 +100,33 @@ for (my $i = 0; $i < $nbonds; $i++) { } # Create a new PostScript object -my $im = new GD::Image($width,$height); -my $white = $im->colorAllocate(255,255,255); -my $black = $im->colorAllocate(0,0,0); -my $gray = $im->colorAllocate(200,200,200); +my ($im,$white,$black,$gray); +if ($png) { + $im = new GD::Image($width,$height); + $white = $im->colorAllocate(255,255,255); + $black = $im->colorAllocate(0,0,0); + $gray = $im->colorAllocate(200,200,200); #$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 -my $doubleWidth = 0.10*$scale; -my $tripleWidth = 0.15*$scale; +my $doubleWidth; +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++) { my $xa = @x[@atomA[$i]]; @@ -128,22 +148,37 @@ for (my $i = 0; $i < $nbonds; $i++) { my $yab = $ya + $t*$dy; my $xperp = $tripleWidth*$sina*$t; my $yperp = $tripleWidth*$cosa*$t; - $im->line($xab+$xperp,$height-($yab-$yperp), - $xab-$xperp,$height-($yab+$yperp), - gdAntiAliased); + if ($png) { + $im->line($xab+$xperp,$height-($yab-$yperp), + $xab-$xperp,$height-($yab+$yperp), + gdAntiAliased); + } elsif ($ps) { + $im->line($xab+$xperp,$yab-$yperp,$xab-$xperp,$yab+$yperp); + } } } elsif (@bondType[$i] == -1) { my $xperp = $tripleWidth*$sina; my $yperp = $tripleWidth*$cosa; - my $poly = new GD::Polygon; - $poly->addPt($xa,$height-$ya); - $poly->addPt($xb+$xperp,$height-($yb-$yperp)); - $poly->addPt($xb-$xperp,$height-($yb+$yperp)); - $im->filledPolygon($poly,$black); + if ($png) { + my $poly = new GD::Polygon; + $poly->addPt($xa,$height-$ya); + $poly->addPt($xb+$xperp,$height-($yb-$yperp)); + $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) { - $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 && ((@adjacent[@atomA[$i]] == 1 && @adjacent[@atomB[$i]] > 2)|| @@ -151,48 +186,70 @@ for (my $i = 0; $i < $nbonds; $i++) { # centered bond my $xperp = $doubleWidth*$sina; my $yperp = $doubleWidth*$cosa; - $im->line($xa+$xperp,$height-($ya-$yperp), - $xb+$xperp,$height-($yb-$yperp), - gdAntiAliased); - $im->line($xa-$xperp,$height-($ya+$yperp), - $xb-$xperp,$height-($yb+$yperp), - gdAntiAliased); + if ($png) { + $im->line($xa+$xperp,$height-($ya-$yperp), + $xb+$xperp,$height-($yb-$yperp), + gdAntiAliased); + $im->line($xa-$xperp,$height-($ya+$yperp), + $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) { my $xperp = 2*$doubleWidth*$sina; my $yperp = 2*$doubleWidth*$cosa; - $im->line($xa,$height-$ya,$xb,$height-$yb,gdAntiAliased); - $im->line($xa+0.1*$dx-$xperp,$height-($ya+0.1*$dy+$yperp), - $xb-0.1*$dx-$xperp,$height-($yb-0.1*$dy+$yperp), - gdAntiAliased); + if ($png) { + $im->line($xa,$height-$ya,$xb,$height-$yb,gdAntiAliased); + $im->line($xa+0.1*$dx-$xperp,$height-($ya+0.1*$dy+$yperp), + $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) { my $xperp = $tripleWidth*$sina; my $yperp = $tripleWidth*$cosa; - $im->line($xa,$height-$ya,$xb,$height-$yb,gdAntiAliased); - $im->line($xa+$xperp,$height-($ya-$yperp), - $xb+$xperp,$height-($yb-$yperp), - gdAntiAliased); - $im->line($xa-$xperp,$height-($ya+$yperp), - $xb-$xperp,$height-($yb+$yperp), - gdAntiAliased); + if ($png) { + $im->line($xa,$height-$ya,$xb,$height-$yb,gdAntiAliased); + $im->line($xa+$xperp,$height-($ya-$yperp), + $xb+$xperp,$height-($yb-$yperp), + gdAntiAliased); + $im->line($xa-$xperp,$height-($ya+$yperp), + $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 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 $pointsize = 20; -my @bounds = GD::Image->stringTTF($black,$font,100,0,0,0,"H"); -my $ptsize = 100*0.662*$pointsize*(2.54/72)*$scale/(@bounds[3]-@bounds[5]); +my ($ptsize,@bounds); +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++) { my ($formula,$sign,$charge) = (@name[$i] =~ /(\w+)([\+|\-])?(\d)?/); - $sign = "–" if ($sign eq "-"); # replace by n-dash - + if ($png) { + $sign = "–" if ($sign eq "-"); # replace by n-dash + } if ($formula ne "C" || $sign ne ""|| @adjacent[$i] < 2 || (@adjacent[$i] == 2 && @bonds[$i] == 4)) { # don't show C, unless charged, terminal, or linear @@ -282,22 +339,44 @@ for (my $i = 0; $i < $natoms; $i++) { } } +if ($png) { # make sure we are writing to a binary stream -binmode STDOUT; + binmode STDOUT; # Convert the image to PNG and print it on standard output -print "Content-type: image/png\n\n"; -print $im->png; + print "Content-type: image/png\n\n"; + print $im->png; +} elsif ($ps) { + my $psfile = "/home/httpd/perl/tmp/".$id.'.eps'; + $im->output($psfile); + print "Content-type: text/html\n\n"; + print (< + +Wrote eps file $psfile + + +HTML +} + sub stringWidth { my ($string) = @_; my $width = 0; while ($string =~ /[A-Za-z]/g) { - my @bounds = GD::Image->stringTTF($black,$font,$ptsize,0,0,0,$&); - $width += @bounds[2]-@bounds[0]+2; + if ($png) { + 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) { - my @bounds = GD::Image->stringTTF($black,$font,0.6*$ptsize,0,0,0,$&); - $width += @bounds[2]-@bounds[0]+2; + if ($png) { + 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; @@ -305,10 +384,22 @@ sub stringWidth { sub fm2cm { #font metrics to cm 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 $yy = 662; @@ -334,7 +425,40 @@ sub printElement { #element symbol + op $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 { + if ($png) { + return &printCharge_png(@_); + } elsif ($ps) { + return &printCharge_ps(@_); + } +} + +sub printCharge_png { my ($sign,$charge,$x,$y) = @_; my $yy = 662; @@ -351,5 +475,26 @@ sub printCharge { $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)); +}