Annotation of loncom/homework/convertjme.pl, revision 1.1
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:
! 6: use GD;
! 7:
! 8: # read the width and the JME string from the cgi query
! 9: %data = &read_input;
! 10: @JMEstring = split (/ /,$data{JME});
! 11: $width = $data{WIDTH};
! 12:
! 13: #print "Content-type: text/plain\n\n";
! 14:
! 15: # parse JME string
! 16:
! 17: $natoms= shift @JMEstring;
! 18: $nbonds= shift @JMEstring;
! 19:
! 20: for ($i = 0; $i < $natoms; $i++) {
! 21: @name[$i] = shift @JMEstring;
! 22: @x[$i] = shift @JMEstring;
! 23: @y[$i] = shift @JMEstring;
! 24: }
! 25:
! 26: for ($i = 0; $i < $nbonds; $i++) {
! 27: @atomA[$i] = (shift @JMEstring)-1;
! 28: @atomB[$i] = (shift @JMEstring)-1;
! 29: @bondType[$i] = shift @JMEstring;
! 30: }
! 31:
! 32: # Find border and move lower left corner to (1.5,1.0)
! 33:
! 34: $xmin = $xmax = @x[0];
! 35: $ymin = $ymax = $y[0];
! 36: $maxName = 0;
! 37:
! 38: for ($i = 1; $i < $natoms; $i++) {
! 39: $xmax = @x[$i] if (@x[$i] > $xmax);
! 40: $xmin = @x[$i] if (@x[$i] < $xmin);
! 41: $ymax = @y[$i] if (@y[$i] > $ymax);
! 42: $ymin = @y[$i] if (@y[$i] < $ymin);
! 43: @name[$i] =~ /(\@{1,2})?(\w+)([\+|\-])?(\d)?/;
! 44: $maxName = length $2 if (length $2 > $maxName);
! 45: }
! 46: $maxName = ($maxName-3 < 0) ? 0 : $maxName-3;
! 47:
! 48: $scale = $width / ($xmax-$xmin+3+$maxName);
! 49: $height = $scale * ($ymax-$ymin+2);
! 50:
! 51: for ($i = 0; $i < $natoms; $i++) {
! 52: @x[$i] += (1.5+$maxName/2-$xmin);
! 53: @x[$i] *= $scale;
! 54: @y[$i] += (1.0-$ymin);
! 55: @y[$i] *= $scale;
! 56: }
! 57:
! 58: # Count bonds
! 59:
! 60: @bonds = map {0} 0..$natoms-1;
! 61: @adjacent = map {0} 0..$natoms-1;
! 62: @bondsx = map {0} 0..$natoms-1;
! 63: @bondsy = map {0} 0..$natoms-1;
! 64: for ($i = 0; $i < $nbonds; $i++) {
! 65: @bonds[@atomA[$i]] += (@bondType[$i]>0) ? @bondType[$i] : 1;
! 66: @bonds[@atomB[$i]] += (@bondType[$i]>0) ? @bondType[$i] : 1;
! 67:
! 68: @adjacent[@atomA[$i]]++;
! 69: @adjacent[@atomB[$i]]++;
! 70:
! 71: @bondsx[@atomA[$i]] += @x[@atomB[$i]] - @x[@atomA[$i]];
! 72: @bondsy[@atomA[$i]] += @y[@atomB[$i]] - @y[@atomA[$i]];
! 73: @bondsx[@atomB[$i]] += @x[@atomA[$i]] - @x[@atomB[$i]];
! 74: @bondsy[@atomB[$i]] += @y[@atomA[$i]] - @y[@atomB[$i]];
! 75: }
! 76:
! 77: # Create a new PostScript object
! 78: $im = new GD::Image($width,$height);
! 79: $white = $im->colorAllocate(255,255,255);
! 80: $black = $im->colorAllocate(0,0,0);
! 81: $gray = $im->colorAllocate(200,200,200);
! 82: #$gdAntiAliased = $im->colorAllocate(1,1,1);
! 83: $im->setAntiAliased($black);
! 84:
! 85: # Draw bonds
! 86: $doubleWidth = 0.10*$scale;
! 87: $tripleWidth = 0.15*$scale;
! 88:
! 89: for ($i = 0; $i < $nbonds; $i++) {
! 90: $xa = @x[@atomA[$i]];
! 91: $ya = @y[@atomA[$i]];
! 92: $xb = @x[@atomB[$i]];
! 93: $yb = @y[@atomB[$i]];
! 94:
! 95: if (@bondType[$i] != 1) {
! 96: $dx = $xb-$xa;
! 97: $dy = $yb-$ya;
! 98: $dd = sqrt($dx*$dx + $dy*$dy);
! 99: $sina=$dy/$dd;
! 100: $cosa=$dx/$dd;
! 101: }
! 102: if (@bondType[$i] == -2) {
! 103: for ($t = 0; $t <= 1; $t += 0.1) {
! 104: $xab = $xa + $t*$dx;
! 105: $yab = $ya + $t*$dy;
! 106: $xperp = $tripleWidth*$sina*$t;
! 107: $yperp = $tripleWidth*$cosa*$t;
! 108: $im->line($xab+$xperp,$height-($yab-$yperp),
! 109: $xab-$xperp,$height-($yab+$yperp),
! 110: gdAntiAliased);
! 111: }
! 112: }
! 113: elsif (@bondType[$i] == -1) {
! 114: $xperp = $tripleWidth*$sina;
! 115: $yperp = $tripleWidth*$cosa;
! 116: $poly = new GD::Polygon;
! 117: $poly->addPt($xa,$height-$ya);
! 118: $poly->addPt($xb+$xperp,$height-($yb-$yperp));
! 119: $poly->addPt($xb-$xperp,$height-($yb+$yperp));
! 120: $im->filledPolygon($poly,$black);
! 121: }
! 122: elsif (@bondType[$i] == 1) {
! 123: $im->line($xa,$height-$ya,$xb,$height-$yb,gdAntiAliased);
! 124: }
! 125: elsif (@bondType[$i] == 2 &&
! 126: ((@adjacent[@atomA[$i]] == 1 && @adjacent[@atomB[$i]] > 2)||
! 127: (@adjacent[@atomB[$i]] == 1 && @adjacent[@atomA[$i]] > 2))) {
! 128: # centered bond
! 129: $xperp = $doubleWidth*$sina;
! 130: $yperp = $doubleWidth*$cosa;
! 131: $im->line($xa+$xperp,$height-($ya-$yperp),
! 132: $xb+$xperp,$height-($yb-$yperp),
! 133: gdAntiAliased);
! 134: $im->line($xa-$xperp,$height-($ya+$yperp),
! 135: $xb-$xperp,$height-($yb+$yperp),
! 136: gdAntiAliased);
! 137: }
! 138: elsif (@bondType[$i] == 2) {
! 139: $xperp = 2*$doubleWidth*$sina;
! 140: $yperp = 2*$doubleWidth*$cosa;
! 141: $im->line($xa,$height-$ya,$xb,$height-$yb,gdAntiAliased);
! 142: $im->line($xa+0.1*$dx-$xperp,$height-($ya+0.1*$dy+$yperp),
! 143: $xb-0.1*$dx-$xperp,$height-($yb-0.1*$dy+$yperp),
! 144: gdAntiAliased);
! 145: }
! 146: elsif (@bondType[$i] == 3) {
! 147: $xperp = $tripleWidth*$sina;
! 148: $yperp = $tripleWidth*$cosa;
! 149: $im->line($xa,$height-$ya,$xb,$height-$yb,gdAntiAliased);
! 150: $im->line($xa+$xperp,$height-($ya-$yperp),
! 151: $xb+$xperp,$height-($yb-$yperp),
! 152: gdAntiAliased);
! 153: $im->line($xa-$xperp,$height-($ya+$yperp),
! 154: $xb-$xperp,$height-($yb+$yperp),
! 155: gdAntiAliased);
! 156: }
! 157: }
! 158:
! 159: # Write labels
! 160:
! 161: %valence = ("C",4,"N",3,"P",3,"O",2,"S",2);
! 162:
! 163: $font = '/usr/share/fonts/default/Type1/n021003l.pfb';
! 164: $pointsize = 20;
! 165: @bounds = GD::Image->stringTTF($black,$font,100,0,0,0,"H");
! 166: $ptsize = 100*0.662*$pointsize*(2.54/72)*$scale/(@bounds[3]-@bounds[5]);
! 167:
! 168: for ($i = 0; $i < $natoms; $i++) {
! 169: my ($formula,$sign,$charge) =
! 170: (@name[$i] =~ /(\w+)([\+|\-])?(\d)?/);
! 171: $sign = "–" if ($sign eq "-"); # replace by n-dash
! 172:
! 173: if ($formula ne "C" || $sign ne ""||
! 174: @adjacent[$i] < 2 || (@adjacent[$i] == 2 && @bonds[$i] == 4)) {
! 175: # don't show C, unless charged, terminal, or linear
! 176: $nH = 0;
! 177: if (exists $valence{$formula}) {
! 178: $nH = $valence{$formula} - @bonds[$i];
! 179: $nH += (($charge eq "")? 1 : $charge) if ($sign eq "+");
! 180: $nH -= (($charge eq "")? 1 : $charge) if ($sign eq "-");
! 181: }
! 182: $formula .= "H" if ($nH > 0);
! 183: $formula .= $nH if ($nH > 1);
! 184: @formula = $formula=~ /[A-Z][a-z]?\d*/g;
! 185:
! 186: $PI = 3.1415;
! 187: if (abs(@bondsy[$i]) < 0.01 && abs(@bondsx[$i]) < 0.01) {
! 188: $bondAngle = -$PI;
! 189: }
! 190: else {
! 191: $bondAngle = atan2(@bondsy[$i],@bondsx[$i]);
! 192: }
! 193:
! 194: if (@adjacent[$i] < 2) {
! 195: $direction = (@bondsx[$i] < 0.01) ? "r" : "l";
! 196: }
! 197: else {
! 198: if ($bondAngle >= -$PI/4 && $bondAngle <= $PI/4) {
! 199: $direction = "l";
! 200: }
! 201: elsif ($bondAngle > $PI/4 && $bondAngle < 3*$PI/4) {
! 202: $direction = "d";
! 203: }
! 204: elsif ($bondAngle < -$PI/4 && $bondAngle > -3*$PI/4) {
! 205: $direction = "u";
! 206: }
! 207: else {
! 208: $direction = "r";
! 209: }
! 210: }
! 211:
! 212: if ($direction eq "r") { # direction = right
! 213: @formula[0] =~ /([A-Z][a-z]?)(\d*)/;
! 214: $carrige = @x[$i]-stringWidth($1)/2;
! 215: foreach (@formula) {
! 216: $_ =~ /([A-Z][a-z]?)(\d*)/;
! 217: $carrige = printElement ($1,$2,$carrige,@y[$i]);
! 218: }
! 219: printCharge ($sign,$charge,$carrige,@y[$i]) if ($sign ne "");
! 220: }
! 221: elsif ($direction eq "l") { # direction = left, reverse hydrogens
! 222: @formula[0] =~ /([A-Z][a-z]?)(\d*)/;
! 223: $carrige = @x[$i]+
! 224: stringWidth($1)/2+stringWidth($2)-stringWidth($formula);
! 225: foreach (reverse @formula) {
! 226: $_ =~ /([A-Z][a-z]?)(\d*)/;
! 227: $carrige = printElement ($1,$2,$carrige,@y[$i]);
! 228: }
! 229: printCharge ($sign,$charge,$carrige,@y[$i]) if ($sign ne "");
! 230: }
! 231: elsif ($direction eq "u") { # direction = up
! 232: (shift @formula) =~ /([A-Z][a-z]?)(\d*)/;
! 233: $carrige = @x[$i]-stringWidth($1)/2;
! 234: $carrige = printElement ($1,$2,$carrige,@y[$i]);
! 235: $y = (@formula > 0) ? @y[$i] + fm2cm(800) : @y[$i];
! 236: $carrige =
! 237: (@formula > 0) ? @x[$i]-stringWidth($1)/2 : $carrige;
! 238: foreach (@formula) {
! 239: $_ =~ /([A-Z][a-z]?)(\d*)/;
! 240: $carrige = printElement ($1,$2,$carrige,$y);
! 241: }
! 242: printCharge ($sign,$charge,$carrige,$y) if ($sign ne "");
! 243: }
! 244: else { # direction = down
! 245: (shift @formula) =~ /([A-Z][a-z]?)(\d*)/;
! 246: $carrige = @x[$i]-stringWidth($1)/2;
! 247: $carrige = printElement ($1,$2,$carrige,@y[$i]);
! 248: $y = (@formula > 0) ? @y[$i] + fm2cm(-800) : @y[$i];
! 249: $carrige =
! 250: (@formula > 0) ? @x[$i]-stringWidth($1)/2 : $carrige;
! 251: foreach (@formula) {
! 252: $_ =~ /([A-Z][a-z]?)(\d*)/;
! 253: $carrige = printElement ($1,$2,$carrige,$y);
! 254: }
! 255: printCharge ($sign,$charge,$carrige,$y) if ($sign ne "");
! 256: }
! 257: }
! 258:
! 259: }
! 260:
! 261: # make sure we are writing to a binary stream
! 262: binmode STDOUT;
! 263:
! 264: # Convert the image to PNG and print it on standard output
! 265: print "Content-type: image/png\n\n";
! 266: print $im->png;
! 267: sub stringWidth {
! 268: my ($string) = @_;
! 269: my $width = 0;
! 270: while ($string =~ /[A-Za-z]/g) {
! 271: my @bounds = GD::Image->stringTTF($black,$font,$ptsize,0,0,0,$&);
! 272: $width += @bounds[2]-@bounds[0]+2;
! 273: }
! 274: while ($string =~ /[\d+-]/g) {
! 275: my @bounds = GD::Image->stringTTF($black,$font,0.6*$ptsize,0,0,0,$&);
! 276: $width += @bounds[2]-@bounds[0]+2;
! 277: }
! 278:
! 279: return $width;
! 280: }
! 281:
! 282: sub fm2cm { #font metrics to cm
! 283: my ($fm) = @_;
! 284: return $scale*(2.54/72)*$pointsize*$fm/1000;
! 285: }
! 286:
! 287: sub printElement { #element symbol + optional subscript
! 288: my ($element,$subscript,$x,$y) = @_;
! 289: $yy = 662;
! 290:
! 291: my @bounds = GD::Image->stringTTF($black,$font,$ptsize,0,
! 292: $x,$height-($y+fm2cm(-$yy/2)),$element);
! 293: $im->filledRectangle(
! 294: @bounds[6]-1,@bounds[7]-fm2cm(135),
! 295: @bounds[2]+1,@bounds[3]+fm2cm(135),$white);
! 296:
! 297: $im->stringTTF($black,$font,$ptsize,0,
! 298: $x,$height-($y+fm2cm(-$yy/2)),$element);
! 299: $x = @bounds[2] + 1;
! 300:
! 301: if ($subscript ne "") {
! 302: @bounds = GD::Image->stringTTF($black,$font,0.6*$ptsize,0,
! 303: $x,$height-($y+fm2cm(-0.8*$yy)),$subscript);
! 304: $im->filledRectangle(
! 305: @bounds[6]-1,@bounds[7]-fm2cm(45),
! 306: @bounds[2]+1,@bounds[3]+fm2cm(45),$white);
! 307: $im->stringTTF($black,$font,0.6*$ptsize,0,
! 308: $x,$height-($y+fm2cm(-0.8*$yy)),$subscript);
! 309: }
! 310: $x = @bounds[2] + 1;
! 311: }
! 312:
! 313: sub printCharge {
! 314: my ($sign,$charge,$x,$y) = @_;
! 315: $yy = 662;
! 316:
! 317: $charge = "" if ($charge == 1);
! 318: $charge .= $sign;
! 319:
! 320: my @bounds = GD::Image->stringTTF($black,$font,0.6*$ptsize,0,
! 321: $x,$height-($y+fm2cm(0.2*$yy)),$charge);
! 322: $im->filledRectangle(
! 323: @bounds[6]-1,@bounds[7]-fm2cm(45),
! 324: @bounds[2]+1,@bounds[3]+fm2cm(45),$white);
! 325:
! 326: $im->stringTTF($black,$font,0.6*$ptsize,0,$x,$height-($y+fm2cm(0.2*$yy)),$charge);
! 327: $x = @bounds[2] + 1;
! 328: }
! 329:
! 330: sub dienice {
! 331: my($errmsg) = @_;
! 332: print "Content-type: text/html\n\n";
! 333: print "<h2>Error</h2>\n";
! 334: print "$errmsg<p>\n";
! 335: print "</body></html>\n";
! 336: system("/bin/rm temp/$SNUM.*");
! 337: exit;
! 338: }
! 339:
! 340: sub read_input
! 341: {
! 342: local ($buffer, @pairs, $pair, $name, $value, %FORM);
! 343: # Read in text
! 344: $ENV{'REQUEST_METHOD'} =~ tr/a-z/A-Z/;
! 345: if ($ENV{'REQUEST_METHOD'} eq "POST")
! 346: {
! 347: read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
! 348: } else
! 349: {
! 350: $buffer = $ENV{'QUERY_STRING'};
! 351: }
! 352: # Split information into name/value pairs
! 353: @pairs = split(/&/, $buffer);
! 354: foreach $pair (@pairs)
! 355: {
! 356: ($name, $value) = split(/=/, $pair);
! 357: $value =~ tr/+/ /;
! 358: $value =~ s/%(..)/pack("C", hex($1))/eg;
! 359: $FORM{$name} = $value;
! 360: }
! 361: %FORM;
! 362: }
! 363:
! 364: #while (($key,$value) = each %ENV) {
! 365: # print "$key = $value<br>\n";
! 366: #}
! 367: #open(STDERR,">errorlog");
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to convertjme.pl CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / homework