[Bio] / FigKernelPackages / raedraw.pm Repository:
ViewVC logotype

Annotation of /FigKernelPackages/raedraw.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (view) (download) (as text)

1 : redwards 1.1
2 :     #### END tool_hdr ####
3 :    
4 :     =pod
5 :    
6 :     =head1 raedraw.pm
7 :    
8 :     A bunch of modules written by Rob to draw different things. Most of these are going to draw images
9 :     using SVG that has many advantages over png/gif images.
10 :    
11 :     A lot of this is geared towards drawing the genome browser that I am working on. The idea is not only
12 :     to plot sims but other data in tag/value pairs
13 :    
14 :     =cut
15 :    
16 :    
17 :     package raedraw;
18 :     use strict;
19 :     use FIG;
20 :     use SVG;
21 :     use Data::Dumper;
22 :     my $fig=new FIG;
23 :    
24 :    
25 :     =head1 new
26 :    
27 :     Instantiate the script and figure out what we are looking for. These are the options.
28 :     Remeber, this was originally taken from a standalone script I wrote, and then cgi-iffied.
29 :    
30 :     Returns a pointer to itself
31 :    
32 :     Arguments that can be passed in
33 :     -genome <genome> Number to draw as baseline
34 :     -compare_to <genome1,genome2,genome3> A reference to a list of similar genomes to plot on image
35 :     Note that this will be expanded with stuff, and some good stuff too
36 :    
37 :    
38 :     Image size
39 :     -width <width> Width of the image (default 800)
40 :     -margin <pixels> Left/right margin and gap btwn contigs (default 100)
41 :     -top_marg <pixels> Top margin (default=20)
42 :     -bottom_marg <pixels> Bottom margin (default=20) (note: was -p)
43 :     -box_height <box height> Height of the box to color (default=10)
44 :    
45 :     Display options
46 :     -rows <number> Number of rows to split image into (default=1)
47 :     -box_no_score <boolean> Draw boxes around pegs with no score (was: l)
48 :     -box_score <boolean> Draw boxes around pegs with sims (default=1) (was k)
49 :     -show_function <peg number> Show function every <peg number> pegs in target genome
50 :     -tick_mark_height <pixels> Height of the tick marks to show (default=3)
51 :     -genome_lines <boolean> Draw lines where the genome should be
52 :    
53 :     Other things
54 :     -abrrev <boolean> Use abbreviated names (default=1)
55 :     -stopshort <peg count> Stop after drawing <peg count> pegs (just for development)
56 :    
57 :    
58 :     At the moment, $self->{'genome'} contains the genome that is drawn along the top, and $self->{'compareto'}
59 :     contains the comparators. We need to extend comparators so we can include homology and whatnot.
60 :    
61 :     EOF
62 :    
63 :     =cut
64 :    
65 :     sub new {
66 :     my ($class,%args) = @_;
67 :     my $self = bless{},$class;
68 :    
69 :     # parse out the arguments that are handed in
70 :     foreach my $arg (qw[genome width margin top_marg bottom_marg box_height rows show_function stopshort box_no_score tick_mark_height genome_lines]) {
71 :     $args{"-".$arg} && ($self->{$arg}=$args{"-".$arg})
72 :     }
73 :     foreach my $arg (qw[box_score abrrev]) {
74 :     if (defined $args{"-".$arg}) {$self->{$arg}=$args{"-".$arg}} else {$self->{$arg}=$args{"-".$arg}=1}
75 :     }
76 :    
77 :     $args{'-compare_to'} && $self->compareto($args{'-compare_to'});
78 :    
79 :     # predefined things
80 :     $self->{'width'} =800 unless (defined $self->{'width'});
81 :     $self->{'box_height'} =10 unless (defined $self->{'box_height'});
82 :     $self->{'margin'} =100 unless (defined $self->{'margin'});
83 :     $self->{'top_marg'} =20 unless (defined $self->{'top_marg'});
84 :     $self->{'bot_marg'} =20 unless (defined $self->{'bot_marg'});
85 :     $self->{'rows'} =1 unless (defined $self->{'rows'});
86 :     $self->{'tick_mark_height'} =3 unless (defined $self->{'tick_mark_height'});
87 :    
88 :     # each genome gets 3 box heights, and we have 2 top/bottom margins
89 :     # we also need to add room for the target genome track.
90 :     $self->{'height'}=(3 * $self->{'box_height'}* (scalar @{$self->compareto()} +1)) + ($self->{'top_marg'} + $self->{'bot_marg'});
91 :    
92 :     # we have the width of the image, and the effective width from which we calculate scaling of the pegs.
93 :     # the effective width is the width * the number of rows we want
94 :     $self->{'effectivewidth'}=$self->{'width'} * $self->{'rows'};
95 :    
96 :     $self->{'svg'}=SVG->new(); # use 100% as default
97 :    
98 :     return $self;
99 :     }
100 :    
101 :    
102 :     =head2 compareto
103 :    
104 :     Get or set the list of genomes or other things that we will compare this to.
105 :     args: A reference to an array of things to add to the comparisons
106 :     returns: A reference to an array of things that we will compare to
107 :    
108 :     =cut
109 :    
110 :     sub compareto {
111 :     my ($self, $ct)=@_;
112 :     if ($ct) {
113 :     if (ref($ct) eq "ARRAY") {push (@{$self->{'compareto'}}, @$ct)}
114 :     else {push (@{$self->{'compareto'}}, $ct)}
115 :     }
116 :     return $self->{'compareto'};
117 :     }
118 :    
119 :     =head2 show_function
120 :    
121 :     Set a boolean to show the function
122 :     args: boolean whether to set the function
123 :     returns: whether the function is shown or not
124 :    
125 :     =cut
126 :    
127 :     sub show_function {
128 :     my ($self, $sf)=@_;
129 :     if (defined $sf) {$self->{'show_function'}=$sf}
130 :     return $self->{'show_function'}
131 :     }
132 :    
133 :    
134 :     =head2 write_image
135 :    
136 :     Write out the image to a file
137 :     Args: A file name to write to
138 :     Returns: 1 on success
139 :    
140 :     =cut
141 :    
142 :     sub write_image {
143 :     my ($self, $file)=@_;
144 :    
145 :     #print STDERR &Dumper($self);
146 :    
147 :     # make sure that we have something to compare to
148 :     unless ($self->compareto()) {die "Couldn't find any genomes to compare to"}
149 :    
150 :     # at the moment this is essentially a sequential call, but i think we may mess with this soon....
151 :     $self->_define_tracks unless ($self->{'track'});
152 :     $self->_scale_image unless ($self->{'rowcount'});
153 :     $self->_draw_image unless ($self->{'drawn'});
154 :     $self->_hz_lines if ($self->{'genome_lines'});
155 :    
156 :     open (OUT, ">$file") || die "Can't open $file";
157 :     print OUT $self->{'svg'}->xmlify;
158 :     close OUT;
159 :    
160 :     print STDERR "The image should be width: ", $self->{'width'}, " height: ",
161 :     $self->{'rowcount'} * (((scalar (keys %{$self->{'trackposn'}})) * $self->{'box_height'}* 3) + $self->{'top_marg'}+ $self->{'box_height'}), "\n";
162 :     print STDERR "Processing took ", time-$^T, " seconds\n";
163 :     }
164 :    
165 :    
166 :     =head2 _define_tracks
167 :    
168 :     Each genome has a track that contains all the information about the genome, including the boxes, names, and drawings. This is an internal method to define those tracks
169 :    
170 :     Args: none
171 :     Returns: nothing
172 :    
173 :     =cut
174 :    
175 :     sub _define_tracks {
176 :     my ($self)=@_;
177 :     {
178 :     my $gp=$self->{'top_marg'}+$self->{'box_height'};
179 :     foreach my $simgen ($self->{'genome'}, @{$self->{'compareto'}}) {
180 :     $self->{'track'}->{$simgen}=$self->{'svg'}->group(id=>"${simgen}_group");
181 :     $self->{'trackposn'}->{$simgen}=$gp;
182 :     my $an=$fig->genus_species($simgen);
183 :     if ($an =~ /salmonella/i) {$an =~ s/Salmonella/S/; $an =~ s/\s+enterica subsp. enterica serovar\s+/ /}
184 :    
185 :     if ($self->{'abbrev'}) {$an=$fig->abbrev($fig->genus_species($simgen))}
186 :     $self->{'label'}->{$simgen}=$an;
187 :     $gp+=3*$self->{'box_height'};
188 :     }
189 :     }
190 :     }
191 :    
192 :    
193 :    
194 :     =head1 _scale_image
195 :    
196 :     An internal method to figure out how long the whole genome is and use this as the baseline for the image
197 :    
198 :     We have somethinglike this for 3 contigs ccc and gaps mmm:
199 :     Row1 mmm ccccccccccc mmm
200 :     Row2 mmm ccc mmm ccc mmm
201 :     Row3 mmm ccccccccccc mmm
202 :     Row4 mmm cc mmm cccc mmm
203 :     The total length is $effectivewidth, but we have to remove 2*rows*margins from this
204 :     then we have to remove # contigs-1 * gap between them
205 :    
206 :     args: none
207 :     returns: none
208 :    
209 :     =cut
210 :    
211 :     sub _scale_image {
212 :     my ($self)=@_;
213 :     my %len; my @xs; $self->{'rowcount'}=0;
214 :     my $absorow;
215 :     {
216 :     my $contigcount;
217 :     foreach my $contig ($fig->all_contigs($self->{'genome'})) {
218 :     $contigcount++;
219 :     $self->{'totallen'}+=$fig->contig_ln($self->{'genome'}, $contig);
220 :     $len{$contig}=$fig->contig_ln($self->{'genome'}, $contig);
221 :     }
222 :    
223 :    
224 :     $contigcount = (($contigcount - 1) * $self->{'margin'}) + (2 * $self->{'rows'}*$self->{'margin'});
225 :     $self->{'xmultiplier'}=$self->{'effectivewidth'}- $contigcount;
226 :     # now we have the total length, the length of each contig, and the amount of free space. For each contig, the scale is
227 :     # the percent of contg/totallen. The space that it takes up is that * free space
228 :     # We also need to know the starts and stops for each row in nt and contigs
229 :     my $offset=0;
230 :     foreach my $contig (sort {$fig->contig_ln($self->{'genome'}, $b) <=> $fig->contig_ln($self->{'genome'}, $a)} keys %len) {
231 :     $self->{'xoffset'}->{$contig}=$self->{'margin'}+$offset;
232 :    
233 :     print STDERR "For contig $contig, length is $len{$contig} and start is ", $self->{'xoffset'}->{$contig};
234 :     print STDERR " and end will be ", $self->{'xoffset'}->{$contig} + $self->{'margin'} + (($len{$contig}/$self->{'totallen'}) * $self->{'xmultiplier'}), "\n";
235 :    
236 :     ### Added rowinfo, but not sure about this
237 :     push (@{$self->{'contigrows'}->{$contig}}, $self->{'rowcount'});
238 :     my $laststart = $self->{'rowinfo'}->{$self->{'rowcount'}}->{$contig}->{'start'}=$self->{'xoffset'}->{$contig};
239 :     my $rowend=$self->{'xoffset'}->{$contig} + (($len{$contig}/$self->{'totallen'}) * $self->{'xmultiplier'});
240 :     while (($rowend-$laststart) > ($self->{'width'} - (2 * $self->{'margin'}))) {
241 :     $laststart=
242 :     $self->{'rowinfo'}->{$self->{'rowcount'}+1}->{$contig}->{'start'}=
243 :     $self->{'rowinfo'}->{$self->{'rowcount'}}->{$contig}->{'end'}=
244 :     $self->{'rowinfo'}->{$self->{'rowcount'}}->{$contig}->{'start'}+($self->{'width'} - (2 * $self->{'margin'}));
245 :     $self->{'rowcount'}++;
246 :     push (@{$self->{'contigrows'}->{$contig}}, $self->{'rowcount'});
247 :     }
248 :     $offset=$self->{'rowinfo'}->{$self->{'rowcount'}}->{$contig}->{'end'}=$rowend;
249 :     #### End added rowinfo section
250 :     }
251 :     }
252 :    
253 :     ##NOTE : ROWINFO HAS MARGINS INCLUDED
254 :    
255 :     # we want to find the absolute starts and stops for each row
256 :     # print out the saved information
257 :     for (my $i=0; $i <= $self->{'rowcount'}; $i++) {
258 :     foreach my $c (keys %{$self->{'rowinfo'}->{$i}}) {
259 :     if (!defined $absorow->{$i}->{'start'} || $absorow->{$i}->{'start'} > $self->{'rowinfo'}->{$i}->{$c}->{'start'})
260 :     {$absorow->{$i}->{'start'} = $self->{'rowinfo'}->{$i}->{$c}->{'start'}}
261 :     if (!defined $absorow->{$i}->{'end'} || $absorow->{$i}->{'end'} < $self->{'rowinfo'}->{$i}->{$c}->{'end'})
262 :     {$absorow->{$i}->{'end'} = $self->{'rowinfo'}->{$i}->{$c}->{'end'}}
263 :     }
264 :     }
265 :    
266 :    
267 :     ### Define the rows
268 :     for (my $row=0; $row <=$self->{'rowcount'}; $row++) {
269 :     my $transform=$row * (((scalar keys %{$self->{'trackposn'}}) * $self->{'box_height'} * 3) + $self->{'top_marg'} + $self->{'bot_marg'});
270 :     my $xtrans=$absorow->{$row}->{'start'} - $self->{'margin'};
271 :     $self->{'rowgroup'}->{$row}=$self->{'svg'}->group(id=>"row_$row", transform=>"translate(-$xtrans, $transform)");
272 :     # add genome labels to the rows
273 :     foreach my $simgen (keys %{$self->{'trackposn'}}) {
274 :     $self->{'rowgroup'}->{$row}->text(id=>"${simgen}_${row}_label", x=>$xtrans, y=>$self->{'trackposn'}->{$simgen}, textLength=>100, lengthAdjust=>"spacingAndGlyphs",
275 :     style=>{'font-family'=>"Helvetica", 'font-size'=>"10", fill=>"black",})->cdata($self->{'label'}->{$simgen});
276 :     }
277 :     }
278 :     } # end _scale_image
279 :    
280 :     =head1 _draw_genome
281 :    
282 :     An internal method to draw the genome that we are comparing to, and to define the locations of the pegs (perhaps)
283 :    
284 :     args: none
285 :     returns: none
286 :    
287 :     =cut
288 :    
289 :     sub _draw_image {
290 :     my ($self)=@_;
291 :     $self->{'drawn'}=1;
292 :     my $defs=$self->{'track'}->{$self->{'genome'}}->defs;
293 :     my $time=time; my $pegcount;
294 :     foreach my $peg ($fig->pegs_of($self->{'genome'})) {
295 :     $pegcount++;
296 :     last if ($self->{'stopshort'} && $self->{'stopshort'} == $pegcount);
297 :    
298 :     # Define the location of the box once per peg
299 :     # also use this to figure out which row to add it to
300 :     my @loc=$fig->feature_location($peg);
301 :     $loc[0] =~ m/^(.*)\_(\d+)\_(\d+)$/;
302 :     my ($contig, $start, $stop)=($1, $2, $3);
303 :     my $len=$stop-$start;
304 :    
305 :     # if the orf is in the same direction want the sim on top, if not want it below
306 :     my $x=$self->{'xoffset'}->{$contig} + (($start/$self->{'totallen'}) * $self->{'xmultiplier'});
307 :     my $boxwidth = (abs($stop-$start)/$self->{'totallen'})*$self->{'xmultiplier'};
308 :    
309 :     # figure out the correct row for the current location. The row is after we have split up the genome
310 :     my $row;
311 :     foreach my $addrow (@{$self->{'contigrows'}->{$contig}}) {
312 :     if ($x >= $self->{'rowinfo'}->{$addrow}->{$contig}->{'start'} && $x < $self->{'rowinfo'}->{$addrow}->{$contig}->{'end'}) {$row=$addrow; last}
313 :     }
314 :     unless (defined $row) {
315 :     print STDERR "Couldn't get a row for $contig looking for a start of $x (real start: $start). These are the starts:\n";
316 :     print STDERR "These are the contigrows: ", join " ", @{$self->{'contigrows'}->{$contig}}, "\n";
317 :     print STDERR map {"$_: " . $self->{'rowinfo'}->{$_}->{$contig}->{'start'} . "\n"} @{$self->{'contigrows'}->{$contig}};
318 :     print STDERR "These are the stops\n";
319 :     print STDERR map {"$_: " . $self->{'rowinfo'}->{$_}->{$contig}->{'end'} . "\n"} @{$self->{'contigrows'}->{$contig}};
320 :     print STDERR "\n";
321 :     exit -1;
322 :     }
323 :    
324 :     # show the function if we are supposed to
325 :     unless ($pegcount % $self->{'show_function'}) {$self->_add_functions($defs, $peg, $x, $boxwidth, $row)}
326 :    
327 :    
328 :     # add a tick mark for the peg
329 :     my $sl=$self->{'trackposn'}->{$self->{'genome'}}-$self->{'tick_mark_height'}; # start line
330 :     my $el=$self->{'trackposn'}->{$self->{'genome'}}+$self->{'tick_mark_height'}; # end line
331 :     $self->{'rowgroup'}->{$row}->line(x1=>$x, x2=>$x, y1=>$sl, y2=>$el);
332 :     $self->{'rowgroup'}->{$row}->line(x1=>$x+$boxwidth, x2=>$x+$boxwidth, y1=>$sl, y2=>$el);
333 :    
334 :    
335 :     #if we want the empty boxes draw them first and then the color thing will overwrite.
336 :     if ($self->{'box_no_score'}) {
337 :     foreach my $simgen (keys %{$self->{'trackposn'}}) {
338 :     my $y=$self->{'trackposn'}->{$simgen};
339 :     if ($start > $stop) {$y-=$self->{'box_height'}}
340 :     $self->{'rowgroup'}->{$row}->rect(x=>$x, y=>$y, height=>$self->{'box_height'},
341 :     width=>$boxwidth, id=>"${peg}_$y", style => {stroke => "rgb(0,0,0)", fill => "none"});
342 :     }
343 :     }
344 :    
345 :     # now for each peg we need to figure out what we need to add
346 :     foreach my $match (@{$self->compareto()}) {
347 :     if ($match =~ /^\d+\.\d+/) {
348 :     # it is a genome
349 :     my $comp=0;
350 :     if ($start > $stop) {$comp=1}
351 :     $self->_plot_sims($peg, $x, $boxwidth, $row, $match, $comp);
352 :     }
353 :     else {
354 :     print STDERR "No support for matches to $match yet\n";
355 :     }
356 :     }
357 :     }
358 :     }
359 :    
360 :    
361 :     =head2 _add_functions
362 :    
363 :     An internal method to add the functions to the image.
364 :     Args: definitions (defs), peg, position (x) where to add the text, box width, row (y group) to add the text
365 :     Returns: None
366 :    
367 :     I want to make the text at 45 degrees, so we are going to have to make a path and then put the text on the path.
368 :     This is tricky. What we do is define a horizontal path from the point where we want to start to the end of the image
369 :     and we rotate it by 45 degrees. Then we put the text onto that path we have just created. Neato, huh?
370 :    
371 :     =cut
372 :    
373 :     sub _add_functions {
374 :     my ($self, $defs, $peg, $position, $boxwidth, $row)=@_;
375 :     return unless ($self->{'show_function'});
376 :     my $funclocx=$position+($boxwidth/2); # this should be the middle of the box?
377 :     my $funclocy=$self->{'trackposn'}->{$self->{'genome'}}-2;
378 :     my $funcendx=$self->{'effectivewidth'}+$funclocx; # this doesn't matter it just needs to be off the image!
379 :     $defs->path(id=>"${peg}_line", d=>"M $funclocx $funclocy L $funcendx $funclocy", transform=>"rotate(-45, $funclocx $funclocy)");
380 :    
381 :    
382 :     # now just add the text as a textPath
383 :     $self->{'rowgroup'}->{$row}->text(style=>{'font-family'=>"Helvetica, sans-serif", 'font-size'=>"2", fill=>"black",})
384 :     ->textPath(id=>"${peg}_function", '-href'=>"#${peg}_line")
385 :     ->cdata(scalar $fig->function_of($peg));
386 :     }
387 :    
388 :    
389 :     =head2 _plot_sims
390 :    
391 :     An internal method to add the similarities to the image
392 :     Args: peg, position (x) where to add the text, width of the box to draw, row (y group) to add the text,
393 :     genome to compare to, flag for whether to put below the line (complement essentially)
394 :     Returns: None
395 :    
396 :     =cut
397 :    
398 :    
399 :     sub _plot_sims {
400 :     ##### PLOT SIMS #####
401 :     # find the sims for the genomes that we need
402 :     my ($self, $peg, $x, $boxwidth, $row, $simgen, $comp)=@_;
403 :     my ($maxN, $maxP)=(50, 1e-5);
404 :     my %seensims; # genomes we have seen sims from for this peg. So we only get the best hit
405 :     foreach my $sim ($fig->sims($peg, $maxN, $maxP, 'fig')) {
406 :     next unless ($fig->genome_of($$sim[1]) == $simgen && defined $self->{'trackposn'}->{$fig->genome_of($$sim[1])});
407 :     # figure out the y posn
408 :     my $y=$self->{'trackposn'}->{$simgen};
409 :     if ($comp) {$y-=$self->{'box_height'}}
410 :     # now we just need to color based on the sim
411 :     my @color=map {int(255 * $_)} my_color($$sim[2]); # this will adjust it for rgb 0-255
412 :     # color at the moment is on a red based scale, but I'd rather have it on a blue based scale as i am in a blue mood
413 :     # (though not down in the dumps, I just like the color blue)
414 :     # swap r and b, leave g the same
415 :     ($color[0], $color[3])=($color[3], $color[0]);
416 :    
417 :     #now we need to make a box:
418 :     #x from $x length $boxwidth
419 :     #y from $y length $boxheight
420 :     #color is in @{$colorgenome->{$fig->genome_of($$sim[1])}}
421 :     if ($self->{'box_score'}) {
422 :     $self->{'rowgroup'}->{$row}->rect(x=>$x, y=>$y, height=>$self->{'box_height'},
423 :     width=>$boxwidth, id=>$$sim[1].$peg, style => {stroke => "rgb(0,0,0)", fill => "rgb(@color)"});
424 :     } else {
425 :     $self->{'rowgroup'}->{$row}->rect(x=>$x, y=>$y, height=>$self->{'box_height'},
426 :     width=>$boxwidth, id=>$$sim[1].$peg, style => {stroke => "none", fill => "rgb(@color)"});
427 :     }
428 :     }
429 :     # lastx is used as the translate function x factor. We need to set it to the end position less the margin so we still have some margin (for error)
430 :     }
431 :    
432 :    
433 :    
434 :     =head2 _hz_lines
435 :    
436 :     An internal method to add horizontal lines to an image where the genomes are
437 :     Args: None
438 :     Returns: None
439 :    
440 :     =cut
441 :    
442 :    
443 :     sub _hz_lines {
444 :     my ($self)=@_;
445 :     for (my $row=0; $row <= $self->{'rowcount'}; $row++) {
446 :     foreach my $contig (keys %{$self->{'rowinfo'}->{$row}}) {
447 :     my ($start, $end)=($self->{'rowinfo'}->{$row}->{$contig}->{'start'}, $self->{'rowinfo'}->{$row}->{$contig}->{'end'});
448 :     print STDERR "Working on $contig in $row line is from $start to $end\n";
449 :     foreach my $simgen (keys %{$self->{'trackposn'}}) {
450 :     $self->{'rowgroup'}->{$row}->line(id=>"line_${simgen}_${contig}_$row",
451 :     x1=>$start, x2=>$end, y1=>$self->{'trackposn'}->{$simgen}, y2=>$self->{'trackposn'}->{$simgen});
452 :     }
453 :     }
454 :     }
455 :     }
456 :    
457 :    
458 :    
459 :     #### COLORS.
460 :     #
461 :     # This has been stolen from protein.cgi written by Gary because I don't
462 :     # understand enough about colors
463 :    
464 :     sub my_color {
465 :     my $percent=shift;
466 :     return (255,255,255) unless ($percent);
467 :     $percent=1-$percent/100; # we want the more similar ones to be darker
468 :     my $hue = 5/6 * $percent - 1/12;
469 :     my $sat = 1 - 10 * $percent / 9;
470 :     my $br = 1;
471 :     return hsb2rgb( $hue, $sat, $br );
472 :     }
473 :    
474 :     #
475 :     # Convert HSB to RGB. Hue is taken to be in range 0 - 1 (red to red);
476 :     #
477 :    
478 :     sub hsb2rgb {
479 :     my ( $h, $s, $br ) = @_;
480 :     $h = 6 * ($h - floor($h)); # Hue is made cyclic modulo 1
481 :     if ( $s > 1 ) { $s = 1 } elsif ( $s < 0 ) { $s = 0 }
482 :     if ( $br > 1 ) { $br = 1 } elsif ( $br < 0 ) { $br = 0 }
483 :     my ( $r, $g, $b ) = ( $h <= 3 ) ? ( ( $h <= 1 ) ? ( 1, $h, 0 )
484 :     : ( $h <= 2 ) ? ( 2 - $h, 1, 0 )
485 :     : ( 0, 1, $h - 2 )
486 :     )
487 :     : ( ( $h <= 4 ) ? ( 0, 4 - $h, 1 )
488 :     : ( $h <= 5 ) ? ( $h - 4, 0, 1 )
489 :     : ( 1, 0, 6 - $h )
490 :     );
491 :     ( ( $r * $s + 1 - $s ) * $br,
492 :     ( $g * $s + 1 - $s ) * $br,
493 :     ( $b * $s + 1 - $s ) * $br
494 :     )
495 :     }
496 :    
497 :     sub floor {
498 :     my $x = $_[0];
499 :     defined( $x ) || return undef;
500 :     ( $x >= 0 ) || ( int($x) == $x ) ? int( $x ) : -1 - int( - $x );
501 :     }
502 :    
503 :     1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3