File Coverage

blib/lib/Chart/Colors.pm
Criterion Covered Total %
statement 47 49 95.9
branch 17 26 65.3
condition n/a
subroutine 6 6 100.0
pod 3 4 75.0
total 73 85 85.8


line stmt bran cond sub pod time code
1             package Chart::Colors;
2              
3 1     1   67285 use strict;
  1         3  
  1         27  
4 1     1   5 use warnings;
  1         2  
  1         602  
5              
6             # perl -MPod::Markdown -e 'Pod::Markdown->new->filter(@ARGV)' lib/Chart/Colors.pm > README.md
7              
8             =head1 NAME
9              
10             Chart::Colors - Perl extension to return an endless stream of new distinct RGB colours codes (good for coloring any number of chart lines)
11              
12             =head1 SYNOPSIS
13              
14              
15             #!/usr/bin/perl -w
16            
17             use Chart::Colors;
18              
19             my $colors = new Chart::Colors();
20             my $nextcolor_hex=$colors->Next('hex'); # Get an HTML-Style answer, like F85099 (put a # in front to use in HTML, i.e. #F85099)
21             my($r,$g,$b)=$colors->Next('rgb'); # Get red, green, and blue ints separately, like (255,123,88)
22             my($h,$s,$v)=$colors->Next('hsv'); # Get hue, saturation, and brightness
23              
24              
25             =head1 DESCRIPTION
26              
27             This module outputs an infinte sequence of visually distinct different colours.
28              
29             It is useful for colorizing the lines on charts etc.
30              
31             =head2 EXAMPLE
32              
33             # perl -MChart::Colors -e '$c=new Chart::Colors(); for(my $i=0;$i<5;$i++) { print "$i\t( " . join(", ",$c->Next()) . " )\n";}; print "#" . $c->Next("hex") . "\n"; print join("|", $c->Next("hsv")) . "\n"; '
34             0 ( 204, 81, 81 )
35             1 ( 127, 51, 51 )
36             2 ( 81, 204, 204 )
37             3 ( 51, 127, 127 )
38             4 ( 142, 204, 81 )
39             #597f33
40             0.75|0.6|0.8
41              
42             =head2 EXPORT
43              
44             None by default.
45              
46              
47             =head2 Notes
48              
49             =head2 new
50              
51             Usage is
52              
53             my $colors = new Chart::Colors();
54              
55              
56             =head2 Next
57              
58             Returns a colour code in hexadecimal ('hex'), red, green, blue ('rgb') or hue, saturation, and brightnes ('hsv') format.
59              
60             Usage is
61              
62             my $nextcolor_hex = $colors->Next('hex');
63              
64             or
65              
66             my($r,$g,$b)=$colors->Next('rgb');
67              
68             or
69              
70             my($h,$s,$v)=$colors->Next('hsv');
71              
72              
73             =head2 hsv_to_rgb
74              
75             my($r,$g,$b)=$this->hsv_to_rgb($h,$s,$v);
76              
77             =cut
78              
79             require Exporter;
80              
81             our @ISA = qw(Exporter);
82             our($VERSION)='1.03';
83             our($UntarError) = '';
84              
85             our %EXPORT_TAGS = ( 'all' => [ qw( ) ] );
86              
87             our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
88              
89             our @EXPORT = qw( );
90              
91              
92             sub new {
93 1     1 1 78 my $class = shift;
94 1         2 my $this={};
95 1         3 $this->{rgbno}=0;
96 1         2 @{$this->{rgbf}}=(0.8,0.5);
  1         4  
97 1         2 $this->{base}=1;
98 1         2 $this->{num}=1;
99 1         3 $this->{ff}=undef;
100 1         3 bless $this,$class;
101 1         3 return $this;
102             } # new
103              
104              
105              
106             sub Next {
107 5     5 1 24 my $this = shift;
108 5         7 my $type = shift; # 'hex' or 'rgb' or 'hsv'
109 5 50       11 $type='' unless($type);
110              
111 5 100       22 $this->{ff}=$this->nextfrac() unless($this->{rgbno}%2);
112 5         13 my($h,$s,$v)=($this->{ff},.6,$this->{rgbf}->[$this->{rgbno}++%2]);
113 5 50       12 return ($h,$s,$v) if($type eq 'hsv');
114             #return($this->hsv_to_rgb($ff,.6,$this->{rgbf[$this->{rgbno}++%2]})); # RGB
115 5         11 my($r,$g,$b)=$this->hsv_to_rgb($h,$s,$v);
116 5 50       12 return sprintf("%02x%02x%02x",$r,$g,$b) if($type eq 'hex');
117 5 50       7 return($r,$g,$b) if($type eq 'rgb');
118 5         25 return($r,$g,$b); # default to RGB
119             #return($this->hsv_to_rgb($h,$s,$v)) if($type eq 'rgb'); # RGB
120             } # Next
121             # testing Next: perl -MChart::Colors -e '$c=new Chart::Colors(); for(my $i=0;$i<5;$i++) { print "$i\t( " . join(", ",$c->Next()) . " )\n"; }' # correct= ['204,81,81', '127,51,51', '81,204,204', '51,127,127', '142,204,81']
122              
123             sub nextfrac { # Keep slicing between previous 0..1 range.
124 3     3 0 4 my $this = shift;
125 3 100       9 my $ret=($this->{base}==1)? 0: $this->{num}/$this->{base};
126 3         7 $this->{num}+=2;
127 3 100       7 if($this->{num}>$this->{base}) {
128 2         4 $this->{base}=2*$this->{base};
129 2         4 $this->{num}=1;
130             }
131 3         5 return $ret;
132             } # nextfrac
133             # testing nextfrac: for(my $i=0;$i<20;$i++) { print "$i\t" . &nextfrac() . "\n"; } # correct= [0.0, 0.5, 0.25, 0.75, 0.125, 0.375, 0.625, 0.875, 0.0625, 0.1875, ...]
134              
135             sub hsv_to_rgb {
136 5     5 1 7 my $this = shift;
137 5         8 my($h,$s,$v)=@_; # All numbers range from 0..1
138             #print "h=$h s=$s v=$v\n";
139 5 50       8 return(0,0,0) if(!$s); # Black is black
140 5         9 my $i = int($h*6);
141 5         9 my $f = $h*6-$i;
142 5         11 my $p = int(255*($v*(1-$s)));
143 5         12 my $q = int(255*($v*(1-$s*$f)));
144 5         19 my $t = int(255*($v*(1-$s*(1-$f))));
145 5         9 $v=int($v*255);
146 5         6 $i%=6;
147 5 100       14 return ($v, $t, $p) if($i == 0);
148 3 100       10 return ($q, $v, $p) if($i == 1);
149 2 50       4 return ($p, $v, $t) if($i == 2);
150 2 50       6 return ($p, $q, $v) if($i == 3);
151 0 0         return ($t, $p, $v) if($i == 4);
152 0           return ($v, $p, $q); # if($i == 5)
153             } # hsv_to_rgb
154             # testing hsv_to_rgb: my $x; while( $x++<20){ my($h,$s,$v)=(rand(),rand(),rand()); print "($h,$s,$v)=(" . join(",",&hsv_to_rgb($h,$s,$v)) . ")\n"; };
155              
156             #my $toprint=$ARGV[0]; $toprint++ unless($toprint); my @ret;push @ret,"'" . join(",",&Next()) . "'" while($toprint--); print "[". join(", ",@ret) . "]\n";
157              
158              
159             1;
160              
161             __END__