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

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

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