[BACK]Return to convertjme.pl CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / homework
File:  [LON-CAPA] / loncom / homework / convertjme.pl
Revision 1.4: download - view: text, annotated - select for diffs
Fri Oct 17 22:24:51 2003 UTC (20 years, 6 months ago) by albertel
Branches: MAIN
CVS tags: HEAD
- adding convertjme.pl to install
- adding GPL header to convertjme.pl

#!/usr/bin/perl
# The LearningOnline Network with CAPA
# Dynamically converts JME strings into either a png or ps file.
#
# $Id: convertjme.pl,v 1.4 2003/10/17 22:24:51 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
# 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 PostScript::Simple;
use LONCAPA::loncgi();

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;
}

sub unescape {
    my $str=shift;
    $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
    return $str;
}

# 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'};
my $png = $ENV{'cgi.'.$id.'.PNG'};
my $ps = $ENV{'cgi.'.$id.'.PS'};
if (!$width) { $width = 200; }

# parse JME string

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;
}

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;
}

# Find border and move lower left corner to (1.5,1.0)

my $xmin = my $xmax = @x[0];
my $ymin = my $ymax = $y[0];
my $maxName = 0;

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);
    $ymin = @y[$i] if (@y[$i] < $ymin);
    @name[$i] =~ /(\@{1,2})?(\w+)([\+|\-])?(\d)?/;
    $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);

for (my $i = 0; $i < $natoms; $i++) {
    @x[$i] += (1.5+$maxName/2-$xmin);
    if ($png) {  @x[$i] *= $scale; }
    @y[$i] += (1.0-$ymin);
    if ($png) { @y[$i] *= $scale; }
}

# Count bonds

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;

    @adjacent[@atomA[$i]]++;
    @adjacent[@atomB[$i]]++;
    
    @bondsx[@atomA[$i]] += @x[@atomB[$i]] - @x[@atomA[$i]];
    @bondsy[@atomA[$i]] += @y[@atomB[$i]] - @y[@atomA[$i]];
    @bondsx[@atomB[$i]] += @x[@atomA[$i]] - @x[@atomB[$i]];
    @bondsy[@atomB[$i]] += @y[@atomA[$i]] - @y[@atomB[$i]];
}

