Annotation of loncom/homework/convertjme.pl, revision 1.4

1.1       albertel    1: #!/usr/bin/perl
1.4     ! albertel    2: # The LearningOnline Network with CAPA
        !             3: # Dynamically converts JME strings into either a png or ps file.
        !             4: #
        !             5: # $Id: gplheader.pl,v 1.1 2001/11/29 18:19:27 www Exp $
        !             6: #
        !             7: # Copyright Michigan State University Board of Trustees
        !             8: #
        !             9: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
        !            10: #
        !            11: # LON-CAPA is free software; you can redistribute it and/or modify
        !            12: # it under the terms of the GNU General Public License as published by
        !            13: # the Free Software Foundation; either version 2 of the License, or
        !            14: # (at your option) any later version.
        !            15: #
        !            16: # LON-CAPA is distributed in the hope that it will be useful,
        !            17: # but WITHOUT ANY WARRANTY; without even the implied warranty of
        !            18: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
        !            19: # GNU General Public License for more details.
        !            20: #
        !            21: # You should have received a copy of the GNU General Public License
        !            22: # along with LON-CAPA; if not, write to the Free Software
        !            23: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
        !            24: #
        !            25: # /home/httpd/html/adm/gpl.txt
        !            26: #
        !            27: # http://www.lon-capa.org/
1.1       albertel   28: # Coded by Guy Ashkenazi, guy@fh.huji.ac.il
                     29: # Based on the work of Peter Ertl, peter.ertl@pharma.novartis.com
1.4     ! albertel   30: 
        !            31: 
1.1       albertel   32: 
1.2       albertel   33: use strict;
                     34: use lib '/home/httpd/lib/perl';
1.1       albertel   35: use GD;
1.3       albertel   36: use PostScript::Simple;
1.2       albertel   37: use LONCAPA::loncgi();
                     38: 
                     39: if (! &LONCAPA::loncgi::check_cookie_and_load_env()) {
                     40:     print <<END;
                     41: Content-type: text/html
                     42: 
                     43: <html>
                     44: <head><title>Bad Cookie</title></head>
                     45: <body>
                     46: Your cookie information is incorrect. 
                     47: </body>
                     48: </html>
                     49: END
                     50:     exit;
                     51: }
                     52: 
                     53: sub unescape {
                     54:     my $str=shift;
                     55:     $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
                     56:     return $str;
                     57: }
1.1       albertel   58: 
                     59: # read the width and the JME string from the cgi query
1.2       albertel   60: my $id=$ENV{'QUERY_STRING'};
                     61: my @JMEstring = split(/ /,&unescape($ENV{'cgi.'.$id.'.JME'}));
                     62: my $width = $ENV{'cgi.'.$id.'.WIDTH'};
1.3       albertel   63: my $png = $ENV{'cgi.'.$id.'.PNG'};
                     64: my $ps = $ENV{'cgi.'.$id.'.PS'};
1.2       albertel   65: if (!$width) { $width = 200; }
1.1       albertel   66: 
                     67: # parse JME string
                     68: 
1.2       albertel   69: my $natoms= shift @JMEstring;
                     70: my $nbonds= shift @JMEstring;
                     71: my (@name,@x,@y);
                     72: for (my $i = 0; $i < $natoms; $i++) {
1.1       albertel   73:     @name[$i] = shift @JMEstring;
                     74:     @x[$i] = shift @JMEstring;
                     75:     @y[$i] = shift @JMEstring;
                     76: }
                     77: 
1.2       albertel   78: my (@atomA,@atomB,@bondType);
                     79: for (my $i = 0; $i < $nbonds; $i++) {
1.1       albertel   80:     @atomA[$i] = (shift @JMEstring)-1;
                     81:     @atomB[$i] = (shift @JMEstring)-1;
                     82:     @bondType[$i] = shift @JMEstring;
                     83: }
                     84: 
                     85: # Find border and move lower left corner to (1.5,1.0)
                     86: 
1.2       albertel   87: my $xmin = my $xmax = @x[0];
                     88: my $ymin = my $ymax = $y[0];
                     89: my $maxName = 0;
