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