Mercurial > repos > davidvanzessen > mutation_analysis

comparison template.pm @ 2:2f4298673519 draft

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Uploaded
author davidvanzessen
date Wed, 10 Sep 2014 10:33:29 -0400
parents
children
comparison
equal deleted inserted replaced
1:856b5b718d21 2:2f4298673519
1 =head1 NAME
2
3 template.pm - creates logo output in various formats
4
5 =head1 SYNOPSIS
6
7 Perl module
8
9 =head1 DESCRIPTION
10
11 logo.cgi and run.pl collect the logo data. They can then enter
12 template::create_template to create logo output in the following formats:
13
14 * EPS
15 * GIF
16 * PDF
17 * PNG
18
19
20
21 If the configuration file "logo.conf" exists in the working directory, then
22 it will be parsed for the locations of GhostScript (gs) and convert. The
23 following is an
24 example of the configuration file ("#" at beginning of line indicates
25 comment):
26
27 # Make configuration changes here. Rename this file to logo.conf
28 # gs version 5.5 does not work, 6.5 does
29 # set the PATHS
30 gs=/usr/local/bin/gs
31 convert=/usr/X11R6/bin/convert
32
33 =cut
34
35 package template;
36 use strict;
37
38
39 ################################################################################
40 ######## STATE FOR FILLINGS ##########
41 ################################################################################
42
43 # BARBITS number of bits in vertical y-axis bar
44 # CHARWIDTH width of characters in logo
45 # COLORSCHEME "a" for amino acid;
46 # "n" for nucleic acid;
47 # "b" for black (no color scheme)
48 # color scheme
49 # DATA string of heights of characters in cm
50 # DESC description of aligned sequences
51 # FINEPRINT enable adverts/credits
52 # LOGOLINES number of lines of logo
53 # LOGOHEIGHT height of EACH LINE in logo (in cm)
54 # LOGOWIDTH width of final logo in cm
55 # LOGOHEIGHTPOINTS height of final logo in points
56 # LOGOWIDTHPOINTS height of final logo in points
57 # LOGOSTART logo output will begin at residue LOGOSTART
58 # LOGOEND logo output will end at residue LOGOEND
59 # ERRBAR 1 to include error bar, 0 to exclude
60 # ERRORBARFRACTION percent of error bar to show in range [0,1]
61 # KIND $AA for amino acid, $NA for nucleic acid
62 # NUMBERING 1 to show residue numbers, 0 to exclude
63 # OUTLINE 1 to print characters in outline form;
64 # 0 to print characters in solid form
65 # SHOWENDS "d" to show 5' and 3' ends;
66 # "p" to show N and C termini;
67 # "-" to exclude end markers
68 # SHOWINGBOX "n" to have No boxes around characters;
69 # "s" to have boxes around characters, with Shrinking;
70 # "f" to have Filled boxes around characters
71 # SHRINKBOOLEAN 1 to shrink characters; 0 to exclude shrinking
72 # SHRINKFACTOR amount to shrink in range from 1(no shrinking) to
73 # 0(full shrinking)
74 # START_NUM start number for very beginning of sequence
75 # TITLE title of logo
76 # YAXIS 1 to turn on y axis and its labels
77
78 ################################################################################
79 ##### VARIABLES AND DEFAULT VALUES #####
80 ################################################################################
81
82 my %defaults = (
83 LOGOHEIGHT => 5,
84 LOGOWIDTH => 8,
85
86 YAXIS => "false",
87 TITLE => "",
88 YAXIS_LABEL => "bits",
89 XAXIS_LABEL => "",
90
91 BARENDS => "false",
92 OUTLINE => "false",
93 SHOWINGBOX => "n",
94 NUMBERING => "false",
95 #FINEPRINT => "Created by: G. E. Crooks, G. Hon, J.-M. Chandonia & S. E. Brenner, (2002) <weblogo.berkeley.edu>",
96 FINEPRINT => "weblogo.berkeley.edu",
97
98 ERRORBARFRACTION => "1",
99 ERRBAR => "0",
100 SHRINKFACTOR => "1",
101 START_NUM => "1",
102
103 DEFAULT_COLOR => "black",
104
105 black => "[0 0 0]",
106 red => "[0.8 0 0]",
107 green => "[0 0.8 0]",
108 blue => "[0 0 0.8]",
109 yellow => "[1 0.7 1.0]",
110 purple => "[0.8 0 0.8]",
111 orange => "[1 0.7 0]"
112 );
113
114 my $AA = 0;
115 my $NA = 1;
116 my $PATH;
117
118 ################################################################################
119 ##### SOME FUNCTIONS #####
120 ################################################################################
121
122
123 sub create_template {
124 my ($input, $kind, $desc_r, $data_r, $outfile, $path) = @_;
125
126 # set path
127 $PATH = $path;
128
129 #Create EPS file
130 my %fillings;
131
132 # put parameters in fillings
133 makeFillings(\%fillings, $input, $kind, $desc_r, $defaults{FINEPRINT});
134
135 # set default data if not filled
136 setDefaults(\%fillings, \%defaults, scalar @$data_r);
137
138 # put color in fillings
139 setColors(\%fillings, \%defaults);
140
141 # put data in fillings
142 setData(\%fillings, $data_r);
143
144 # make eps output
145 my $eps = fillTemplate("$PATH/template.eps", \%fillings);
146 my $format = $input->{FORMAT};
147
148 # convert
149 my ($gsprog, $convertprog) = getProgs();
150
151 # print STDERR "(gsprog, convertprog) = ($gsprog, $convertprog)\n";
152
153 my $width = $fillings{LOGOWIDTHPOINTS};
154 my $height = $fillings{LOGOHEIGHTPOINTS}; # height of entire logo
155 my $res = $input->{RES};
156 my $antialias = (defined $input->{ANTIALIAS} && $input->{ANTIALIAS}) ? "-dTextAlphaBits=4" : "";
157
158 my $r = $width . "x" . $height;
159
160 if( $format eq "EPS" ) {
161 if ($outfile eq "-") { # if standard out
162 print $eps;
163 } else {
164 open (WRITEME, ">$outfile");
165 print WRITEME $eps;
166 close (WRITEME);
167 }
168
169 } elsif ($format eq "PDF"){
170 # print("outfile = $outfile\n");
171 my $program = "| $gsprog -sOutputFile=$outfile -sDEVICE=pdfwrite -dPDFSETTINGS=/printer -q -r$res -dDEVICEWIDTHPOINTS=$width -dDEVICEHEIGHTPOINTS=$height -dEmbedAllFonts=true $antialias -dSAFER -dBATCH -dNOPAUSE -_";
172 open(WRITEME, $program);
173 print WRITEME "$eps";
174 close (WRITEME);
175
176 } elsif ( $format eq "PNG" ) {
177 my $program = "| $gsprog -sOutputFile=$outfile -sDEVICE=png16m -q -r$res -dDEVICEWIDTHPOINTS=$width -dDEVICEHEIGHTPOINTS=$height $antialias -dSAFER -dBATCH -dNOPAUSE -_";
178 #print ("$program");
179 open(WRITEME, $program);
180 print WRITEME "$eps";
181 close (WRITEME);
182
183 } elsif ($format eq "GIF") {
184 # convert to EPS first, then GIF
185 die "Please check logo.conf: convert program does not exist"
186 if (!defined $convertprog || !(-e $convertprog));
187
188 my $program = "| $gsprog -sOutputFile=- -sDEVICE=png16m -q -r$res -dDEVICEWIDTHPOINTS=$width -dDEVICEHEIGHTPOINTS=$height $antialias -dSAFER -dBATCH -dNOPAUSE -_";
189
190 if ($outfile eq "-") {
191 $program .= " | $convertprog png:- gif:-";
192 } else {
193 $program .= " | $convertprog png:- $outfile";
194 }
195
196 open(WRITEME, $program);
197 print WRITEME "$eps";
198 close (WRITEME);
199 }
200 }
201
202 #deprecated
203 sub c {
204 return create_template( @_);
205 }
206
207 sub getProgs {
208 my ($gsprog, $convertprog) = ("gs", "convert");
209
210
211 # No configuration file, then return defaults.
212 return ($gsprog, $convertprog) if (! (-e "$PATH/logo.conf"));
213 open (CONF, "$PATH/logo.conf");
214
215 while (<CONF>) {
216 next if (/^\#/); # skip lines beginning with "#"
217 if (m/^gs/i) { # if looks like gs (case insensitive)
218 ($gsprog) = ($_ =~ /^\S+\=(.+)$/);
219 }
220 if (m/^convert/i) { # if looks like convert (case insensitive)
221 ($convertprog) = ($_ =~ /^\S+\=(.+)$/);
222 }
223 }
224
225 # Do these fings exist?
226 my ($gsprogname) = ($gsprog =~ /^(\S+)/);
227
228 die "Please check $PATH/logo.conf: gs program ($gsprogname) does not exist" if (!defined $gsprogname || !(-e $gsprogname));
229 #die "Please check logo.conf: convert program does not exist" if (!defined $convertprog || !(-e $convertprog));
230
231 return ($gsprog, $convertprog);
232 }
233
234 sub get_eps {
235 my ($input, $kind, $desc_r, $data_r) = @_;
236 my %fillings;
237
238 # put parameters in fillings
239 makeFillings(\%fillings, $input, $kind, $desc_r);
240
241 # set default data if not filled
242 setDefaults(\%fillings, \%defaults, $#$data_r);
243
244 # put data in fillings
245 setData(\%fillings, $data_r);
246
247 # make output
248 return fillTemplate("$PATH/template.eps", \%fillings);
249 }
250
251 sub fillTemplate {
252 my ($filename, $fillings) = @_;
253
254 if (not -e $filename) {
255 die "filename ($filename) must exist\n";
256 }
257
258 my $text;
259 local $/; # slurp mode (undef)
260 local *F; # create local filehandle
261 open(F, "< $filename\0") || return;
262 $text = <F>;
263 close(F);
264
265 #replace {$KEYWORDS} with value in %$fillings hash
266 $text =~ s{ \{\$ (.*?) \} }
267 { exists( $fillings->{$1})
268 ? $fillings->{$1}
269 : ""
270 }gsex;
271 return $text;
272 }
273
274
275 ################################################################################
276 ##### FILL THE FILLINGS HERE #####
277 ################################################################################
278
279 sub isChecked {
280 return 0 if (!defined $_[0]);
281 return $_[0];
282 }
283
284 # negative/positive ints
285 sub isInt {
286 return ($_[0] =~ /^[-\+]?\d+$/) ? 1 : 0;
287 }
288
289 sub makeFillings {
290
291 # my ($fillings, $input, $kind, $desc_r, $data_r, $fineprint) = @_;
292 my ($fillings, $input, $kind, $desc_r, $fineprint) = @_;
293 $fillings->{KIND} = $kind;
294 $fillings->{LOGOHEIGHT} = $input->{LOGO_HEIGHT};
295 $fillings->{LOGOWIDTH} = $input->{LOGO_WIDTH};
296 $fillings->{OUTLINE} = (isChecked($input->{OUTLINE})) ? "true" : "false";
297 $fillings->{NUMBERING} = (isChecked($input->{NUMBERING})) ? "true" : "false";
298 $fillings->{FINEPRINT} = (isChecked($input->{FINEPRINT})) ? $fineprint : "";
299
300 $fillings->{LOGOSTART} = $input->{LOGOSTART};
301 $fillings->{LOGOEND} = $input->{LOGOEND};
302 $fillings->{START_NUM} = $input->{START_NUM};
303
304 $fillings->{YAXIS} = (isChecked($input->{YAXIS}) && !isChecked($input->{STRETCH})) ? "true" : "false";
305
306
307
308 $fillings->{TITLE} = $input->{TITLETEXT};
309 $fillings->{YAXIS_LABEL} = $input->{YAXIS_LABEL};
310
311 $fillings->{XAXIS_LABEL} = $input->{XAXIS_LABEL};
312 $fillings->{ERRBAR} = $input->{ERRBAR};
313 $fillings->{SHOWINGBOX} = (isChecked($input->{SHOWINGBOX})) ? "s" : "n";
314 $fillings->{SHRINKBOOLEAN} = ($fillings->{SHOWINGBOX} eq "s") ? "true" : "false";
315 $fillings->{SHRINKFACTOR} = $input->{BOXSHRINK};
316
317 if ((defined $input->{CHARSPERLINE}) &&
318 isInt($input->{CHARSPERLINE}) &&
319 ($input->{CHARSPERLINE} > 0)) {
320 $fillings->{CHARSPERLINE} = $input->{CHARSPERLINE};
321 }
322
323 if (defined $input->{BARBITS}) {
324 $fillings->{BARBITS} = $input->{BARBITS};
325 } else {
326 $fillings->{BARBITS} = ($fillings->{KIND} == $AA) ? 4.3 : 2;
327 }
328
329 if (defined $input->{TICBITS}) {
330 $fillings->{TICBITS} = $input->{TICBITS};
331 } else {
332 $fillings->{TICBITS} = 1;
333 }
334
335
336
337
338 # if (isChecked($input->{NOCOLOR})) {
339 # $fillings->{COLORSCHEME} = "b";
340 # } else {
341 # $fillings->{COLORSCHEME} = ($kind == $AA) ? "a" : "n";
342 # }
343
344 #color
345 if (defined $input->{DEFAULT_COLOR}) {
346 $fillings->{DEFAULT_COLOR} = (isHexColor( $input->{DEFAULT_COLOR})) ? "c" . $input->{DEFAULT_COLOR} :
347 $input->{DEFAULT_COLOR};
348 }
349
350 if (isChecked($input->{SHOWENDS})) {
351 $fillings->{SHOWENDS} = ($fillings->{KIND} == $AA) ? "p" : "d";
352 } else {
353 $fillings->{SHOWENDS} = "-";
354 }
355
356 $fillings->{DESC} = getDescription($desc_r, $fillings->{KIND});
357
358 $fillings->{ERRORBARFRACTION} = $input->{ERRORBARFRACTION};
359 $fillings->{COLORSCHEME} = $input->{COLORSCHEME};
360 $fillings->{COLORS} = $input->{COLORS};
361 }
362
363 sub getDescription {
364 my $returnVal = "";
365
366 foreach (@{$_[0]}) {
367 if(defined($_)) {
368 $returnVal .= "% * $_\n";
369 } else {
370 $returnVal .= "% * \n";
371 }
372 }
373
374 if ($_[1] == $AA) {
375 $returnVal .= "% * PROTEIN ALIGNMENT";
376 } else {
377 $returnVal .= "% * NUCLEOTIDE ALIGNMENT";
378 }
379
380 return $returnVal;
381 }
382
383
384 ################################################################################
385 ##### SETTING DEFAULTS #####
386 ################################################################################
387
388 sub setDefaults {
389 my ($fillings, $defaults, $numchars) = @_;
390
391 $fillings->{LOGOHEIGHT} = $defaults->{LOGOHEIGHT} if !defined $fillings->{LOGOHEIGHT};
392 $fillings->{LOGOWIDTH} = $defaults->{LOGOWIDTH} if !defined $fillings->{LOGOWIDTH};
393
394 $fillings->{START_NUM} = $defaults->{START_NUM} if !defined $fillings->{START_NUM};
395 $fillings->{LOGOSTART} = $fillings->{START_NUM} if !defined $fillings->{LOGOSTART};
396 $fillings->{LOGOEND} = $numchars + $fillings->{LOGOSTART} - 1 if !defined $fillings->{LOGOEND};
397
398 $fillings->{YAXIS} = $defaults->{YAXIS} if !defined $fillings->{YAXIS};
399 $fillings->{TITLE} = $defaults->{TITLE} if !defined $fillings->{TITLE} || $fillings->{TITLE} eq "";
400 #$fillings->{YAXIS_LABEL} = $defaults->{YAXIS_LABEL} if !defined $fillings->{YAXIS_LABEL} || $fillings->{YAXIS_LABEL} eq "";
401 $fillings->{YAXIS_LABEL} = $defaults->{YAXIS_LABEL} if !defined $fillings->{YAXIS_LABEL} ;
402 $fillings->{XAXIS_LABEL} = $defaults->{XAXIS_LABEL} if !defined $fillings->{XAXIS_LABEL} || $fillings->{XAXIS_LABEL} eq "";
403
404 $fillings->{BARENDS} = $defaults->{BARENDS} if !defined $fillings->{BARENDS};
405 $fillings->{OUTLINE} = $defaults->{OUTLINE} if !defined $fillings->{OUTLINE};
406 $fillings->{SHOWINGBOX} = $defaults->{SHOWINGBOX} if !defined $fillings->{SHOWINGBOX};
407 $fillings->{NUMBERING} = $defaults->{NUMBERING} if !defined $fillings->{NUMBERING};
408
409 $fillings->{ERRORBARFRACTION} = $defaults->{ERRORBARFRACTION} if !defined $fillings->{ERRORBARFRACTION};
410 $fillings->{SHRINKFACTOR} = $defaults->{SHRINKFACTOR} if !defined $fillings->{SHRINKFACTOR};
411 $fillings->{ERRBAR} = $defaults->{ERRBAR} if !defined $fillings->{ERRBAR};
412
413 # printf("logostart = %d, start num = %d, numchars = $numchars, logoend = %d\n", $fillings->{LOGOSTART}, $fillings->{START_NUM},
414 # $fillings->{LOGOEND});
415
416 my $givenrange = $fillings->{LOGOEND} - $fillings->{LOGOSTART} + 1;
417 my $possiblerange = $numchars - ($fillings->{LOGOSTART} - $fillings->{START_NUM});
418
419 if (!defined $fillings->{CHARSPERLINE} && ($givenrange > $possiblerange)) {
420 $fillings->{CHARSPERLINE} = $numchars - ($fillings->{LOGOSTART} - $fillings->{START_NUM});
421 } elsif (!defined $fillings->{CHARSPERLINE}) {
422 $fillings->{CHARSPERLINE} = $fillings->{LOGOEND} - $fillings->{LOGOSTART} + 1;
423 }
424
425 $fillings->{DEFAULT_COLOR} = $defaults->{DEFAULT_COLOR} if !defined $fillings->{DEFAULT_COLOR} ||
426 $fillings->{DEFAULT_COLOR} eq "";
427
428 # printf("chars per line = %s\n",$fillings->{CHARSPERLINE});
429 # print("givenrange = $givenrange, possiblerange = $possiblerange\n");
430
431 if ($givenrange > $possiblerange) {
432 $fillings->{LOGOLINES} = roundup($possiblerange / $fillings->{CHARSPERLINE});
433 } else {
434 $fillings->{LOGOLINES} = roundup($givenrange / $fillings->{CHARSPERLINE});
435 }
436
437 $fillings->{CHARWIDTH} = ($fillings->{LOGOWIDTH} - 1.5) / $fillings->{CHARSPERLINE};
438
439 # # change height if more than 1 line
440 # $fillings->{LOGOHEIGHTPOINTS} = int($fillings->{LOGOHEIGHT} * (72 / 2.54)) * $fillings->{LOGOLINES};
441
442 # LOGOHEIGHTPOITNS is the height input by the user
443 # $fillings->{LOGOHEIGHTPOINTS} = int($fillings->{LOGOHEIGHT} * (72 / 2.54)); # user specifies height of entire logo
444 $fillings->{LOGOHEIGHTPOINTS} = int($fillings->{LOGOHEIGHT} * (72 / 2.54)) * $fillings->{LOGOLINES}; # user specifies height of logo line
445 $fillings->{LOGOWIDTHPOINTS} = int($fillings->{LOGOWIDTH} * (72 / 2.54));
446
447 # LOGOLINEHEIGHT is the height of each logo line, in cm
448 # $fillings->{LOGOLINEHEIGHT} = $fillings->{LOGOHEIGHT} / $fillings->{LOGOLINES}; # user specifies height of entire logo
449 $fillings->{LOGOLINEHEIGHT} = $fillings->{LOGOHEIGHT}; # user specifies height of logo line
450 }
451
452 sub roundup {
453 return ($_[0] - int($_[0]) > 0) ? int($_[0] + 1) : $_[0];
454 }
455
456
457 ################################################################################
458 ##### COLORS #####
459 ################################################################################
460
461 sub getDefaultColors {
462 my ($defaults) = @_;
463 my $returnVal = "";
464 $returnVal .= "/black " . $defaults->{black} . " def\n";
465 $returnVal .= "/red " . $defaults->{red} . " def\n";
466 $returnVal .= "/green " . $defaults->{green} . " def\n";
467 $returnVal .= "/blue " . $defaults->{blue} . " def\n";
468 $returnVal .= "/yellow " . $defaults->{yellow} . " def\n";
469 $returnVal .= "/purple " . $defaults->{purple} . " def\n";
470 $returnVal .= "/orange " . $defaults->{orange} . " def\n";
471
472 return $returnVal;
473 }
474
475 sub getNAColors {
476 my $returnVal = <<END
477 % Standard DNA/RNA color scheme
478 /colorDict <<
479 (G) orange
480 (T) red
481 (C) blue
482 (A) green
483 (U) red
484 END
485 ;
486
487 return $returnVal;
488 }
489
490 sub getAAColors {
491 my $returnVal = <<END
492 % Standard Amino Acid colors
493 /colorDict <<
494 (G) green
495 (S) green
496 (T) green
497 (Y) green
498 (C) green
499 (N) purple
500 (Q) purple
501 (K) blue
502 (R) blue
503 (H) blue
504 (D) red
505 (E) red
506 (P) black
507 (A) black
508 (W) black
509 (F) black
510 (L) black
511 (I) black
512 (M) black
513 (V) black
514 END
515 ;
516
517 return $returnVal;
518 }
519
520 sub setColors {
521 my ($fillings, $defaults, $input) = @_;
522 my $colordef = getDefaultColors($defaults);
523 my $colordict = "/colorDict <<\n";
524
525 if ($fillings->{COLORSCHEME} eq "DEFAULT") {
526 $colordef = getDefaultColors($defaults);
527
528 if ($fillings->{KIND} eq $AA) {
529 $colordict = getAAColors();
530 } else {
531 $colordict = getNAColors();
532 }
533 } elsif ($fillings->{COLORSCHEME} eq "BW") {
534 # do nothing for dict
535 } else {
536
537 my %colorhash = %{ $fillings->{COLORS} };
538 my $colorName = "";
539
540 foreach (keys %colorhash) { # keys are strings of residues, value = color name or color code (FF0000)
541 # add color to definitions
542 $colorName = $colorhash{$_};
543
544 # print("color = $_\n");
545
546 addColorDef(\$colordef, $colorName ) if (isHexColor($colorName));
547
548 # add have each residue use the color
549 foreach (split(//, $_)) {
550 # add color to dictionary
551 if (isHexColor($colorName)) {
552 $colordict .= " ($_) c$colorName\n" if !($_ =~ /^\s*$/);
553 } else {
554 $colordict .= " ($_) $colorName\n" if !($_ =~ /^\s*$/);
555 }
556 }
557 }
558 }
559
560 $colordict .= "\n>> def";
561
562 # add to fillings
563 $fillings->{COLORDEF} = $colordef;
564 $fillings->{COLORDICT} = $colordict;
565 }
566
567 sub addColorDef {
568 # print("adding to color def\n");
569 my ($colordef_r, $color) = @_;
570 my $PSColor = getPSColor($color);
571 $$colordef_r .= "/c$color $PSColor def\n";
572 }
573
574 sub isHexColor {
575 return ($_[0] =~ /^[0-9a-fA-F]+$/) && (length $_[0] == 6);
576 }
577
578 # know that it is hex color
579 sub getPSColor {
580 return "[" . hex(substr($_[0],0,2)) / 255 . " " .
581 hex(substr($_[0],2,2)) / 255 . " " .
582 hex(substr($_[0],4,2)) / 255 . "]";
583 }
584
585
586 ################################################################################
587 ##### SETTING DATA FIELD #####
588 ################################################################################
589
590 sub setData {
591 my ($fillings, $data_r) = @_;
592
593 my @data = @$data_r;
594 my ($height, $letter);
595 my @slice;
596 my $data;
597 my $start_num = $fillings->{START_NUM};
598
599 my $start = $fillings->{LOGOSTART} - $start_num; # where in @data to start
600 my $end = $fillings->{LOGOEND} - $start_num; # where in @data to end
601 my $charsperline = $fillings->{CHARSPERLINE};
602
603 my $numlabel = $fillings->{LOGOSTART};
604
605 $end = ($end >= scalar @data) ? (scalar @data - 1) : $end;
606
607 for (my $i=$start ; $i<=$end ; $i++) {
608
609 # if add new lines
610 # if ((($i - $start) % $charsperline == 0) &&
611 # ($i != $start) && # not first one
612 # ($i != $end)) { # not last one
613 if ((($i - $start) % $charsperline == 0) &&
614 ($i != $start)) { # not first one
615 $data .= <<END
616 EndLine
617 StartLine
618
619 END
620 ;
621 }
622
623 @slice = @{$data[$i]};
624 $data .= <<END
625 ($numlabel) startstack
626 END
627 ;
628
629 $numlabel++;
630
631 foreach (@slice) {
632 ($letter,$height) = ($_ =~ /^(.{1})(\S+)/);
633
634 # is space, so leave
635 if ($letter eq " ") {
636 last;
637 }
638
639 # look for ">", which is symbol for error bar, then quit
640 if ($letter eq ">") {
641 last;
642 }
643
644 # # look for negative heights
645 # if ($height < 0) {
646 # next;
647 # }
648
649 $letter = (uc $letter); # always uppercase
650 $height = ($height < 0) ? 0 : $height;
651 $data .= " $height ($letter) numchar\n";
652 }
653
654 # put in error bars -- size is in $height as read in before
655 if ($fillings->{ERRBAR} && $letter ne " " && $height != 0) {
656 $data .= " $height Ibeam\n";
657 }
658
659 $data .= <<END
660 endstack
661
662 END
663 ;
664
665 }
666
667 $fillings->{DATA} = $data;
668 }
669
670 ################################################################################
671
672 1;