1.1       albertel   90: 
1.2       albertel   91: for (my $i = 1; $i < $natoms; $i++) {
1.1       albertel   92:     $xmax = @x[$i] if (@x[$i] > $xmax);
                     93:     $xmin = @x[$i] if (@x[$i] < $xmin);
                     94:     $ymax = @y[$i] if (@y[$i] > $ymax);
                     95:     $ymin = @y[$i] if (@y[$i] < $ymin);
                     96:     @name[$i] =~ /(\@{1,2})?(\w+)([\+|\-])?(\d)?/;
                     97:     $maxName = length $2 if (length $2 > $maxName);
                     98: }
                     99: $maxName = ($maxName-3 < 0) ? 0 : $maxName-3;
1.2       albertel  100: my $scale = $width / ($xmax-$xmin+3+$maxName);
                    101: my $height = $scale * ($ymax-$ymin+2);
1.1       albertel  102: 
1.2       albertel  103: for (my $i = 0; $i < $natoms; $i++) {
1.1       albertel  104:     @x[$i] += (1.5+$maxName/2-$xmin);
1.3       albertel  105:     if ($png) {  @x[$i] *= $scale; }
1.1       albertel  106:     @y[$i] += (1.0-$ymin);
1.3       albertel  107:     if ($png) { @y[$i] *= $scale; }
1.1       albertel  108: }
                    109: 
                    110: # Count bonds
                    111: 
1.2       albertel  112: my @bonds = map {0} 0..$natoms-1;
                    113: my @adjacent = map {0} 0..$natoms-1;
                    114: my @bondsx = map {0} 0..$natoms-1;
                    115: my @bondsy = map {0} 0..$natoms-1;
                    116: for (my $i = 0; $i < $nbonds; $i++) {
1.1       albertel  117:     @bonds[@atomA[$i]] += (@bondType[$i]>0) ? @bondType[$i] : 1;
                    118:     @bonds[@atomB[$i]] += (@bondType[$i]>0) ? @bondType[$i] : 1;
                    119: 
                    120:     @adjacent[@atomA[$i]]++;
                    121:     @adjacent[@atomB[$i]]++;
                    122:     
                    123:     @bondsx[@atomA[$i]] += @x[@atomB[$i]] - @x[@atomA[$i]];
                    124:     @bondsy[@atomA[$i]] += @y[@atomB[$i]] - @y[@atomA[$i]];
                    125:     @bondsx[@atomB[$i]] += @x[@atomA[$i]] - @x[@atomB[$i]];
                    126:     @bondsy[@atomB[$i]] += @y[@atomA[$i]] - @y[@atomB[$i]];
                    127: }
                    128: 
                    129: # Create a new PostScript object
1.3       albertel  130: my ($im,$white,$black,$gray);
                    131: if ($png) {
                    132:     $im = new GD::Image($width,$height); 
                    133:     $white = $im->colorAllocate(255,255,255);
                    134:     $black = $im->colorAllocate(0,0,0);
                    135:     $gray = $im->colorAllocate(200,200,200);
1.1       albertel  136: #$gdAntiAliased = $im->colorAllocate(1,1,1);
1.3       albertel  137:     $im->setAntiAliased($black);
                    138: } elsif ($ps) {
                    139:     $im = new PostScript::Simple(xsize => $xmax-$xmin+3+$maxName,
                    140: 				 ysize => $ymax-$ymin+2,
                    141: 				 clip => 1,
                    142: 				 eps => 1,
                    143: 				 color => 0,
                    144: 				 units => "cm");
                    145: }
1.1       albertel  146: 
                    147: # Draw bonds
1.3       albertel  148: my $doubleWidth;
                    149: my $tripleWidth;
                    150: if ($png) {
                    151:     $doubleWidth = 0.10*$scale;
                    152:     $tripleWidth = 0.15*$scale;
                    153: } elsif ($ps) {
                    154:     $doubleWidth = 0.10;
                    155:     $tripleWidth = 0.15;
                    156: }
