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__ |