# Create a new PostScript object
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);
} 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;
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]];
    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;
        my $dd = sqrt($dx*$dx + $dy*$dy);
        $sina=$dy/$dd;
        $cosa=$dx/$dd;
    }
    if    (@bondType[$i] == -2) {
	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;
	    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;
	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) {
	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)||
	    (@adjacent[@atomB[$i]] == 1 && @adjacent[@atomA[$i]] > 2))) {
	# centered bond
	my $xperp = $doubleWidth*$sina;
	my $yperp = $doubleWidth*$cosa;
	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;
	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;
	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 ($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)?/);
    if ($png) {
	$sign = "&#8211;" 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
	my $nH = 0;
	if (exists $valence{$formula}) {
	    $nH = $valence{$formula} - @bonds[$i];
	    $nH += (($charge eq "")? 1 : $charge) if ($sign eq "+");
	    $nH -= (($charge eq "")? 1 : $charge) if ($sign eq "-");
	}
	$formula .= "H" if ($nH > 0);
	$formula .= $nH if ($nH > 1);
	my @formula = $formula=~ /[A-Z][a-z]?\d*/g;

	my $PI = 3.1415;
	my $bondAngle;
	if (abs(@bondsy[$i]) < 0.01 && abs(@bondsx[$i]) < 0.01) {
	    $bondAngle = -$PI;
	}
	else {
	    $bondAngle = atan2(@bondsy[$i],@bondsx[$i]);
	}

	my $direction;
	if (@adjacent[$i] < 2) {
	    $direction = (@bondsx[$i] < 0.01) ? "r" : "l";
	}
	else {
	    if  ($bondAngle >= -$PI/4 && $bondAngle <= $PI/4) {
		$direction = "l";
	    }
	    elsif ($bondAngle > $PI/4 && $bondAngle < 3*$PI/4) {
		$direction = "d";
	    }
	    elsif ($bondAngle < -$PI/4 && $bondAngle > -3*$PI/4) {
		$direction = "u";
	    }
	    else {
		$direction = "r";
	    }
	}
		
	if ($direction eq "r") {  # direction = right
	    @formula[0] =~ /([A-Z][a-z]?)(\d*)/;
	    my $carrige = @x[$i]-stringWidth($1)/2;
	    foreach (@formula) {
		$_ =~ /([A-Z][a-z]?)(\d*)/;
		$carrige = printElement ($1,$2,$carrige,@y[$i]);
	    }
	    printCharge ($sign,$charge,$carrige,@y[$i]) if ($sign ne ""); 
	}
	elsif ($direction eq "l") {  # direction = left, reverse hydrogens
	    @formula[0] =~ /([A-Z][a-z]?)(\d*)/;
	    my $carrige = @x[$i]+
		stringWidth($1)/2+stringWidth($2)-stringWidth($formula);
	    foreach (reverse @formula) {
		$_ =~ /([A-Z][a-z]?)(\d*)/;
		$carrige = printElement ($1,$2,$carrige,@y[$i]);
	    }
	    printCharge ($sign,$charge,$carrige,@y[$i]) if ($sign ne ""); 
	}
	elsif ($direction eq "u") { # direction = up
	    (shift @formula) =~ /([A-Z][a-z]?)(\d*)/;
	    my $carrige = @x[$i]-stringWidth($1)/2;
	    $carrige = printElement ($1,$2,$carrige,@y[$i]);
	    my $y = (@formula > 0) ? @y[$i] + fm2cm(800) : @y[$i];
	    $carrige =
		(@formula > 0) ? @x[$i]-stringWidth($1)/2 : $carrige;
	    foreach (@formula) {
		$_ =~ /([A-Z][a-z]?)(\d*)/;
		$carrige = printElement ($1,$2,$carrige,$y);
	    }
	    printCharge ($sign,$charge,$carrige,$y) if ($sign ne ""); 
	}
	else { # direction = down
	    (shift @formula) =~ /([A-Z][a-z]?)(\d*)/;
	    my $carrige = @x[$i]-stringWidth($1)/2;
	    $carrige = printElement ($1,$2,$carrige,@y[$i]);
	    my $y = (@formula > 0) ? @y[$i] + fm2cm(-800) : @y[$i];
	    $carrige =
		(@formula > 0) ? @x[$i]-stringWidth($1)/2 : $carrige;
	    foreach (@formula) {
		$_ =~ /([A-Z][a-z]?)(\d*)/;
		$carrige = printElement ($1,$2,$carrige,$y);
	    }
	    printCharge ($sign,$charge,$carrige,$y) if ($sign ne ""); 
	}
    }
}

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 "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) {
	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) {
	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;
}

sub fm2cm {  #font metrics to cm
    my ($fm) = @_;
    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_png {  #element symbol + optional subscript
    my ($element,$subscript,$x,$y) = @_;
    my $yy = 662;

    my @bounds = GD::Image->stringTTF($black,$font,$ptsize,0,
				   $x,$height-($y+fm2cm(-$yy/2)),$element);
    $im->filledRectangle(
			 @bounds[6]-1,@bounds[7]-fm2cm(135),
			 @bounds[2]+1,@bounds[3]+fm2cm(135),$white);

    $im->stringTTF($black,$font,$ptsize,0,
		   $x,$height-($y+fm2cm(-$yy/2)),$element);
    $x = @bounds[2] + 1;

    if ($subscript ne "") {
	@bounds = GD::Image->stringTTF($black,$font,0.6*$ptsize,0,
	   $x,$height-($y+fm2cm(-0.8*$yy)),$subscript);
	$im->filledRectangle(
			     @bounds[6]-1,@bounds[7]-fm2cm(45),
			     @bounds[2]+1,@bounds[3]+fm2cm(45),$white);
	$im->stringTTF($black,$font,0.6*$ptsize,0,
				 $x,$height-($y+fm2cm(-0.8*$yy)),$subscript);
    }
    $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;

    $charge = "" if ($charge == 1);
    $charge .= $sign;
    
    my @bounds = GD::Image->stringTTF($black,$font,0.6*$ptsize,0,
       $x,$height-($y+fm2cm(0.2*$yy)),$charge);
    $im->filledRectangle(
			 @bounds[6]-1,@bounds[7]-fm2cm(45),
			 @bounds[2]+1,@bounds[3]+fm2cm(45),$white);

    $im->stringTTF($black,$font,0.6*$ptsize,0,$x,$height-($y+fm2cm(0.2*$yy)),$charge);
    $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));
}
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>