1.1       albertel  157: 
1.2       albertel  158: for (my $i = 0; $i < $nbonds; $i++) {
                    159:     my $xa = @x[@atomA[$i]];
                    160:     my $ya = @y[@atomA[$i]];
                    161:     my $xb = @x[@atomB[$i]];
                    162:     my $yb = @y[@atomB[$i]];
1.1       albertel  163: 
1.2       albertel  164:     my ($sina,$cosa,$dx,$dy);
1.1       albertel  165:     if (@bondType[$i] != 1) {
                    166:         $dx = $xb-$xa;
                    167: 	$dy = $yb-$ya;
1.2       albertel  168:         my $dd = sqrt($dx*$dx + $dy*$dy);
1.1       albertel  169:         $sina=$dy/$dd;
                    170:         $cosa=$dx/$dd;
                    171:     }
                    172:     if    (@bondType[$i] == -2) {
1.2       albertel  173: 	for (my $t = 0; $t <= 1; $t += 0.1) {
                    174: 	    my $xab = $xa + $t*$dx; 
                    175: 	    my $yab = $ya + $t*$dy; 
                    176: 	    my $xperp = $tripleWidth*$sina*$t;
                    177: 	    my $yperp = $tripleWidth*$cosa*$t;
1.3       albertel  178: 	    if ($png) {
                    179: 		$im->line($xab+$xperp,$height-($yab-$yperp),
                    180: 			  $xab-$xperp,$height-($yab+$yperp),
                    181: 			  gdAntiAliased);
                    182: 	    } elsif ($ps) {
                    183: 		$im->line($xab+$xperp,$yab-$yperp,$xab-$xperp,$yab+$yperp);
                    184: 	    }
1.1       albertel  185: 	}
                    186:     }
                    187:     elsif (@bondType[$i] == -1) {
1.2       albertel  188: 	my $xperp = $tripleWidth*$sina;
                    189: 	my $yperp = $tripleWidth*$cosa;
1.3       albertel  190: 	if ($png) {
                    191: 	    my $poly = new GD::Polygon;
                    192: 	    $poly->addPt($xa,$height-$ya);
                    193: 	    $poly->addPt($xb+$xperp,$height-($yb-$yperp));
                    194: 	    $poly->addPt($xb-$xperp,$height-($yb+$yperp));
                    195: 	    $im->filledPolygon($poly,$black);
                    196: 	} elsif ($ps) {
                    197: 	    $im->polygon({filled=>1},
                    198: 			 $xa,$ya,
                    199: 			 $xb+$xperp,$yb-$yperp,
                    200: 			 $xb-$xperp,$yb+$yperp);
                    201: 	}
1.1       albertel  202:     }
                    203:     elsif (@bondType[$i] == 1) {
1.3       albertel  204: 	if ($png) {
                    205: 	    $im->line($xa,$height-$ya,$xb,$height-$yb,gdAntiAliased);
                    206: 	} elsif ($ps) {
                    207: 	    $im->line($xa,$ya,$xb,$yb);
                    208: 	}
1.1       albertel  209:     }
                    210:     elsif (@bondType[$i] == 2 &&
                    211: 	   ((@adjacent[@atomA[$i]] == 1 && @adjacent[@atomB[$i]] > 2)||
                    212: 	    (@adjacent[@atomB[$i]] == 1 && @adjacent[@atomA[$i]] > 2))) {
                    213: 	# centered bond
1.2       albertel  214: 	my $xperp = $doubleWidth*$sina;
                    215: 	my $yperp = $doubleWidth*$cosa;
1.3       albertel  216: 	if ($png) {
                    217: 	    $im->line($xa+$xperp,$height-($ya-$yperp),
                    218: 		      $xb+$xperp,$height-($yb-$yperp),
                    219: 		      gdAntiAliased);
                    220: 	    $im->line($xa-$xperp,$height-($ya+$yperp),
                    221: 		      $xb-$xperp,$height-($yb+$yperp),
                    222: 		      gdAntiAliased);
                    223: 	} elsif ($ps) {
                    224: 	    $im->line($xa+$xperp,$ya-$yperp,$xb+$xperp,$yb-$yperp);
                    225: 	    $im->line($xa-$xperp,$ya+$yperp,$xb-$xperp,$yb+$yperp);
                    226: 	}
1.1       albertel  227:     }
                    228:     elsif (@bondType[$i] == 2) {
1.2       albertel  229: 	my $xperp = 2*$doubleWidth*$sina;
                    230: 	my $yperp = 2*$doubleWidth*$cosa;
1.3       albertel  231: 	if ($png) {
                    232: 	    $im->line($xa,$height-$ya,$xb,$height-$yb,gdAntiAliased);
                    233: 	    $im->line($xa+0.1*$dx-$xperp,$height-($ya+0.1*$dy+$yperp),
                    234: 		      $xb-0.1*$dx-$xperp,$height-($yb-0.1*$dy+$yperp),
                    235: 		      gdAntiAliased);
                    236: 	} elsif ($ps) {
                    237: 	    $im->line($xa,$ya,$xb,$yb);
                    238: 	    $im->line($xa+0.1*$dx-$xperp,$ya+0.1*$dy+$yperp,
                    239: 		     $xb-0.1*$dx-$xperp,$yb-0.1*$dy+$yperp);
                    240: 
                    241: 	}
1.1       albertel  242:     }
                    243:     elsif (@bondType[$i] == 3) {
1.2       albertel  244: 	my $xperp = $tripleWidth*$sina;
                    245: 	my $yperp = $tripleWidth*$cosa;
1.3       albertel  246: 	if ($png) {
                    247: 	    $im->line($xa,$height-$ya,$xb,$height-$yb,gdAntiAliased);
                    248: 	    $im->line($xa+$xperp,$height-($ya-$yperp),
                    249: 		      $xb+$xperp,$height-($yb-$yperp),
                    250: 		      gdAntiAliased);
                    251: 	    $im->line($xa-$xperp,$height-($ya+$yperp),
                    252: 		      $xb-$xperp,$height-($yb+$yperp),
                    253: 		      gdAntiAliased);
                    254: 	} elsif ($ps) {
                    255: 	    $im->line($xa,$ya,$xb,$yb);
                    256: 	    $im->line($xa+$xperp,$ya-$yperp,$xb+$xperp,$yb-$yperp);
                    257: 	    $im->line($xa-$xperp,$ya+$yperp,$xb-$xperp,$yb+$yperp);
                    258: 	}
1.1       albertel  259:     }   
                    260: }
                    261: 
                    262: # Write labels
                    263: 
