[LON-CAPA-cvs] cvs: loncom /homework chemresponse.pm convertjme.pl
albertel
lon-capa-cvs@mail.lon-capa.org
Thu, 16 Oct 2003 21:52:28 -0000
This is a MIME encoded message
--albertel1066341148
Content-Type: text/plain
albertel Thu Oct 16 17:52:28 2003 EDT
Modified files:
/loncom/homework convertjme.pl chemresponse.pm
Log:
- BUG#2292 mostly done, now prints (and generates a PS file of ths sturcture) all of the JME -> pns,PNG code was done by Guy Ashkenazi, I am just gluing it in.
--albertel1066341148
Content-Type: text/plain
Content-Disposition: attachment; filename="albertel-20031016175228.txt"
Index: loncom/homework/convertjme.pl
diff -u loncom/homework/convertjme.pl:1.2 loncom/homework/convertjme.pl:1.3
--- loncom/homework/convertjme.pl:1.2 Thu Oct 16 16:16:42 2003
+++ loncom/homework/convertjme.pl Thu Oct 16 17:52:27 2003
@@ -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 @@
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 @@
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 @@
}
# 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 @@
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 @@
# 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 @@
}
}
+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 (<<HTML)
+<html>
+<body>
+Wrote eps file $psfile
+</body>
+</html>
+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 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 @@
$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 @@
$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));
+}
Index: loncom/homework/chemresponse.pm
diff -u loncom/homework/chemresponse.pm:1.16 loncom/homework/chemresponse.pm:1.17
--- loncom/homework/chemresponse.pm:1.16 Thu Oct 16 16:16:42 2003
+++ loncom/homework/chemresponse.pm Thu Oct 16 17:52:27 2003
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# chemical equation style response
#
-# $Id: chemresponse.pm,v 1.16 2003/10/16 20:16:42 albertel Exp $
+# $Id: chemresponse.pm,v 1.17 2003/10/16 21:52:27 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -207,19 +207,34 @@
my $result;
if ($target eq 'web') {
my $width=&Apache::lonxml::get_param('width',$parstack,$safeeval);
- my $height=&Apache::lonxml::get_param('height',$parstack,$safeeval);
my $molecule=&Apache::lonxml::get_param('molecule',$parstack,$safeeval);
my $options=&Apache::lonxml::get_param('options',$parstack,$safeeval);
my $id=time.'_'.int(rand(1000));
$result="<img src='/cgi-bin/convertjme.pl?$id' />";
&Apache::lonnet::appenv(
'cgi.'.$id.'.JME' => &Apache::lonnet::escape($molecule),
+ 'cgi.'.$id.'.PNG' => 1,
'cgi.'.$id.'.WIDTH' => $width );
-
+ } elsif ($target eq 'tex') {
+ my $texwidth=&Apache::lonxml::get_param('texwidth',$parstack,$safeeval,1);
+ if (!$texwidth) { $texwidth='90'; }
+ my $molecule=&Apache::lonxml::get_param('molecule',$parstack,$safeeval);
+ my $options=&Apache::lonxml::get_param('options',$parstack,$safeeval);
+ my $filename = $ENV{'user.name'}.'_'.$ENV{'user.domain'}.
+ '_'.time.'_'.$$.int(rand(1000)).'_organicstructure';
+ my $id=$filename;
+ &Apache::lonnet::appenv(
+ 'cgi.'.$id.'.JME' => &Apache::lonnet::escape($molecule),
+ 'cgi.'.$id.'.PS' => 1,
+ 'cgi.'.$id.'.WIDTH' => $texwidth );
+ $id=&Apache::lonnet::escape($id);
+ &Apache::lonxml::register_ssi("/cgi-bin/convertjme.pl?$id");
+ $result = '\graphicspath{{/home/httpd/perl/tmp/}}\includegraphics[width='.$texwidth.' mm]{'.$filename.'.eps}';
} elsif ($target eq 'edit') {
$result .=&Apache::edit::tag_start($target,$token);
$result .=&Apache::edit::text_arg('Width:','width',$token,5);
$result .=&Apache::edit::text_arg('Height:','height',$token,5);
+ $result .=&Apache::edit::text_arg('TeXwidth:','texwidth',$token,5);
$result .='<nobr>';
$result .=&Apache::edit::text_arg('Molecule:','molecule',$token,40);
my $molecule=&Apache::lonxml::get_param('molecule',$parstack,
@@ -244,7 +259,7 @@
my $constructtag=&Apache::edit::get_new_args($token,$parstack,
$safeeval,'molecule',
'width','height',
- 'options');
+ 'texwidth','options');
if ($constructtag) { $result = &Apache::edit::rebuild_tag($token); }
}
return $result;
--albertel1066341148--