[LON-CAPA-cvs] cvs: loncom /homework chemresponse.pm convertjme.pl
albertel
lon-capa-cvs@mail.lon-capa.org
Thu, 16 Oct 2003 20:16:42 -0000
This is a MIME encoded message
--albertel1066335402
Content-Type: text/plain
albertel Thu Oct 16 16:16:42 2003 EDT
Modified files:
/loncom/homework convertjme.pl chemresponse.pm
Log:
- converting to staticlly display things
--albertel1066335402
Content-Type: text/plain
Content-Disposition: attachment; filename="albertel-20031016161642.txt"
Index: loncom/homework/convertjme.pl
diff -u loncom/homework/convertjme.pl:1.1 loncom/homework/convertjme.pl:1.2
--- loncom/homework/convertjme.pl:1.1 Thu Oct 16 15:46:36 2003
+++ loncom/homework/convertjme.pl Thu Oct 16 16:16:42 2003
@@ -3,27 +3,50 @@
# Coded by Guy Ashkenazi, guy@fh.huji.ac.il
# Based on the work of Peter Ertl, peter.ertl@pharma.novartis.com
+use strict;
+use lib '/home/httpd/lib/perl';
use GD;
+use LONCAPA::loncgi();
-# read the width and the JME string from the cgi query
-%data = &read_input;
-@JMEstring = split (/ /,$data{JME});
-$width = $data{WIDTH};
+if (! &LONCAPA::loncgi::check_cookie_and_load_env()) {
+ print <<END;
+Content-type: text/html
+
+<html>
+<head><title>Bad Cookie</title></head>
+<body>
+Your cookie information is incorrect.
+</body>
+</html>
+END
+ exit;
+}
-#print "Content-type: text/plain\n\n";
+sub unescape {
+ my $str=shift;
+ $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
+ return $str;
+}
-# parse JME string
+# read the width and the JME string from the cgi query
+my $id=$ENV{'QUERY_STRING'};
+my @JMEstring = split(/ /,&unescape($ENV{'cgi.'.$id.'.JME'}));
+my $width = $ENV{'cgi.'.$id.'.WIDTH'};
+if (!$width) { $width = 200; }
-$natoms= shift @JMEstring;
-$nbonds= shift @JMEstring;
+# parse JME string
-for ($i = 0; $i < $natoms; $i++) {
+my $natoms= shift @JMEstring;
+my $nbonds= shift @JMEstring;
+my (@name,@x,@y);
+for (my $i = 0; $i < $natoms; $i++) {
@name[$i] = shift @JMEstring;
@x[$i] = shift @JMEstring;
@y[$i] = shift @JMEstring;
}
-for ($i = 0; $i < $nbonds; $i++) {
+my (@atomA,@atomB,@bondType);
+for (my $i = 0; $i < $nbonds; $i++) {
@atomA[$i] = (shift @JMEstring)-1;
@atomB[$i] = (shift @JMEstring)-1;
@bondType[$i] = shift @JMEstring;
@@ -31,11 +54,11 @@
# Find border and move lower left corner to (1.5,1.0)
-$xmin = $xmax = @x[0];
-$ymin = $ymax = $y[0];
-$maxName = 0;
+my $xmin = my $xmax = @x[0];
+my $ymin = my $ymax = $y[0];
+my $maxName = 0;
-for ($i = 1; $i < $natoms; $i++) {
+for (my $i = 1; $i < $natoms; $i++) {
$xmax = @x[$i] if (@x[$i] > $xmax);
$xmin = @x[$i] if (@x[$i] < $xmin);
$ymax = @y[$i] if (@y[$i] > $ymax);
@@ -44,11 +67,10 @@
$maxName = length $2 if (length $2 > $maxName);
}
$maxName = ($maxName-3 < 0) ? 0 : $maxName-3;
+my $scale = $width / ($xmax-$xmin+3+$maxName);
+my $height = $scale * ($ymax-$ymin+2);
-$scale = $width / ($xmax-$xmin+3+$maxName);
-$height = $scale * ($ymax-$ymin+2);
-
-for ($i = 0; $i < $natoms; $i++) {
+for (my $i = 0; $i < $natoms; $i++) {
@x[$i] += (1.5+$maxName/2-$xmin);
@x[$i] *= $scale;
@y[$i] += (1.0-$ymin);
@@ -57,11 +79,11 @@
# Count bonds
-@bonds = map {0} 0..$natoms-1;
-@adjacent = map {0} 0..$natoms-1;
-@bondsx = map {0} 0..$natoms-1;
-@bondsy = map {0} 0..$natoms-1;
-for ($i = 0; $i < $nbonds; $i++) {
+my @bonds = map {0} 0..$natoms-1;
+my @adjacent = map {0} 0..$natoms-1;
+my @bondsx = map {0} 0..$natoms-1;
+my @bondsy = map {0} 0..$natoms-1;
+for (my $i = 0; $i < $nbonds; $i++) {
@bonds[@atomA[$i]] += (@bondType[$i]>0) ? @bondType[$i] : 1;
@bonds[@atomB[$i]] += (@bondType[$i]>0) ? @bondType[$i] : 1;
@@ -75,45 +97,46 @@
}
# Create a new PostScript object
-$im = new GD::Image($width,$height);
-$white = $im->colorAllocate(255,255,255);
-$black = $im->colorAllocate(0,0,0);
-$gray = $im->colorAllocate(200,200,200);
+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);
#$gdAntiAliased = $im->colorAllocate(1,1,1);
$im->setAntiAliased($black);
# Draw bonds
-$doubleWidth = 0.10*$scale;
-$tripleWidth = 0.15*$scale;
+my $doubleWidth = 0.10*$scale;
+my $tripleWidth = 0.15*$scale;
-for ($i = 0; $i < $nbonds; $i++) {
- $xa = @x[@atomA[$i]];
- $ya = @y[@atomA[$i]];
- $xb = @x[@atomB[$i]];
- $yb = @y[@atomB[$i]];
+for (my $i = 0; $i < $nbonds; $i++) {
+ my $xa = @x[@atomA[$i]];
+ my $ya = @y[@atomA[$i]];
+ my $xb = @x[@atomB[$i]];
+ my $yb = @y[@atomB[$i]];
+ my ($sina,$cosa,$dx,$dy);
if (@bondType[$i] != 1) {
$dx = $xb-$xa;
$dy = $yb-$ya;
- $dd = sqrt($dx*$dx + $dy*$dy);
+ my $dd = sqrt($dx*$dx + $dy*$dy);
$sina=$dy/$dd;
$cosa=$dx/$dd;
}
if (@bondType[$i] == -2) {
- for ($t = 0; $t <= 1; $t += 0.1) {
- $xab = $xa + $t*$dx;
- $yab = $ya + $t*$dy;
- $xperp = $tripleWidth*$sina*$t;
- $yperp = $tripleWidth*$cosa*$t;
+ for (my $t = 0; $t <= 1; $t += 0.1) {
+ my $xab = $xa + $t*$dx;
+ 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);
}
}
elsif (@bondType[$i] == -1) {
- $xperp = $tripleWidth*$sina;
- $yperp = $tripleWidth*$cosa;
- $poly = new GD::Polygon;
+ 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));
@@ -126,8 +149,8 @@
((@adjacent[@atomA[$i]] == 1 && @adjacent[@atomB[$i]] > 2)||
(@adjacent[@atomB[$i]] == 1 && @adjacent[@atomA[$i]] > 2))) {
# centered bond
- $xperp = $doubleWidth*$sina;
- $yperp = $doubleWidth*$cosa;
+ my $xperp = $doubleWidth*$sina;
+ my $yperp = $doubleWidth*$cosa;
$im->line($xa+$xperp,$height-($ya-$yperp),
$xb+$xperp,$height-($yb-$yperp),
gdAntiAliased);
@@ -136,16 +159,16 @@
gdAntiAliased);
}
elsif (@bondType[$i] == 2) {
- $xperp = 2*$doubleWidth*$sina;
- $yperp = 2*$doubleWidth*$cosa;
+ 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);
}
elsif (@bondType[$i] == 3) {
- $xperp = $tripleWidth*$sina;
- $yperp = $tripleWidth*$cosa;
+ 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),
@@ -158,14 +181,14 @@
# Write labels
-%valence = ("C",4,"N",3,"P",3,"O",2,"S",2);
+my %valence = ("C",4,"N",3,"P",3,"O",2,"S",2);
-$font = '/usr/share/fonts/default/Type1/n021003l.pfb';
-$pointsize = 20;
-@bounds = GD::Image->stringTTF($black,$font,100,0,0,0,"H");
-$ptsize = 100*0.662*$pointsize*(2.54/72)*$scale/(@bounds[3]-@bounds[5]);
+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]);
-for ($i = 0; $i < $natoms; $i++) {
+for (my $i = 0; $i < $natoms; $i++) {
my ($formula,$sign,$charge) =
(@name[$i] =~ /(\w+)([\+|\-])?(\d)?/);
$sign = "–" if ($sign eq "-"); # replace by n-dash
@@ -173,7 +196,7 @@
if ($formula ne "C" || $sign ne ""||
@adjacent[$i] < 2 || (@adjacent[$i] == 2 && @bonds[$i] == 4)) {
# don't show C, unless charged, terminal, or linear
- $nH = 0;
+ my $nH = 0;
if (exists $valence{$formula}) {
$nH = $valence{$formula} - @bonds[$i];
$nH += (($charge eq "")? 1 : $charge) if ($sign eq "+");
@@ -181,9 +204,10 @@
}
$formula .= "H" if ($nH > 0);
$formula .= $nH if ($nH > 1);
- @formula = $formula=~ /[A-Z][a-z]?\d*/g;
+ my @formula = $formula=~ /[A-Z][a-z]?\d*/g;
- $PI = 3.1415;
+ my $PI = 3.1415;
+ my $bondAngle;
if (abs(@bondsy[$i]) < 0.01 && abs(@bondsx[$i]) < 0.01) {
$bondAngle = -$PI;
}
@@ -191,6 +215,7 @@
$bondAngle = atan2(@bondsy[$i],@bondsx[$i]);
}
+ my $direction;
if (@adjacent[$i] < 2) {
$direction = (@bondsx[$i] < 0.01) ? "r" : "l";
}
@@ -211,7 +236,7 @@
if ($direction eq "r") { # direction = right
@formula[0] =~ /([A-Z][a-z]?)(\d*)/;
- $carrige = @x[$i]-stringWidth($1)/2;
+ my $carrige = @x[$i]-stringWidth($1)/2;
foreach (@formula) {
$_ =~ /([A-Z][a-z]?)(\d*)/;
$carrige = printElement ($1,$2,$carrige,@y[$i]);
@@ -220,7 +245,7 @@
}
elsif ($direction eq "l") { # direction = left, reverse hydrogens
@formula[0] =~ /([A-Z][a-z]?)(\d*)/;
- $carrige = @x[$i]+
+ my $carrige = @x[$i]+
stringWidth($1)/2+stringWidth($2)-stringWidth($formula);
foreach (reverse @formula) {
$_ =~ /([A-Z][a-z]?)(\d*)/;
@@ -230,9 +255,9 @@
}
elsif ($direction eq "u") { # direction = up
(shift @formula) =~ /([A-Z][a-z]?)(\d*)/;
- $carrige = @x[$i]-stringWidth($1)/2;
+ my $carrige = @x[$i]-stringWidth($1)/2;
$carrige = printElement ($1,$2,$carrige,@y[$i]);
- $y = (@formula > 0) ? @y[$i] + fm2cm(800) : @y[$i];
+ my $y = (@formula > 0) ? @y[$i] + fm2cm(800) : @y[$i];
$carrige =
(@formula > 0) ? @x[$i]-stringWidth($1)/2 : $carrige;
foreach (@formula) {
@@ -243,9 +268,9 @@
}
else { # direction = down
(shift @formula) =~ /([A-Z][a-z]?)(\d*)/;
- $carrige = @x[$i]-stringWidth($1)/2;
+ my $carrige = @x[$i]-stringWidth($1)/2;
$carrige = printElement ($1,$2,$carrige,@y[$i]);
- $y = (@formula > 0) ? @y[$i] + fm2cm(-800) : @y[$i];
+ my $y = (@formula > 0) ? @y[$i] + fm2cm(-800) : @y[$i];
$carrige =
(@formula > 0) ? @x[$i]-stringWidth($1)/2 : $carrige;
foreach (@formula) {
@@ -255,7 +280,6 @@
printCharge ($sign,$charge,$carrige,$y) if ($sign ne "");
}
}
-
}
# make sure we are writing to a binary stream
@@ -286,7 +310,7 @@
sub printElement { #element symbol + optional subscript
my ($element,$subscript,$x,$y) = @_;
- $yy = 662;
+ my $yy = 662;
my @bounds = GD::Image->stringTTF($black,$font,$ptsize,0,
$x,$height-($y+fm2cm(-$yy/2)),$element);
@@ -312,7 +336,7 @@
sub printCharge {
my ($sign,$charge,$x,$y) = @_;
- $yy = 662;
+ my $yy = 662;
$charge = "" if ($charge == 1);
$charge .= $sign;
@@ -327,41 +351,5 @@
$x = @bounds[2] + 1;
}
-sub dienice {
- my($errmsg) = @_;
- print "Content-type: text/html\n\n";
- print "<h2>Error</h2>\n";
- print "$errmsg<p>\n";
- print "</body></html>\n";
- system("/bin/rm temp/$SNUM.*");
- exit;
-}
-sub read_input
-{
- local ($buffer, @pairs, $pair, $name, $value, %FORM);
- # Read in text
- $ENV{'REQUEST_METHOD'} =~ tr/a-z/A-Z/;
- if ($ENV{'REQUEST_METHOD'} eq "POST")
- {
- read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
- } else
- {
- $buffer = $ENV{'QUERY_STRING'};
- }
- # Split information into name/value pairs
- @pairs = split(/&/, $buffer);
- foreach $pair (@pairs)
- {
- ($name, $value) = split(/=/, $pair);
- $value =~ tr/+/ /;
- $value =~ s/%(..)/pack("C", hex($1))/eg;
- $FORM{$name} = $value;
- }
- %FORM;
-}
-#while (($key,$value) = each %ENV) {
-# print "$key = $value<br>\n";
-#}
-#open(STDERR,">errorlog");
Index: loncom/homework/chemresponse.pm
diff -u loncom/homework/chemresponse.pm:1.15 loncom/homework/chemresponse.pm:1.16
--- loncom/homework/chemresponse.pm:1.15 Thu Oct 16 14:30:46 2003
+++ loncom/homework/chemresponse.pm Thu Oct 16 16:16:42 2003
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# chemical equation style response
#
-# $Id: chemresponse.pm,v 1.15 2003/10/16 18:30:46 albertel Exp $
+# $Id: chemresponse.pm,v 1.16 2003/10/16 20:16:42 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -210,12 +210,12 @@
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);
- $result=<<CHEMOUTPUT;
-<applet code="JME.class" archive="/adm/jme/JME.jar" width="$width" height="$height">
-<param name="options" value="depict,$options" />
-<param name="jme" value="$molecule" />
-</applet>
-CHEMOUTPUT
+ 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.'.WIDTH' => $width );
+
} elsif ($target eq 'edit') {
$result .=&Apache::edit::tag_start($target,$token);
$result .=&Apache::edit::text_arg('Width:','width',$token,5);
--albertel1066335402--