1.2       albertel  264: my %valence = ("C",4,"N",3,"P",3,"O",2,"S",2);
1.3       albertel  265: 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);
1.2       albertel  266: my $font = '/usr/share/fonts/default/Type1/n021003l.pfb';
                    267: my $pointsize = 20;
1.3       albertel  268: my ($ptsize,@bounds);
                    269: if ($png) {
                    270:     @bounds = GD::Image->stringTTF($black,$font,100,0,0,0,"H");
                    271:     $ptsize = 100*0.662*$pointsize*(2.54/72)*$scale/(@bounds[3]-@bounds[5]);
                    272: }
1.1       albertel  273: 
1.2       albertel  274: for (my $i = 0; $i < $natoms; $i++) {
1.1       albertel  275:     my ($formula,$sign,$charge) =
                    276: 	(@name[$i] =~ /(\w+)([\+|\-])?(\d)?/);
1.3       albertel  277:     if ($png) {
                    278: 	$sign = "&#8211;" if ($sign eq "-");  # replace by n-dash
                    279:     }
1.1       albertel  280:     if ($formula ne "C" || $sign ne ""||
                    281: 	@adjacent[$i] < 2 || (@adjacent[$i] == 2 && @bonds[$i] == 4)) {
                    282: 	# don't show C, unless charged, terminal, or linear
1.2       albertel  283: 	my $nH = 0;
1.1       albertel  284: 	if (exists $valence{$formula}) {
                    285: 	    $nH = $valence{$formula} - @bonds[$i];
                    286: 	    $nH += (($charge eq "")? 1 : $charge) if ($sign eq "+");
                    287: 	    $nH -= (($charge eq "")? 1 : $charge) if ($sign eq "-");
                    288: 	}
                    289: 	$formula .= "H" if ($nH > 0);
                    290: 	$formula .= $nH if ($nH > 1);
1.2       albertel  291: 	my @formula = $formula=~ /[A-Z][a-z]?\d*/g;
1.1       albertel  292: 
1.2       albertel  293: 	my $PI = 3.1415;
                    294: 	my $bondAngle;
1.1       albertel  295: 	if (abs(@bondsy[$i]) < 0.01 && abs(@bondsx[$i]) < 0.01) {
                    296: 	    $bondAngle = -$PI;
                    297: 	}
                    298: 	else {
                    299: 	    $bondAngle = atan2(@bondsy[$i],@bondsx[$i]);
                    300: 	}
                    301: 
1.2       albertel  302: 	my $direction;
1.1       albertel  303: 	if (@adjacent[$i] < 2) {
                    304: 	    $direction = (@bondsx[$i] < 0.01) ? "r" : "l";
                    305: 	}
                    306: 	else {
                    307: 	    if  ($bondAngle >= -$PI/4 && $bondAngle <= $PI/4) {
                    308: 		$direction = "l";
                    309: 	    }
                    310: 	    elsif ($bondAngle > $PI/4 && $bondAngle < 3*$PI/4) {
                    311: 		$direction = "d";
                    312: 	    }
                    313: 	    elsif ($bondAngle < -$PI/4 && $bondAngle > -3*$PI/4) {
                    314: 		$direction = "u";
                    315: 	    }
                    316: 	    else {
                    317: 		$direction = "r";
                    318: 	    }
                    319: 	}
                    320: 		
                    321: 	if ($direction eq "r") {  # direction = right
                    322: 	    @formula[0] =~ /([A-Z][a-z]?)(\d*)/;
1.2       albertel  323: 	    my $carrige = @x[$i]-stringWidth($1)/2;
1.1       albertel  324: 	    foreach (@formula) {
                    325: 		$_ =~ /([A-Z][a-z]?)(\d*)/;
                    326: 		$carrige = printElement ($1,$2,$carrige,@y[$i]);
                    327: 	    }
                    328: 	    printCharge ($sign,$charge,$carrige,@y[$i]) if ($sign ne ""); 
                    329: 	}
                    330: 	elsif ($direction eq "l") {  # direction = left, reverse hydrogens
                    331: 	    @formula[0] =~ /([A-Z][a-z]?)(\d*)/;
1.2       albertel  332: 	    my $carrige = @x[$i]+
1.1       albertel  333: 		stringWidth($1)/2+stringWidth($2)-stringWidth($formula);
                    334: 	    foreach (reverse @formula) {
                    335: 		$_ =~ /([A-Z][a-z]?)(\d*)/;
                    336: 		$carrige = printElement ($1,$2,$carrige,@y[$i]);
                    337: 	    }
                    338: 	    printCharge ($sign,$charge,$carrige,@y[$i]) if ($sign ne ""); 
                    339: 	}
                    340: 	elsif ($direction eq "u") { # direction = up
                    341: 	    (shift @formula) =~ /([A-Z][a-z]?)(\d*)/;
1.2       albertel  342: 	    my $carrige = @x[$i]-stringWidth($1)/2;
1.1       albertel  343: 	    $carrige = printElement ($1,$2,$carrige,@y[$i]);
1.2       albertel  344: 	    my $y = (@formula > 0) ? @y[$i] + fm2cm(800) : @y[$i];
1.1       albertel  345: 	    $carrige =
                    346: 		(@formula > 0) ? @x[$i]-stringWidth($1)/2 : $carrige;
                    347: 	    foreach (@formula) {
                    348: 		$_ =~ /([A-Z][a-z]?)(\d*)/;
                    349: 		$carrige = printElement ($1,$2,$carrige,$y);
                    350: 	    }
                    351: 	    printCharge ($sign,$charge,$carrige,$y) if ($sign ne ""); 
                    352: 	}
                    353: 	else { # direction = down
                    354: 	    (shift @formula) =~ /([A-Z][a-z]?)(\d*)/;
1.2       albertel  355: 	    my $carrige = @x[$i]-stringWidth($1)/2;
1.1       albertel  356: 	    $carrige = printElement ($1,$2,$carrige,@y[$i]);
1.2       albertel  357: 	    my $y = (@formula > 0) ? @y[$i] + fm2cm(-800) : @y[$i];
1.1       albertel  358: 	    $carrige =
                    359: 		(@formula > 0) ? @x[$i]-stringWidth($1)/2 : $carrige;
                    360: 	    foreach (@formula) {
                    361: 		$_ =~ /([A-Z][a-z]?)(\d*)/;
                    362: 		$carrige = printElement ($1,$2,$carrige,$y);
                    363: 	    }
                    364: 	    printCharge ($sign,$charge,$carrige,$y) if ($sign ne ""); 
                    365: 	}
                    366:     }
                    367: }
                    368: 
1.3       albertel  369: if ($png) {
1.1       albertel  370: # make sure we are writing to a binary stream
1.3       albertel  371:     binmode STDOUT;
1.1       albertel  372: 
                    373: # Convert the image to PNG and print it on standard output
1.3       albertel  374:     print "Content-type: image/png\n\n";
                    375:     print $im->png;
                    376: } elsif ($ps) {
                    377:     my $psfile = "/home/httpd/perl/tmp/".$id.'.eps';
                    378:     $im->output($psfile);
                    379:     print "Content-type: text/html\n\n";
                    380:     print (<<HTML)
                    381: <html>
                    382: <body>
                    383: Wrote eps file $psfile
                    384: </body>
                    385: </html>
                    386: HTML
                    387: }
                    388: 
1.1       albertel  389: sub stringWidth {
                    390:     my ($string) = @_;
                    391:     my $width = 0;
                    392:     while ($string =~ /[A-Za-z]/g) {
1.3       albertel  393: 	if ($png) {
                    394: 	    my @bounds = GD::Image->stringTTF($black,$font,$ptsize,0,0,0,$&);
                    395: 	    $width += @bounds[2]-@bounds[0]+2;
                    396: 	} elsif ($ps) {
                    397: 	    $width += $font_width{$&};
                    398: 	}
1.1       albertel  399:     }
                    400:     while ($string =~ /[\d+-]/g) {
1.3       albertel  401: 	if ($png) {
                    402: 	    my @bounds=GD::Image->stringTTF($black,$font,0.6*$ptsize,0,0,0,$&);
                    403: 	    $width += @bounds[2]-@bounds[0]+2;
                    404: 	} elsif ($ps) {
                    405: 	    $width += 0.6*$font_width{$&};
                    406: 	}
1.1       albertel  407:     }
                    408:     
                    409:     return $width;
                    410: }
                    411: 
                    412: sub fm2cm {  #font metrics to cm
                    413:     my ($fm) = @_;
1.3       albertel  414:     if ($png) {
                    415: 	return $scale*(2.54/72)*$pointsize*$fm/1000;
                    416:     } elsif ($ps) {
                    417: 	return (2.54/72)*$pointsize*$fm/1000;
                    418:     }
                    419: }
                    420: 
                    421: sub printElement {
                    422:     if ($png) {
                    423: 	return &printElement_png(@_);
                    424:     } elsif ($ps) {
                    425: 	return &printElement_ps(@_);
                    426:     }
1.1       albertel  427: }
                    428: 
1.3       albertel  429: sub printElement_png {  #element symbol + optional subscript
1.1       albertel  430:     my ($element,$subscript,$x,$y) = @_;
1.2       albertel  431:     my $yy = 662;
1.1       albertel  432: 
                    433:     my @bounds = GD::Image->stringTTF($black,$font,$ptsize,0,
                    434: 				   $x,$height-($y+fm2cm(-$yy/2)),$element);
                    435:     $im->filledRectangle(
                    436: 			 @bounds[6]-1,@bounds[7]-fm2cm(135),
                    437: 			 @bounds[2]+1,@bounds[3]+fm2cm(135),$white);
                    438: 
                    439:     $im->stringTTF($black,$font,$ptsize,0,
                    440: 		   $x,$height-($y+fm2cm(-$yy/2)),$element);
                    441:     $x = @bounds[2] + 1;
                    442: 
                    443:     if ($subscript ne "") {
                    444: 	@bounds = GD::Image->stringTTF($black,$font,0.6*$ptsize,0,
                    445: 	   $x,$height-($y+fm2cm(-0.8*$yy)),$subscript);
                    446: 	$im->filledRectangle(
                    447: 			     @bounds[6]-1,@bounds[7]-fm2cm(45),
                    448: 			     @bounds[2]+1,@bounds[3]+fm2cm(45),$white);
                    449: 	$im->stringTTF($black,$font,0.6*$ptsize,0,
                    450: 				 $x,$height-($y+fm2cm(-0.8*$yy)),$subscript);
                    451:     }
                    452:     $x = @bounds[2] + 1;
                    453: }
                    454: 
1.3       albertel  455: sub printElement_ps {  #element symbol + optional subscript
                    456:     my ($element,$subscript,$x,$y) = @_;
                    457:     $height = 662;
                    458:     
                    459:     $im->setcolour("white");
                    460:     $im->box({filled=>1},
                    461: 	    $x+fm2cm(-30),$y+fm2cm(-$height/2-150),
                    462: 	    $x+fm2cm(stringWidth($element)+50),$y+fm2cm(+$height/2+150));
                    463:     $im->setcolour("black");
                    464:     $im->setfont("Times-Roman",$pointsize);
                    465:     $im->text($x,$y+fm2cm(-$height/2),$element);
                    466:     $x += fm2cm(stringWidth($element));
                    467: 
                    468:     if ($subscript ne "") {
                    469: 	$im->setcolour("white");
                    470: 	$im->box({filled=>1},
                    471: 		$x,$y+fm2cm(-0.8*$height-45),
                    472: 		$x+fm2cm(stringWidth($subscript)+50),$y+fm2cm(-0.2*$height+45));
                    473: 	$im->setcolour("black");
                    474: 	$im->setfont("Times-Roman",0.6*$pointsize);
                    475: 	$im->text($x,$y+fm2cm(-0.8*$height),$subscript);
                    476:     }
                    477:     $x += fm2cm(stringWidth($subscript));
                    478: }
                    479: 
1.1       albertel  480: sub printCharge {
1.3       albertel  481:     if ($png) {
                    482: 	return &printCharge_png(@_);
                    483:     } elsif ($ps) {
                    484: 	return &printCharge_ps(@_);
                    485:     }
                    486: }
                    487: 
                    488: sub printCharge_png {
1.1       albertel  489:     my ($sign,$charge,$x,$y) = @_;
1.2       albertel  490:     my $yy = 662;
1.1       albertel  491: 
                    492:     $charge = "" if ($charge == 1);
                    493:     $charge .= $sign;
                    494:     
                    495:     my @bounds = GD::Image->stringTTF($black,$font,0.6*$ptsize,0,
                    496:        $x,$height-($y+fm2cm(0.2*$yy)),$charge);
                    497:     $im->filledRectangle(
                    498: 			 @bounds[6]-1,@bounds[7]-fm2cm(45),
                    499: 			 @bounds[2]+1,@bounds[3]+fm2cm(45),$white);
                    500: 
                    501:     $im->stringTTF($black,$font,0.6*$ptsize,0,$x,$height-($y+fm2cm(0.2*$yy)),$charge);
                    502:     $x = @bounds[2] + 1;
                    503: }
                    504: 
1.3       albertel  505: sub printCharge_ps {
                    506:     my ($sign,$charge,$x,$y) = @_;
                    507:     $height = 662;
                    508: 
                    509:     $charge = "" if ($charge == 1);
                    510:     $charge .= $sign;
                    511:     
                    512:     $im->setcolour("white");
                    513:     $im->box({filled=>1},
                    514: 	    $x,$y+fm2cm(0.2*$height-45),
                    515: 	    $x+fm2cm(stringWidth($charge)+50),$y+fm2cm(0.8*$height+45));
                    516: 
                    517:     if ($sign eq "-") { # replace by n-dash
                    518: 	chop $charge;
                    519: 	$charge .= "\xb1";
                    520:     }
                    521:     $im->setcolour("black");
                    522:     $im->setfont("Times-Roman",0.6*$pointsize);
                    523:     $im->text($x,$y+fm2cm(0.2*$height),$charge);
                    524:     $x += fm2cm(stringWidth($charge));
                    525: }
1.1       albertel  526: 
                    527: 

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>