| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package Color::TupleEncode; |
|
2
|
|
|
|
|
|
|
|
|
3
|
8
|
|
|
8
|
|
187773
|
use warnings FATAL=>"all"; |
|
|
8
|
|
|
|
|
21
|
|
|
|
8
|
|
|
|
|
347
|
|
|
4
|
8
|
|
|
8
|
|
44
|
use strict; |
|
|
8
|
|
|
|
|
17
|
|
|
|
8
|
|
|
|
|
287
|
|
|
5
|
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
# use Smart::Comments; |
|
7
|
|
|
|
|
|
|
|
|
8
|
8
|
|
|
8
|
|
339492
|
use parent qw(Exporter); |
|
|
8
|
|
|
|
|
2711
|
|
|
|
8
|
|
|
|
|
64
|
|
|
9
|
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
our %EXPORT_TAGS = ("all"=>[qw(tuple_asRGB tuple_asRGB255 tuple_asRGBhex tuple_asHSV)]); |
|
11
|
|
|
|
|
|
|
Exporter::export_ok_tags("all"); |
|
12
|
|
|
|
|
|
|
|
|
13
|
8
|
|
|
8
|
|
663
|
use Carp; |
|
|
8
|
|
|
|
|
15
|
|
|
|
8
|
|
|
|
|
635
|
|
|
14
|
8
|
|
|
8
|
|
11693
|
use Graphics::ColorObject; |
|
|
8
|
|
|
|
|
3425685
|
|
|
|
8
|
|
|
|
|
593
|
|
|
15
|
8
|
|
|
8
|
|
4820
|
use Color::TupleEncode::Baran; |
|
|
8
|
|
|
|
|
24
|
|
|
|
8
|
|
|
|
|
281
|
|
|
16
|
8
|
|
|
8
|
|
5580
|
use Color::TupleEncode::2Way; |
|
|
8
|
|
|
|
|
23
|
|
|
|
8
|
|
|
|
|
259
|
|
|
17
|
8
|
|
|
8
|
|
59
|
use Math::VecStat qw(min max); |
|
|
8
|
|
|
|
|
13
|
|
|
|
8
|
|
|
|
|
672
|
|
|
18
|
8
|
|
|
8
|
|
47
|
use POSIX qw(fmod); |
|
|
8
|
|
|
|
|
13
|
|
|
|
8
|
|
|
|
|
68
|
|
|
19
|
8
|
|
|
8
|
|
449
|
use Readonly; |
|
|
8
|
|
|
|
|
17
|
|
|
|
8
|
|
|
|
|
25109
|
|
|
20
|
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
# Additional allowable options - added to those of the implementation method |
|
22
|
|
|
|
|
|
|
Readonly::Hash our %OPTIONS_DEFAULT => (-method=>"Color::TupleEncode::Baran"); |
|
23
|
|
|
|
|
|
|
Readonly::Array our @OPTIONS_OK => (qw(-method)); |
|
24
|
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
=head1 NAME |
|
26
|
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
Color::TupleEncode - Encode a tuple (vector) into a color - useful for |
|
28
|
|
|
|
|
|
|
generating color representation of a comparison of multiple values. |
|
29
|
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
=head1 VERSION |
|
31
|
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
Version 0.11 |
|
33
|
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
=cut |
|
35
|
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
our $VERSION = '0.11'; |
|
37
|
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
=head1 SYNOPSIS |
|
39
|
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
Given a tuple (e.g. three numbers) , apply color-coding method to |
|
41
|
|
|
|
|
|
|
encode the tuple by a color in HSV (hue, saturation, value) space. For a visual tour of the results, see L. |
|
42
|
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
use Color::TupleEncode; |
|
44
|
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
# By default the encoding method Color::TupleEncode::Baran will be used |
|
46
|
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
# initialize and define in one step |
|
48
|
|
|
|
|
|
|
$encoder = Color::TupleEncode->new(tuple=>[$a,$b,$c]); |
|
49
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
# pass in some options understood by the encoding implementation |
|
51
|
|
|
|
|
|
|
%options = {-ha=>30, -saturation=>{dmin=>0.2,dmax=>0.8}}; |
|
52
|
|
|
|
|
|
|
$encoder = Color::TupleEncode->new(tuple=>[$a,$b,$c],options=>\%options); |
|
53
|
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
# initialize tuple directly |
|
55
|
|
|
|
|
|
|
$encoder->set_tuple($a,$b,$c); |
|
56
|
|
|
|
|
|
|
$encoder->set_tuple([$a,$b,$c]); |
|
57
|
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
# obtain RGB (0 <= R,G,B <= 1) values |
|
59
|
|
|
|
|
|
|
($r,$g,$b) = $encoder->as_RGB; |
|
60
|
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
# obtain RGB (0 <= R,G,B <= 255) values |
|
62
|
|
|
|
|
|
|
($r255,$g255,$b255) = $encoder->as_RGB255; |
|
63
|
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
# obtain RGB hex (e.g. FF00FF - note no leading #) |
|
65
|
|
|
|
|
|
|
$hex = $encoder->as_RGBhex; |
|
66
|
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
# obtain HSV (0 <= H < 360, 0 <= S,V <= 1) values |
|
68
|
|
|
|
|
|
|
($h,$s,$v) = $encoder->as_HSV; |
|
69
|
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
# change the encoding method |
|
71
|
|
|
|
|
|
|
$encoder->set_method("Color::TupleEncode::2Way"); |
|
72
|
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
# see how many values this method accepts ($tuple_size = 2) |
|
74
|
|
|
|
|
|
|
$tuple_size = $encoder->get_tuple_size(); |
|
75
|
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
# set the tuple with the new method and encode |
|
77
|
|
|
|
|
|
|
$encoder->set_tuple(1,2); |
|
78
|
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
($r,$g,$b) = $encoder->as_RGB; |
|
80
|
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
Use C<%options> to define implementation and any parameters that control the encoding. |
|
82
|
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
%options = (-method=>"Color::TupleEncode::Baran"); |
|
84
|
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
%options = (-method=>"Color::TupleEncode::Baran", |
|
86
|
|
|
|
|
|
|
-saturation=>{min=>0,max=>1,dmin=>0,dmax=>1}); |
|
87
|
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
A non-OO interface is also supported. |
|
89
|
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
# import functions explicitly |
|
91
|
|
|
|
|
|
|
use Color::TupleEncode qw(tuple_asRGB tuple_asRGB255 tuple_asHSV tuple_asRGBhex); |
|
92
|
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
# or import them all automatically |
|
94
|
|
|
|
|
|
|
use Color::TupleEncode qw(:all); |
|
95
|
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
# pass tuple and options just like with new() |
|
97
|
|
|
|
|
|
|
($r,$g,$b) = tuple_asRGB(tuple=>[$a,$b,$c]); |
|
98
|
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
# specify options |
|
100
|
|
|
|
|
|
|
($r,$g,$b) = tuple_asRGB(tuple=>[$a,$b,$c],options=>\%options) |
|
101
|
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
# specify method directly - note that ::2Way takes two values |
|
103
|
|
|
|
|
|
|
($r,$g,$b) = tuple_asRGB(tuple=>[$a,$b],method=>"Color::TupleEncode::2Way"); |
|
104
|
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
# tuple_asRGB255, tuple_asHSV and tuple_asRGBhex work analogously |
|
106
|
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
=head1 COLOR ENCODINGS |
|
108
|
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
=head2 Default Encoding |
|
110
|
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
The default encoding method is due to I (see L
|
|
112
|
|
|
|
|
|
|
ENCODINGS>). This method encodes a 3-tuple C<(x,y,z)> by first assigning a |
|
113
|
|
|
|
|
|
|
characteristic hue to each variable and then calculating a color based |
|
114
|
|
|
|
|
|
|
on the relative relationship of the values. The encoding is designed |
|
115
|
|
|
|
|
|
|
to emphasize the variable that is most different. |
|
116
|
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
The default encoding is implemented in L. |
|
118
|
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
=head2 C |
|
120
|
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
This encoding converts a 2-tuple C<(x,y)> to color. It is implemented in the module L. |
|
122
|
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
If you would like to implement your own encoding, I suggest editing and extend this module. See |
|
124
|
|
|
|
|
|
|
L for more details. |
|
125
|
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
=head2 Other Encodings |
|
127
|
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
C is designed to derive encoding functionality |
|
129
|
|
|
|
|
|
|
from utility modules, such as L. The |
|
130
|
|
|
|
|
|
|
utility modules implement the specifics of the tuple-to-color |
|
131
|
|
|
|
|
|
|
conversion and L does the housekeeping. |
|
132
|
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
You can change the class by using C<-method> in the C<%options> hash passed to C |
|
134
|
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
%options = (-method=>"Color::TupleEncode::2Way"); |
|
136
|
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
set the option directly |
|
138
|
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
$threeway->set_options(-method=>"Color::TupleEncode::2Way"); |
|
140
|
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
or pass the method name to C |
|
142
|
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
Color::TupleEncode->new(method=>"Color::TupleEncode::2Way"); |
|
144
|
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
Note that when using the options hash, option names are prefixed by |
|
146
|
|
|
|
|
|
|
C<->. When passing arguments to C, however, the C<-> is not |
|
147
|
|
|
|
|
|
|
used. |
|
148
|
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
=head1 EXAMPLES |
|
150
|
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
=head2 Quick encoding |
|
152
|
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
To encode a tuple with the default encoding scheme (C): |
|
154
|
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
use Color::TupleEncode qw(as_HSV as_RGBhex); |
|
156
|
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
my @tuple = (0.2,0.5,0.9); |
|
158
|
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
my @hsv = as_HSV(tuple=>\@tuple); # 291 0.7 1.0 |
|
160
|
|
|
|
|
|
|
my @rgb = as_RGB255(tuple=>\@tuple); # 230 77 255 |
|
161
|
|
|
|
|
|
|
my $hex = as_RGBhex(tuple=>\@tuple); # E64DFF |
|
162
|
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
=head2 Encoding with options |
|
164
|
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
Options control how individual encodings work. The |
|
166
|
|
|
|
|
|
|
C method supports changing the |
|
167
|
|
|
|
|
|
|
characteristic hues of each variable, min/max ranges for saturation |
|
168
|
|
|
|
|
|
|
and value and min/max ranges for the largest variable difference for |
|
169
|
|
|
|
|
|
|
saturation and value components. |
|
170
|
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
# change the characteristic hues |
|
172
|
|
|
|
|
|
|
my @hsv = as_HSV(tuple=>\@tuple,options=>{-ha=>60,-hb=>180,-hc=>300}); # 351 0.7 1.0 |
|
173
|
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
=head2 Using another implementation |
|
175
|
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
use Color::TupleEncode qw(as_HSV as_RGBhex); |
|
177
|
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
my @tuple = (0.2,0.5,0.9); |
|
179
|
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
my $method = "Color::TupleEncode::2Way"; |
|
181
|
|
|
|
|
|
|
my @hsv = tuple_asHSV(tuple=>\@tuple,method=>$method); # 255 0.6 1.0 |
|
182
|
|
|
|
|
|
|
my @rgb = tuple_asRGB255(tuple=>\@tuple,method=>$method); # 102 140 255 |
|
183
|
|
|
|
|
|
|
my @rgb = tuple_asRGBhex(tuple=>\@tuple,method=>$method); # 668Cff |
|
184
|
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
=head2 examples/example-3way |
|
186
|
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
This is one of the example scripts in the C directory. It |
|
188
|
|
|
|
|
|
|
shows how to use the 3-tuple encoding implemented by L |
|
189
|
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
The C takes a 3-tuple (or uses a random one) and reports its HSV, RGB and hex colors. |
|
191
|
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
# use a random tuple |
|
193
|
|
|
|
|
|
|
> examples/example-3way |
|
194
|
|
|
|
|
|
|
The 3-tuple 0.787 0.608 0.795 encodes as follows |
|
195
|
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
hue 125 saturation 0.186 value 1.000 |
|
197
|
|
|
|
|
|
|
R 207 G 255 B 211 |
|
198
|
|
|
|
|
|
|
hex CFFFD3 |
|
199
|
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
# use a 3-tuple specified with -tuple |
|
201
|
|
|
|
|
|
|
> examples/example-3way -tuple 0.2,0.3,0.9 |
|
202
|
|
|
|
|
|
|
The 3-tuple 0.200 0.300 0.900 encodes as follows |
|
203
|
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
hue 257 saturation 0.700 value 1.000 |
|
205
|
|
|
|
|
|
|
R 128 G 77 B 255 |
|
206
|
|
|
|
|
|
|
hex 804DFF |
|
207
|
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
=head2 examples/examples-2way |
|
209
|
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
This is one of the example scripts in the C directory. It |
|
211
|
|
|
|
|
|
|
shows how to use the 2-tuple encoding implemented by L |
|
212
|
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
The C takes a 2-tuple (or uses a random one) and reports its HSV, RGB and hex colors. |
|
214
|
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
# use a random 2-tuple |
|
216
|
|
|
|
|
|
|
> examples/example-2way |
|
217
|
|
|
|
|
|
|
The 2-tuple 0.786 0.524 encodes as follows |
|
218
|
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
hue 240 saturation 0.440 value 0.126 |
|
220
|
|
|
|
|
|
|
R 18 G 18 B 32 |
|
221
|
|
|
|
|
|
|
hex 121220 |
|
222
|
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
# use a 2-tuple specified with -tuple |
|
224
|
|
|
|
|
|
|
> examples/example-2way -tuple 0.2,0.9 |
|
225
|
|
|
|
|
|
|
The 2-tuple 0.200 0.900 encodes as follows |
|
226
|
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
hue 40 saturation 0.167 value 0.422 |
|
228
|
|
|
|
|
|
|
R 108 G 102 B 90 |
|
229
|
|
|
|
|
|
|
hex 6C665A |
|
230
|
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
=head2 examples/tuple2color |
|
232
|
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
This script is much more flexible. It can read tuples from a file, or |
|
234
|
|
|
|
|
|
|
generate a matrix of tuples that span a given range. You can specify |
|
235
|
|
|
|
|
|
|
the implementation and options on the command line. |
|
236
|
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
The script can also generate a PNG color chart of the kind seen at L. |
|
238
|
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
By default C uses the 3-tuple encoding. |
|
240
|
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
# generate a matrix of tuples and report RGB, HSV and hex values |
|
242
|
|
|
|
|
|
|
> examples/tuple2color |
|
243
|
|
|
|
|
|
|
abc 0 0 0 rgb 255 255 255 hsv 0 0 1 hex FFFFFF |
|
244
|
|
|
|
|
|
|
abc 0.2 0 0 rgb 255 204 204 hsv 0 0.2 1 hex FFCCCC |
|
245
|
|
|
|
|
|
|
abc 0.4 0 0 rgb 255 153 153 hsv 0 0.4 1 hex FF9999 |
|
246
|
|
|
|
|
|
|
abc 0.6 0 0 rgb 255 102 102 hsv 0 0.6 1 hex FF6666 |
|
247
|
|
|
|
|
|
|
abc 0.8 0 0 rgb 255 51 51 hsv 0 0.8 1 hex FF3333 |
|
248
|
|
|
|
|
|
|
... |
|
249
|
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
# specify range of matrix values (default is min=0, max=1, step=(max-min)/10) |
|
251
|
|
|
|
|
|
|
tuple2color -min 0 -max 1 -step 0.1 |
|
252
|
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
# you can overwrite one or more matrix settings |
|
254
|
|
|
|
|
|
|
tuple2color -step 0.2 |
|
255
|
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
# instead of using an automatically generated matrix, |
|
257
|
|
|
|
|
|
|
# specify input data (tuples) |
|
258
|
|
|
|
|
|
|
tuple2color -data matrix_data.txt |
|
259
|
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
# specify how matrix entries should be sorted (default no sort) |
|
261
|
|
|
|
|
|
|
tuple2color -data matrix_data.txt -sortby a,b,c |
|
262
|
|
|
|
|
|
|
tuple2color -data matrix_data.txt -sortby b,c,a |
|
263
|
|
|
|
|
|
|
tuple2color -data matrix_data.txt -sortby c,a,b |
|
264
|
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
# specify implementation |
|
266
|
|
|
|
|
|
|
tuple2color -data matrix_data.txt -method Color::TupleEncode::Baran |
|
267
|
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
# specify options for Color::Threeway |
|
269
|
|
|
|
|
|
|
draw_color_char ... -options "-saturation=>{dmin=>0,dmax=>1}" |
|
270
|
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
In addition, generate a PNG image of values and corresponding encoded colors. |
|
272
|
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
# draw color patch matrix using default settings |
|
274
|
|
|
|
|
|
|
tuple2color -draw |
|
275
|
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
# specify output image size |
|
277
|
|
|
|
|
|
|
tuple2color ... -width 500 -height 500 |
|
278
|
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
# specify output file |
|
280
|
|
|
|
|
|
|
tuple2color ... -outfile somematrix.png |
|
281
|
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
The 2-way and 3-way encoding color charts are bundled with this |
|
283
|
|
|
|
|
|
|
module, at C. |
|
284
|
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
These charts were generated using C as follows. |
|
286
|
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
A large 2-tuple encoding chart with C<[a,b]> in the range C<[0,2]> sampling every C<0.15>. |
|
288
|
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
./tuple2color -method "Color::TupleEncode::2Way" \ |
|
290
|
|
|
|
|
|
|
-min 0 -max 2 -step 0.15 \ |
|
291
|
|
|
|
|
|
|
-outfile color-chart-2way.png \ |
|
292
|
|
|
|
|
|
|
-width 600 -height 1360 \ |
|
293
|
|
|
|
|
|
|
-draw |
|
294
|
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
A small 2-tuple encoding chart with C<[a,b]> in the range C<[0,2]> sampling every C<0.3>. |
|
296
|
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
./tuple2color -method "Color::TupleEncode::2Way" \ |
|
298
|
|
|
|
|
|
|
-min 0 -max 2 -step 0.3 \ |
|
299
|
|
|
|
|
|
|
-outfile color-chart-2way-small.png \ |
|
300
|
|
|
|
|
|
|
-width 600 -height 430 \ |
|
301
|
|
|
|
|
|
|
-draw |
|
302
|
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
A large 3-tuple encoding chart with C<[a,b,c]> in the range C<[0,1]> sampling every C<0.2>. |
|
304
|
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
./tuple2color -step 0.2 \ |
|
306
|
|
|
|
|
|
|
-outfile color-chart-3way.png \ |
|
307
|
|
|
|
|
|
|
-width 650 -height 1450 \ |
|
308
|
|
|
|
|
|
|
-draw |
|
309
|
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
A large 2-tuple encoding chart with C<[a,b,c]> in the range C<[0,1]> sampling every C<1/3>. |
|
311
|
|
|
|
|
|
|
|
|
312
|
|
|
|
|
|
|
./tuple2color -step 0.33333333333 \ |
|
313
|
|
|
|
|
|
|
-outfile color-chart-3way-small.png \ |
|
314
|
|
|
|
|
|
|
-width 650 -height 450 \ |
|
315
|
|
|
|
|
|
|
-draw |
|
316
|
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
=head1 SUBROUTINES/METHODS |
|
318
|
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
=head2 C |
|
320
|
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
=head2 C [ $a,$b,$c ] )> |
|
322
|
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
=head2 C [ $a,$b,$c ], options =E \%options)> |
|
324
|
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
=head2 C [ $a,$b,$c ], method =E $class_name)> |
|
326
|
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
=head2 C [ $a,$b,$c ], method =E $class_name, options =E \%options)> |
|
328
|
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
Initializes the encoder object. You can immediately pass in a tuple, |
|
330
|
|
|
|
|
|
|
options and/or an encoding method. The method can be part of the option hash (as C<-method>). |
|
331
|
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
Options are passed in as a hash reference and the encoding method as |
|
333
|
|
|
|
|
|
|
the name of the module that implements the encoding. Two |
|
334
|
|
|
|
|
|
|
methods are available (C (default encoding) |
|
335
|
|
|
|
|
|
|
and C). |
|
336
|
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
At any time if you try to pass in incorrectly formatted input (e.g. the wrong number of elements in a tuple, an option that is not understood by the encoding method), the module dies using C. |
|
338
|
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
You can write your own encoding method - see L
|
|
340
|
|
|
|
|
|
|
ENCODING CLASS> for details. |
|
341
|
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
=cut |
|
343
|
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
sub new { |
|
345
|
93
|
|
|
93
|
1
|
2222936
|
my $class = shift; |
|
346
|
|
|
|
|
|
|
|
|
347
|
93
|
100
|
100
|
|
|
671
|
if(@_ && @_ % 2) { |
|
348
|
3
|
|
|
|
|
556
|
confess "Arguments to new must be a hash (i.e. even number of entries)"; |
|
349
|
|
|
|
|
|
|
} |
|
350
|
|
|
|
|
|
|
|
|
351
|
90
|
100
|
|
|
|
285
|
$class = ref($class) ? ref($class) : $class; |
|
352
|
90
|
|
|
|
|
179
|
my $self = {}; |
|
353
|
90
|
|
|
|
|
249
|
bless $self, $class; |
|
354
|
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
# immediately set the method to default - this ensures that |
|
356
|
|
|
|
|
|
|
# a method is set for any further steps |
|
357
|
90
|
|
|
|
|
502
|
$self->_set_method($OPTIONS_DEFAULT{-method}); |
|
358
|
|
|
|
|
|
|
|
|
359
|
90
|
|
|
|
|
451
|
my %args = @_; |
|
360
|
|
|
|
|
|
|
|
|
361
|
90
|
100
|
|
|
|
272
|
if($args{method}) { |
|
362
|
4
|
|
|
|
|
11
|
$self->_set_method($args{method}); |
|
363
|
|
|
|
|
|
|
} |
|
364
|
|
|
|
|
|
|
|
|
365
|
89
|
|
|
|
|
342
|
my %args_ok = (options=>1,tuple=>1,method=>1); |
|
366
|
|
|
|
|
|
|
|
|
367
|
89
|
100
|
|
|
|
433
|
if(my @args_notok = grep(! $args_ok{$_}, keys %args)) { |
|
368
|
2
|
|
|
|
|
312
|
confess "Do not understand new() arguments ".join(" ",@args_notok); |
|
369
|
|
|
|
|
|
|
} |
|
370
|
|
|
|
|
|
|
|
|
371
|
87
|
100
|
|
|
|
252
|
if($args{options}) { |
|
372
|
59
|
|
|
|
|
91
|
my $options = $args{options}; |
|
373
|
59
|
|
|
|
|
154
|
$self->set_options($options); |
|
374
|
|
|
|
|
|
|
} |
|
375
|
85
|
100
|
|
|
|
247
|
if($args{tuple}) { |
|
376
|
68
|
|
|
|
|
207
|
$self->set_tuple( $args{tuple} ); |
|
377
|
|
|
|
|
|
|
} |
|
378
|
|
|
|
|
|
|
|
|
379
|
77
|
|
|
|
|
515
|
return $self; |
|
380
|
|
|
|
|
|
|
} |
|
381
|
|
|
|
|
|
|
|
|
382
|
|
|
|
|
|
|
=head2 C |
|
383
|
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
Define options that control how encoding is done. Each encoding method has |
|
385
|
|
|
|
|
|
|
its own set of options. For details, see L. |
|
386
|
|
|
|
|
|
|
|
|
387
|
|
|
|
|
|
|
Options are passed in as a hash and option names are prefixed with C<->. |
|
388
|
|
|
|
|
|
|
|
|
389
|
|
|
|
|
|
|
$encoder->set_options(-ha=>0,-hb=>120,-hc=>240); |
|
390
|
|
|
|
|
|
|
|
|
391
|
|
|
|
|
|
|
=cut |
|
392
|
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
sub set_options { |
|
394
|
218
|
|
|
218
|
1
|
1518
|
my ($self,@options) = @_; |
|
395
|
218
|
100
|
|
|
|
551
|
return if ! @options; |
|
396
|
217
|
|
|
|
|
298
|
my %options; |
|
397
|
217
|
100
|
|
|
|
846
|
if(not @options % 2) { |
|
|
|
50
|
|
|
|
|
|
|
398
|
12
|
|
|
|
|
32
|
%options = @options; |
|
399
|
|
|
|
|
|
|
} |
|
400
|
|
|
|
|
|
|
elsif (@options == 1) { |
|
401
|
205
|
|
|
|
|
415
|
my $options_first = $options[0]; |
|
402
|
205
|
50
|
|
|
|
462
|
if(ref( $options_first ) eq "HASH") { |
|
403
|
205
|
|
|
|
|
992
|
%options = %$options_first; |
|
404
|
|
|
|
|
|
|
} else { |
|
405
|
0
|
|
|
|
|
0
|
confess "Value passed to options must be a hash or hash reference"; |
|
406
|
|
|
|
|
|
|
} |
|
407
|
|
|
|
|
|
|
} |
|
408
|
|
|
|
|
|
|
else { |
|
409
|
0
|
|
|
|
|
0
|
confess "Value passed to options must be a hash or hash reference"; |
|
410
|
|
|
|
|
|
|
} |
|
411
|
217
|
|
|
|
|
751
|
my @option_names = keys %options; |
|
412
|
|
|
|
|
|
|
# make sure that the -method option, if it exists, is set first |
|
413
|
217
|
|
|
|
|
1078
|
@option_names = (grep($_ eq "-method", @option_names), |
|
414
|
|
|
|
|
|
|
grep($_ ne "-method", @option_names)); |
|
415
|
217
|
|
|
|
|
535
|
for my $option_name (@option_names) { |
|
416
|
903
|
|
|
|
|
1770
|
my $option_value = $options{$option_name}; |
|
417
|
903
|
100
|
|
|
|
1731
|
if($option_name eq "-method") { |
|
418
|
54
|
|
|
|
|
131
|
$self->_set_method($option_value); |
|
419
|
|
|
|
|
|
|
} else { |
|
420
|
849
|
|
|
|
|
2366
|
my $method = $self->get_options(-method); |
|
421
|
849
|
|
|
|
|
2415
|
$self->_validate_option($option_name,$option_value); |
|
422
|
846
|
100
|
|
|
|
1627
|
if(! defined $option_value) { |
|
423
|
36
|
|
|
|
|
296
|
$self->_clear_option($option_name); |
|
424
|
|
|
|
|
|
|
} |
|
425
|
|
|
|
|
|
|
else { |
|
426
|
810
|
|
|
|
|
3420
|
$self->{options}{$option_name} = $option_value; |
|
427
|
|
|
|
|
|
|
} |
|
428
|
|
|
|
|
|
|
} |
|
429
|
|
|
|
|
|
|
} |
|
430
|
|
|
|
|
|
|
} |
|
431
|
|
|
|
|
|
|
|
|
432
|
|
|
|
|
|
|
=pod |
|
433
|
|
|
|
|
|
|
|
|
434
|
|
|
|
|
|
|
=head2 C<$ok = has_option( $option_name )> |
|
435
|
|
|
|
|
|
|
|
|
436
|
|
|
|
|
|
|
Tests whether the current encoding scheme supports (and has set) the option C<$option_name>. |
|
437
|
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
If the method does not support the option, undef is returned. |
|
439
|
|
|
|
|
|
|
|
|
440
|
|
|
|
|
|
|
If the method supports the option, but it is not set, 0 is returned. |
|
441
|
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
If the method supports the option, and the option is set, 1 is returned. |
|
443
|
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
=cut |
|
445
|
|
|
|
|
|
|
|
|
446
|
|
|
|
|
|
|
sub has_option { |
|
447
|
0
|
|
|
0
|
1
|
0
|
my ($self,$option_name) = @_; |
|
448
|
0
|
|
|
|
|
0
|
my @options_ok = $self->_get_ok_options(); |
|
449
|
0
|
0
|
0
|
|
|
0
|
if(! grep($_ eq $option_name, @options_ok)) { |
|
|
|
0
|
|
|
|
|
|
|
450
|
0
|
|
|
|
|
0
|
return; |
|
451
|
|
|
|
|
|
|
} elsif (exists $self->{options}{$option_name} |
|
452
|
|
|
|
|
|
|
&& |
|
453
|
|
|
|
|
|
|
defined $self->{options}{$option_name}) { |
|
454
|
0
|
|
|
|
|
0
|
return 1; |
|
455
|
|
|
|
|
|
|
} else { |
|
456
|
0
|
|
|
|
|
0
|
return 0; |
|
457
|
|
|
|
|
|
|
} |
|
458
|
|
|
|
|
|
|
} |
|
459
|
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
=for comment |
|
461
|
|
|
|
|
|
|
Validate an option as acceptable. Returns 1 if the option is supported by the current method, and dies otherwise. |
|
462
|
|
|
|
|
|
|
|
|
463
|
|
|
|
|
|
|
=cut |
|
464
|
|
|
|
|
|
|
|
|
465
|
|
|
|
|
|
|
sub _validate_option { |
|
466
|
849
|
|
|
849
|
|
1473
|
my ($self,$option_name,$option_value) = @_; |
|
467
|
849
|
50
|
|
|
|
1812
|
confess "Cannot validate an undefined option name." unless defined $option_name; |
|
468
|
849
|
|
|
|
|
1064
|
my @options_ok; |
|
469
|
|
|
|
|
|
|
my $method; |
|
470
|
849
|
50
|
|
|
|
2271
|
if(! defined $self->{options}{-method}) { |
|
471
|
|
|
|
|
|
|
# this package's default options |
|
472
|
0
|
|
|
|
|
0
|
confess "Cannot set options to an object that does not have encoding implementation defined."; |
|
473
|
|
|
|
|
|
|
} |
|
474
|
|
|
|
|
|
|
else { |
|
475
|
|
|
|
|
|
|
# this package's default options and the implementation's default options |
|
476
|
849
|
|
|
|
|
1652
|
@options_ok = $self->_get_ok_options(); |
|
477
|
849
|
|
|
|
|
2365
|
$method = $self->{options}{-method}; |
|
478
|
|
|
|
|
|
|
} |
|
479
|
849
|
100
|
|
|
|
3514
|
if(! grep($_ eq $option_name, @options_ok)) { |
|
480
|
3
|
|
|
|
|
606
|
confess "Encoding implementation $method does not support option $option_name."; |
|
481
|
|
|
|
|
|
|
} |
|
482
|
846
|
100
|
|
|
|
1645
|
if(! defined $option_value) { |
|
483
|
|
|
|
|
|
|
# An undefined option value is acceptable - the option will be cleared |
|
484
|
36
|
|
|
|
|
102
|
return 1; |
|
485
|
|
|
|
|
|
|
} else { |
|
486
|
810
|
|
|
|
|
2269
|
return 1; |
|
487
|
|
|
|
|
|
|
} |
|
488
|
|
|
|
|
|
|
} |
|
489
|
|
|
|
|
|
|
|
|
490
|
|
|
|
|
|
|
=pod |
|
491
|
|
|
|
|
|
|
|
|
492
|
|
|
|
|
|
|
=head2 C<%options = get_options()> |
|
493
|
|
|
|
|
|
|
|
|
494
|
|
|
|
|
|
|
=head2 C<$option_value = get_options( "-saturation" )> |
|
495
|
|
|
|
|
|
|
|
|
496
|
|
|
|
|
|
|
=head2 C<($option_value_1,$option_value_2) = get_options( qw(-saturation -value) )> |
|
497
|
|
|
|
|
|
|
|
|
498
|
|
|
|
|
|
|
Retrieve one or more (or all) option values. Options control how color |
|
499
|
|
|
|
|
|
|
encoding is done and are set by C or during |
|
500
|
|
|
|
|
|
|
initialization. |
|
501
|
|
|
|
|
|
|
|
|
502
|
|
|
|
|
|
|
If no option names are passed, a hash of all defined options (hash |
|
503
|
|
|
|
|
|
|
keys) and their values (hash values) is returned. |
|
504
|
|
|
|
|
|
|
|
|
505
|
|
|
|
|
|
|
If one or more option names is passed, a list of corresponding values |
|
506
|
|
|
|
|
|
|
is returned. |
|
507
|
|
|
|
|
|
|
|
|
508
|
|
|
|
|
|
|
=cut |
|
509
|
|
|
|
|
|
|
|
|
510
|
|
|
|
|
|
|
sub get_options { |
|
511
|
2140
|
|
|
2140
|
1
|
35758
|
my $self = shift; |
|
512
|
2140
|
|
|
|
|
6511
|
my @options = @_; |
|
513
|
|
|
|
|
|
|
|
|
514
|
2140
|
50
|
|
|
|
7086
|
if(! defined $self->{options}{-method}) { |
|
515
|
0
|
|
|
|
|
0
|
confess "Cannot get_options() on an object which does not have the encoding method set."; |
|
516
|
|
|
|
|
|
|
} |
|
517
|
|
|
|
|
|
|
# get a list of all allowable options for this implementation |
|
518
|
2140
|
|
|
|
|
4148
|
my $method = $self->{options}{-method}; |
|
519
|
2140
|
|
|
|
|
4462
|
my @ok_options = $self->_get_ok_options(); |
|
520
|
2140
|
|
|
|
|
3543
|
my $output_hash = 0; |
|
521
|
|
|
|
|
|
|
# if no options were asked for, we'll return them all |
|
522
|
2140
|
100
|
|
|
|
5203
|
if(! @options) { |
|
523
|
56
|
|
|
|
|
153
|
my @ok_options = $self->_get_ok_options(); |
|
524
|
56
|
|
|
|
|
151
|
@options = @ok_options; |
|
525
|
56
|
|
|
|
|
113
|
$output_hash = 1; |
|
526
|
|
|
|
|
|
|
} |
|
527
|
2140
|
|
|
|
|
2702
|
my @values; |
|
528
|
|
|
|
|
|
|
my %values; |
|
529
|
2140
|
|
|
|
|
3813
|
for my $option_name (@options) { |
|
530
|
2693
|
50
|
|
|
|
9514
|
if(grep($_ eq $option_name, @ok_options)) { |
|
531
|
2693
|
|
|
|
|
3286
|
my $option_value; |
|
532
|
2693
|
100
|
66
|
|
|
30844
|
if(exists $self->{options}{$option_name} && defined $self->{options}{$option_name}) { |
|
533
|
2508
|
|
|
|
|
4762
|
$option_value = $self->{options}{$option_name}; |
|
534
|
|
|
|
|
|
|
} else { |
|
535
|
185
|
|
|
|
|
337
|
$option_value = undef; |
|
536
|
|
|
|
|
|
|
} |
|
537
|
2693
|
|
|
|
|
3866
|
push @values, $option_value; |
|
538
|
2693
|
|
|
|
|
9433
|
$values{$option_name} = $option_value; |
|
539
|
|
|
|
|
|
|
} else { |
|
540
|
0
|
|
|
|
|
0
|
confess "You asked for option $option_name - this option is not supported by method $method."; |
|
541
|
|
|
|
|
|
|
} |
|
542
|
|
|
|
|
|
|
} |
|
543
|
2140
|
100
|
|
|
|
4473
|
if($output_hash) { |
|
544
|
56
|
|
|
|
|
660
|
return %values; |
|
545
|
|
|
|
|
|
|
} else { |
|
546
|
2084
|
100
|
|
|
|
4428
|
if(@values == 1) { |
|
547
|
1939
|
|
|
|
|
9709
|
return $values[0]; |
|
548
|
|
|
|
|
|
|
} else { |
|
549
|
145
|
|
|
|
|
910
|
return @values; |
|
550
|
|
|
|
|
|
|
} |
|
551
|
|
|
|
|
|
|
} |
|
552
|
|
|
|
|
|
|
} |
|
553
|
|
|
|
|
|
|
|
|
554
|
|
|
|
|
|
|
=for comment |
|
555
|
|
|
|
|
|
|
Clear options |
|
556
|
|
|
|
|
|
|
|
|
557
|
|
|
|
|
|
|
=cut |
|
558
|
|
|
|
|
|
|
|
|
559
|
|
|
|
|
|
|
sub _clear_options { |
|
560
|
146
|
|
|
146
|
|
249
|
my $self = shift; |
|
561
|
146
|
|
|
|
|
545
|
$self->{options} = {}; |
|
562
|
|
|
|
|
|
|
} |
|
563
|
|
|
|
|
|
|
|
|
564
|
|
|
|
|
|
|
=for comment |
|
565
|
|
|
|
|
|
|
Clear option by deleting its entry. |
|
566
|
|
|
|
|
|
|
|
|
567
|
|
|
|
|
|
|
=cut |
|
568
|
|
|
|
|
|
|
|
|
569
|
|
|
|
|
|
|
sub _clear_option { |
|
570
|
36
|
|
|
36
|
|
83
|
my ($self,$option_name) = shift; |
|
571
|
36
|
50
|
|
|
|
199
|
if(defined $option_name) { |
|
572
|
0
|
|
|
|
|
0
|
delete $self->{options}{$option_name}; |
|
573
|
|
|
|
|
|
|
} |
|
574
|
|
|
|
|
|
|
} |
|
575
|
|
|
|
|
|
|
|
|
576
|
|
|
|
|
|
|
|
|
577
|
|
|
|
|
|
|
=pod |
|
578
|
|
|
|
|
|
|
|
|
579
|
|
|
|
|
|
|
=head2 C |
|
580
|
|
|
|
|
|
|
|
|
581
|
|
|
|
|
|
|
=head2 C |
|
582
|
|
|
|
|
|
|
|
|
583
|
|
|
|
|
|
|
Define the tuple to encode to a color. Retrieve with C. |
|
584
|
|
|
|
|
|
|
|
|
585
|
|
|
|
|
|
|
The tuple size must be compatible with the encoding method. You can check the required size with C. |
|
586
|
|
|
|
|
|
|
|
|
587
|
|
|
|
|
|
|
=cut |
|
588
|
|
|
|
|
|
|
|
|
589
|
|
|
|
|
|
|
sub set_tuple { |
|
590
|
132
|
|
|
132
|
1
|
38631
|
my ($self,@tuple) = @_; |
|
591
|
132
|
|
|
|
|
368
|
my @ok_tuple = $self->_validate_tuple(@tuple); |
|
592
|
115
|
|
|
|
|
361
|
$self->_set_tuple(@ok_tuple); |
|
593
|
|
|
|
|
|
|
} |
|
594
|
|
|
|
|
|
|
|
|
595
|
|
|
|
|
|
|
=for comment |
|
596
|
|
|
|
|
|
|
Set object's data tuple. |
|
597
|
|
|
|
|
|
|
|
|
598
|
|
|
|
|
|
|
=cut |
|
599
|
|
|
|
|
|
|
|
|
600
|
|
|
|
|
|
|
sub _set_tuple { |
|
601
|
115
|
|
|
115
|
|
239
|
my ($self,@tuple) = @_; |
|
602
|
115
|
|
|
|
|
2749177
|
$self->{data} = [@tuple]; |
|
603
|
|
|
|
|
|
|
} |
|
604
|
|
|
|
|
|
|
|
|
605
|
|
|
|
|
|
|
=pod |
|
606
|
|
|
|
|
|
|
|
|
607
|
|
|
|
|
|
|
=head2 C<@tuple = get_tuple()> |
|
608
|
|
|
|
|
|
|
|
|
609
|
|
|
|
|
|
|
Retrieve the current tuple, defind by C. |
|
610
|
|
|
|
|
|
|
|
|
611
|
|
|
|
|
|
|
=cut |
|
612
|
|
|
|
|
|
|
|
|
613
|
|
|
|
|
|
|
sub get_tuple { |
|
614
|
861
|
|
|
861
|
1
|
1148
|
my $self = shift; |
|
615
|
861
|
100
|
|
|
|
2306
|
if($self->{data}) { |
|
616
|
860
|
|
|
|
|
893
|
return @{$self->{data}}; |
|
|
860
|
|
|
|
|
3638
|
|
|
617
|
|
|
|
|
|
|
} else { |
|
618
|
1
|
|
|
|
|
13
|
return; |
|
619
|
|
|
|
|
|
|
} |
|
620
|
|
|
|
|
|
|
} |
|
621
|
|
|
|
|
|
|
|
|
622
|
|
|
|
|
|
|
=pod |
|
623
|
|
|
|
|
|
|
|
|
624
|
|
|
|
|
|
|
=head2 C<$size = get_tuple_size()> |
|
625
|
|
|
|
|
|
|
|
|
626
|
|
|
|
|
|
|
Retrieve the size of the tuple for the current implementation. For |
|
627
|
|
|
|
|
|
|
example, the method by I (see L) uses three |
|
628
|
|
|
|
|
|
|
values as input, thus C<$size=3>. |
|
629
|
|
|
|
|
|
|
|
|
630
|
|
|
|
|
|
|
=cut |
|
631
|
|
|
|
|
|
|
|
|
632
|
|
|
|
|
|
|
sub get_tuple_size { |
|
633
|
1
|
|
|
1
|
1
|
2
|
my $self = shift; |
|
634
|
1
|
|
|
|
|
5
|
my $method = $self->get_options(-method); |
|
635
|
1
|
50
|
|
|
|
4
|
if(! defined $method) { |
|
636
|
0
|
|
|
|
|
0
|
confess "Cannot retrieve tuple size for an undefined method"; |
|
637
|
|
|
|
|
|
|
} else { |
|
638
|
1
|
|
|
|
|
4
|
return $method->_get_tuple_size(); |
|
639
|
|
|
|
|
|
|
} |
|
640
|
|
|
|
|
|
|
} |
|
641
|
|
|
|
|
|
|
|
|
642
|
|
|
|
|
|
|
|
|
643
|
|
|
|
|
|
|
=for comment |
|
644
|
|
|
|
|
|
|
Set and get the encoding method. |
|
645
|
|
|
|
|
|
|
|
|
646
|
|
|
|
|
|
|
=cut |
|
647
|
|
|
|
|
|
|
|
|
648
|
|
|
|
|
|
|
sub _set_method { |
|
649
|
148
|
|
|
148
|
|
524
|
my ($self,$method) = @_; |
|
650
|
148
|
100
|
|
|
|
967
|
if(ref($method)) { |
|
651
|
1
|
|
|
|
|
177
|
confess "The implementation method must be a string, e.g. 'Color::TupleEncode::2Way'"; |
|
652
|
|
|
|
|
|
|
} |
|
653
|
147
|
|
|
|
|
292
|
for my $fn (qw(_get_value _get_saturation _get_hue _get_tuple_size _get_ok_options _get_default_options)) { |
|
654
|
877
|
100
|
|
|
|
5185
|
if(! $method->can($fn)) { |
|
655
|
1
|
|
|
|
|
274
|
confess "Thex encoding implementation $method does not support $fn"; |
|
656
|
|
|
|
|
|
|
} |
|
657
|
|
|
|
|
|
|
} |
|
658
|
146
|
50
|
|
|
|
586
|
if($method->_get_tuple_size() <= 0) { |
|
659
|
0
|
|
|
|
|
0
|
confess "The encoding implementation $method did not return a positive tuple size. Make sure $method::_get_tuple_size() returns a positive number!"; |
|
660
|
|
|
|
|
|
|
} |
|
661
|
146
|
50
|
|
|
|
498
|
if(! $method->_get_default_options()) { |
|
662
|
0
|
|
|
|
|
0
|
confess "The encoding implementation $method does define \%OPTIONS_DEFAULT"; |
|
663
|
|
|
|
|
|
|
} |
|
664
|
146
|
50
|
|
|
|
1463
|
if(! $method->_get_ok_options()) { |
|
665
|
0
|
|
|
|
|
0
|
confess "The encoding implementation $method does define \@OPTIONS_OK"; |
|
666
|
|
|
|
|
|
|
} |
|
667
|
|
|
|
|
|
|
# when we set a method, clear options because they may have been |
|
668
|
|
|
|
|
|
|
# set by a previous method. |
|
669
|
146
|
|
|
|
|
1045
|
$self->_clear_options(); |
|
670
|
146
|
|
|
|
|
501
|
$self->{options}{-method} = $method; |
|
671
|
|
|
|
|
|
|
# upon setting the method, set all default options associated with the method |
|
672
|
146
|
|
|
|
|
365
|
$self->set_options( $self->_get_implementation_default_options() ); |
|
673
|
|
|
|
|
|
|
} |
|
674
|
|
|
|
|
|
|
|
|
675
|
|
|
|
|
|
|
=pod |
|
676
|
|
|
|
|
|
|
|
|
677
|
|
|
|
|
|
|
=head2 C<$method = get_method()> |
|
678
|
|
|
|
|
|
|
|
|
679
|
|
|
|
|
|
|
Retrieve the current encoding method. By default, this is L. |
|
680
|
|
|
|
|
|
|
|
|
681
|
|
|
|
|
|
|
=cut |
|
682
|
|
|
|
|
|
|
|
|
683
|
|
|
|
|
|
|
sub get_method { |
|
684
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
|
685
|
0
|
|
|
|
|
0
|
return $self->{options}{-method}; |
|
686
|
|
|
|
|
|
|
} |
|
687
|
|
|
|
|
|
|
|
|
688
|
|
|
|
|
|
|
=pod |
|
689
|
|
|
|
|
|
|
|
|
690
|
|
|
|
|
|
|
=head2 C |
|
691
|
|
|
|
|
|
|
|
|
692
|
|
|
|
|
|
|
Set the encoding method. By default, the method is L. |
|
693
|
|
|
|
|
|
|
|
|
694
|
|
|
|
|
|
|
You can also set the method as an option |
|
695
|
|
|
|
|
|
|
|
|
696
|
|
|
|
|
|
|
$encoder->set_options(-method=>"Color::TupleEncode::2Way"); |
|
697
|
|
|
|
|
|
|
|
|
698
|
|
|
|
|
|
|
or at initialization |
|
699
|
|
|
|
|
|
|
|
|
700
|
|
|
|
|
|
|
Color::TupleEncode->new(method=>"Color::TupleEncode::2Way"); |
|
701
|
|
|
|
|
|
|
|
|
702
|
|
|
|
|
|
|
Color::TupleEncode->new(options=>{-method=>"Color::TupleEncode::2Way"}); |
|
703
|
|
|
|
|
|
|
|
|
704
|
|
|
|
|
|
|
Note that when using the options hash, option names are prefixed by |
|
705
|
|
|
|
|
|
|
C<->. When passing arguments to C, however, the C<-> is not |
|
706
|
|
|
|
|
|
|
used. |
|
707
|
|
|
|
|
|
|
|
|
708
|
|
|
|
|
|
|
=cut |
|
709
|
|
|
|
|
|
|
|
|
710
|
|
|
|
|
|
|
sub set_method { |
|
711
|
0
|
|
|
0
|
1
|
0
|
my ($self,$method) = @_; |
|
712
|
0
|
|
|
|
|
0
|
$self->_set_method($method); |
|
713
|
|
|
|
|
|
|
} |
|
714
|
|
|
|
|
|
|
|
|
715
|
|
|
|
|
|
|
=pod |
|
716
|
|
|
|
|
|
|
|
|
717
|
|
|
|
|
|
|
=head2 C<($r,$g,$b) = as_RGB()> |
|
718
|
|
|
|
|
|
|
|
|
719
|
|
|
|
|
|
|
Retrieve the RGB encoding of the current tuple. The tuple is set by either C or at initialization. |
|
720
|
|
|
|
|
|
|
|
|
721
|
|
|
|
|
|
|
Each of the returned RGB component values are in the range C<[0,1]>. |
|
722
|
|
|
|
|
|
|
|
|
723
|
|
|
|
|
|
|
If the tuple is not defined, then C, this and other C methods return nothing (evaluates to false in all contexts). |
|
724
|
|
|
|
|
|
|
|
|
725
|
|
|
|
|
|
|
=cut |
|
726
|
|
|
|
|
|
|
|
|
727
|
|
|
|
|
|
|
sub as_RGB { |
|
728
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
|
729
|
0
|
0
|
|
|
|
0
|
if(! $self->get_tuple) { |
|
730
|
0
|
|
|
|
|
0
|
return; |
|
731
|
|
|
|
|
|
|
} |
|
732
|
0
|
|
|
|
|
0
|
my @hsv = $self->as_HSV(); |
|
733
|
0
|
|
|
|
|
0
|
my $color = Graphics::ColorObject->new_HSV(\@hsv); |
|
734
|
0
|
|
|
|
|
0
|
return @{$color->as_RGB}; |
|
|
0
|
|
|
|
|
0
|
|
|
735
|
|
|
|
|
|
|
} |
|
736
|
|
|
|
|
|
|
|
|
737
|
|
|
|
|
|
|
=pod |
|
738
|
|
|
|
|
|
|
|
|
739
|
|
|
|
|
|
|
=head2 C |
|
740
|
|
|
|
|
|
|
|
|
741
|
|
|
|
|
|
|
Analogous to C but each of the returned RGB component values |
|
742
|
|
|
|
|
|
|
are in the range C<[0,255]>. |
|
743
|
|
|
|
|
|
|
|
|
744
|
|
|
|
|
|
|
=cut |
|
745
|
|
|
|
|
|
|
|
|
746
|
|
|
|
|
|
|
sub as_RGB255 { |
|
747
|
72
|
|
|
72
|
1
|
229
|
my $self = shift; |
|
748
|
72
|
50
|
|
|
|
142
|
if(! $self->get_tuple) { |
|
749
|
0
|
|
|
|
|
0
|
return; |
|
750
|
|
|
|
|
|
|
} |
|
751
|
72
|
|
|
|
|
185
|
my @hsv = $self->as_HSV(); |
|
752
|
72
|
|
|
|
|
468
|
my $color = Graphics::ColorObject->new_HSV(\@hsv); |
|
753
|
72
|
|
|
|
|
21037
|
return @{$color->as_RGB255}; |
|
|
72
|
|
|
|
|
287
|
|
|
754
|
|
|
|
|
|
|
|
|
755
|
|
|
|
|
|
|
} |
|
756
|
|
|
|
|
|
|
|
|
757
|
|
|
|
|
|
|
=pod |
|
758
|
|
|
|
|
|
|
|
|
759
|
|
|
|
|
|
|
=head2 C<$hex = as_RGBhex()> |
|
760
|
|
|
|
|
|
|
|
|
761
|
|
|
|
|
|
|
Analogous to C but returned is the hex encoding (e.g. C) of the RGB color. |
|
762
|
|
|
|
|
|
|
|
|
763
|
|
|
|
|
|
|
Note that the hex encoding does not have a leading C<#>. |
|
764
|
|
|
|
|
|
|
|
|
765
|
|
|
|
|
|
|
=cut |
|
766
|
|
|
|
|
|
|
|
|
767
|
|
|
|
|
|
|
sub as_RGBhex { |
|
768
|
36
|
|
|
36
|
1
|
5960
|
my $self = shift; |
|
769
|
36
|
50
|
|
|
|
104
|
if(! $self->get_tuple) { |
|
770
|
0
|
|
|
|
|
0
|
return; |
|
771
|
|
|
|
|
|
|
} |
|
772
|
36
|
|
|
|
|
145
|
my @hsv = $self->as_HSV(); |
|
773
|
36
|
|
|
|
|
218
|
my $color = Graphics::ColorObject->new_HSV(\@hsv); |
|
774
|
36
|
|
|
|
|
9763
|
return $color->as_RGBhex; |
|
775
|
|
|
|
|
|
|
|
|
776
|
|
|
|
|
|
|
} |
|
777
|
|
|
|
|
|
|
|
|
778
|
|
|
|
|
|
|
=pod |
|
779
|
|
|
|
|
|
|
|
|
780
|
|
|
|
|
|
|
=head2 C<($h,$s,$v) = as_HSV()> |
|
781
|
|
|
|
|
|
|
|
|
782
|
|
|
|
|
|
|
Retrieve the HSV encoding of the current tuple. The tuple is set by either C or at initialization. |
|
783
|
|
|
|
|
|
|
|
|
784
|
|
|
|
|
|
|
Hue C<$h> is in the range C<[0,360)> and saturation C<$s> and value C<$v> in the range C<[0,1]>. |
|
785
|
|
|
|
|
|
|
|
|
786
|
|
|
|
|
|
|
=cut |
|
787
|
|
|
|
|
|
|
|
|
788
|
|
|
|
|
|
|
sub as_HSV { |
|
789
|
174
|
|
|
174
|
1
|
1239
|
my $self = shift; |
|
790
|
174
|
50
|
|
|
|
362
|
if(! $self->get_tuple) { |
|
791
|
0
|
|
|
|
|
0
|
return; |
|
792
|
|
|
|
|
|
|
} |
|
793
|
174
|
|
|
|
|
263
|
my ($h,$s,$v); |
|
794
|
174
|
|
|
|
|
353
|
$h = $self->_get_hue; |
|
795
|
174
|
|
|
|
|
391
|
$s = $self->_get_saturation; |
|
796
|
174
|
|
|
|
|
431
|
$v = $self->_get_value; |
|
797
|
174
|
50
|
|
|
|
400
|
confess "problem" if ! defined $v; |
|
798
|
174
|
|
|
|
|
633
|
return ($h,$s,$v); |
|
799
|
|
|
|
|
|
|
} |
|
800
|
|
|
|
|
|
|
|
|
801
|
|
|
|
|
|
|
=pod |
|
802
|
|
|
|
|
|
|
|
|
803
|
|
|
|
|
|
|
=head1 EXPORT |
|
804
|
|
|
|
|
|
|
|
|
805
|
|
|
|
|
|
|
In addition to the object oriented interface, you can call these |
|
806
|
|
|
|
|
|
|
functions directly to obtain the color encoding. Note that any |
|
807
|
|
|
|
|
|
|
encoding options must be passed in each call. |
|
808
|
|
|
|
|
|
|
|
|
809
|
|
|
|
|
|
|
=head2 C<($r,$g,$b) = tuple_asRGB( tuple =E [$a,$b,$c])> |
|
810
|
|
|
|
|
|
|
|
|
811
|
|
|
|
|
|
|
=head2 C<($r,$g,$b) = tuple_asRGB( tuple =E [$a,$b,$c], options =E %options)> |
|
812
|
|
|
|
|
|
|
|
|
813
|
|
|
|
|
|
|
=head2 C<($r,$g,$b) = tuple_asRGB( tuple =E [$a,$b,$c], method =E $class_name)> |
|
814
|
|
|
|
|
|
|
|
|
815
|
|
|
|
|
|
|
=head2 C<($r,$g,$b) = tuple_asRGB( tuple =E [$a,$b,$c], method =E $class_name, options =E %options)> |
|
816
|
|
|
|
|
|
|
|
|
817
|
|
|
|
|
|
|
=cut |
|
818
|
|
|
|
|
|
|
|
|
819
|
|
|
|
|
|
|
sub tuple_asRGB { |
|
820
|
0
|
|
|
0
|
1
|
0
|
my @args = @_; |
|
821
|
0
|
|
|
|
|
0
|
my $self = Color::TupleEncode->new(@args); |
|
822
|
0
|
0
|
|
|
|
0
|
confess "No data values provided" if ! $self->get_tuple; |
|
823
|
0
|
|
|
|
|
0
|
return $self->as_RGB(); |
|
824
|
|
|
|
|
|
|
} |
|
825
|
|
|
|
|
|
|
|
|
826
|
|
|
|
|
|
|
=head2 C<($r,$g,$b) = tuple_asRGB255()> |
|
827
|
|
|
|
|
|
|
|
|
828
|
|
|
|
|
|
|
=head2 C<$hex = tuple_asRGBhex()> |
|
829
|
|
|
|
|
|
|
|
|
830
|
|
|
|
|
|
|
=head2 C<($h,$s,$v) = tuple_asHSV()> |
|
831
|
|
|
|
|
|
|
|
|
832
|
|
|
|
|
|
|
These functions work just like tuple_asRGB, but return the color in a different color space (e.g. RGB, HSV) or form (component or hex). |
|
833
|
|
|
|
|
|
|
|
|
834
|
|
|
|
|
|
|
=cut |
|
835
|
|
|
|
|
|
|
|
|
836
|
|
|
|
|
|
|
sub tuple_asRGB255 { |
|
837
|
36
|
|
|
36
|
1
|
111
|
my @args = @_; |
|
838
|
36
|
|
|
|
|
176
|
my $self = Color::TupleEncode->new(@args); |
|
839
|
36
|
50
|
|
|
|
131
|
confess "No data values provided" if ! $self->get_tuple; |
|
840
|
36
|
|
|
|
|
122
|
return $self->as_RGB255(); |
|
841
|
|
|
|
|
|
|
} |
|
842
|
|
|
|
|
|
|
|
|
843
|
|
|
|
|
|
|
sub tuple_asRGBhex { |
|
844
|
0
|
|
|
0
|
1
|
0
|
my @args = @_; |
|
845
|
0
|
|
|
|
|
0
|
my $self = Color::TupleEncode->new(@args); |
|
846
|
0
|
0
|
|
|
|
0
|
confess "No data values provided" if ! $self->get_tuple; |
|
847
|
0
|
|
|
|
|
0
|
return $self->as_RGBhex(); |
|
848
|
|
|
|
|
|
|
} |
|
849
|
|
|
|
|
|
|
|
|
850
|
|
|
|
|
|
|
sub tuple_asHSV { |
|
851
|
15
|
|
|
15
|
1
|
33
|
my @args = @_; |
|
852
|
15
|
|
|
|
|
39
|
my $self = Color::TupleEncode->new(@args); |
|
853
|
15
|
50
|
|
|
|
32
|
confess "No data values provided" if ! $self->get_tuple; |
|
854
|
15
|
|
|
|
|
44
|
return $self->as_HSV(); |
|
855
|
|
|
|
|
|
|
} |
|
856
|
|
|
|
|
|
|
|
|
857
|
|
|
|
|
|
|
=for comment |
|
858
|
|
|
|
|
|
|
Having defined a tuple with new() or set_tuple(), return the corresponding color value. |
|
859
|
|
|
|
|
|
|
|
|
860
|
|
|
|
|
|
|
=cut |
|
861
|
|
|
|
|
|
|
|
|
862
|
|
|
|
|
|
|
sub _get_value { |
|
863
|
174
|
|
|
174
|
|
220
|
my $self = shift; |
|
864
|
174
|
|
|
|
|
473
|
my $method = $self->get_options(-method); |
|
865
|
174
|
|
|
|
|
10443
|
my $v = eval $method.q{::_get_value($self)}; |
|
866
|
174
|
50
|
|
|
|
658
|
confess "Problem calculating value: $@" if $@; |
|
867
|
174
|
|
|
|
|
380
|
return $v; |
|
868
|
|
|
|
|
|
|
} |
|
869
|
|
|
|
|
|
|
|
|
870
|
|
|
|
|
|
|
=for comment |
|
871
|
|
|
|
|
|
|
Having defined a tuple with new() or set_tuple(), return the corresponding color saturation. |
|
872
|
|
|
|
|
|
|
|
|
873
|
|
|
|
|
|
|
=cut |
|
874
|
|
|
|
|
|
|
|
|
875
|
|
|
|
|
|
|
sub _get_saturation { |
|
876
|
174
|
|
|
174
|
|
278
|
my $self = shift; |
|
877
|
174
|
|
|
|
|
459
|
my $method = $self->get_options(-method); |
|
878
|
174
|
|
|
|
|
10805
|
my $s = eval $method.q{::_get_saturation($self)}; |
|
879
|
174
|
50
|
|
|
|
641
|
confess "Problem calculating saturation: $@" if $@; |
|
880
|
174
|
|
|
|
|
386
|
return $s; |
|
881
|
|
|
|
|
|
|
} |
|
882
|
|
|
|
|
|
|
|
|
883
|
|
|
|
|
|
|
=for comment |
|
884
|
|
|
|
|
|
|
Having defined a tuple with new() or set_tuple(), return the corresponding color hue. |
|
885
|
|
|
|
|
|
|
|
|
886
|
|
|
|
|
|
|
=cut |
|
887
|
|
|
|
|
|
|
|
|
888
|
|
|
|
|
|
|
sub _get_hue { |
|
889
|
174
|
|
|
174
|
|
215
|
my $self = shift; |
|
890
|
174
|
|
|
|
|
519
|
my $method = $self->get_options(-method); |
|
891
|
174
|
|
|
|
|
13024
|
my $h = eval $method.q{::_get_hue($self)}; |
|
892
|
174
|
50
|
|
|
|
899
|
confess "Problem calculating hue: $@" if $@; |
|
893
|
174
|
|
|
|
|
436
|
return $h; |
|
894
|
|
|
|
|
|
|
} |
|
895
|
|
|
|
|
|
|
|
|
896
|
|
|
|
|
|
|
=for comment |
|
897
|
|
|
|
|
|
|
Check that the data triplet has all values defined. A list must be passed - not a list reference! |
|
898
|
|
|
|
|
|
|
|
|
899
|
|
|
|
|
|
|
=cut |
|
900
|
|
|
|
|
|
|
|
|
901
|
|
|
|
|
|
|
sub _validate_tuple { |
|
902
|
132
|
|
|
132
|
|
228
|
my ($self,@tuple_in) = @_; |
|
903
|
132
|
|
|
|
|
182
|
my @ok_tuple; |
|
904
|
|
|
|
|
|
|
my @tuple; |
|
905
|
132
|
100
|
|
|
|
310
|
if(@tuple_in == 1) { |
|
906
|
124
|
|
|
|
|
205
|
my $tuple_in_first = $tuple_in[0]; |
|
907
|
124
|
100
|
|
|
|
331
|
if( ref( $tuple_in_first ) eq "ARRAY") { |
|
|
|
50
|
|
|
|
|
|
|
908
|
123
|
|
|
|
|
339
|
@tuple = @$tuple_in_first; |
|
909
|
|
|
|
|
|
|
} |
|
910
|
|
|
|
|
|
|
elsif ( ref( $tuple_in_first ) ) { |
|
911
|
1
|
|
|
|
|
144
|
confess "Tuple must be passed in as a list or array reference."; |
|
912
|
|
|
|
|
|
|
} |
|
913
|
|
|
|
|
|
|
else { |
|
914
|
0
|
|
|
|
|
0
|
@tuple = @tuple_in; |
|
915
|
|
|
|
|
|
|
} |
|
916
|
|
|
|
|
|
|
} |
|
917
|
|
|
|
|
|
|
else { |
|
918
|
8
|
|
|
|
|
16
|
@tuple = @tuple_in; |
|
919
|
|
|
|
|
|
|
} |
|
920
|
131
|
|
|
|
|
429
|
my $method = $self->get_options(-method); |
|
921
|
131
|
|
|
|
|
473
|
my $tuple_size = $method->_get_tuple_size(); |
|
922
|
131
|
100
|
|
|
|
301
|
if(@tuple == $tuple_size) { |
|
923
|
124
|
|
|
|
|
324
|
for my $i (0..$tuple_size-1) { |
|
924
|
332
|
100
|
|
|
|
1416
|
confess "value at index [$i] in data tuple is not defined." if ! defined $tuple[$i]; |
|
925
|
327
|
100
|
|
|
|
1132
|
confess "value at index [$i] cannot be a reference - saw $tuple[$i] which is a ".ref($tuple[$i]) if ref $tuple[$i]; |
|
926
|
324
|
100
|
|
|
|
4636
|
confess "value at index [$i] in data tuple is not a number." if $tuple[$i] !~ qr{^[-+]?[0-9]*\.?[0-9]+([eE][-+]?[0-9]+)?$}; |
|
927
|
|
|
|
|
|
|
} |
|
928
|
115
|
|
|
|
|
533
|
return @tuple; |
|
929
|
|
|
|
|
|
|
} else { |
|
930
|
7
|
|
|
|
|
1077
|
confess "Wrong number of values in tuple. Must pass exactly ",$tuple_size," values as input data, either as list reference. Saw ".int(@tuple)." values: ".join(" ",@tuple); |
|
931
|
|
|
|
|
|
|
} |
|
932
|
|
|
|
|
|
|
} |
|
933
|
|
|
|
|
|
|
|
|
934
|
|
|
|
|
|
|
=for comment |
|
935
|
|
|
|
|
|
|
Retrieve allowed and default options |
|
936
|
|
|
|
|
|
|
|
|
937
|
|
|
|
|
|
|
=cut |
|
938
|
|
|
|
|
|
|
|
|
939
|
|
|
|
|
|
|
sub _get_ok_options { |
|
940
|
3045
|
|
|
3045
|
|
3894
|
my $self = shift; |
|
941
|
3045
|
|
|
|
|
5490
|
my $method = $self->{options}{-method}; |
|
942
|
3045
|
|
|
|
|
11198
|
my @OK = ($method->_get_ok_options,@OPTIONS_OK); |
|
943
|
3045
|
|
|
|
|
109616
|
return @OK; |
|
944
|
|
|
|
|
|
|
} |
|
945
|
|
|
|
|
|
|
|
|
946
|
|
|
|
|
|
|
sub _get_implementation_ok_options { |
|
947
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
|
948
|
0
|
|
|
|
|
0
|
my $method = $self->{options}{-method}; |
|
949
|
0
|
|
|
|
|
0
|
my @OK = $method->_get_ok_options; |
|
950
|
0
|
|
|
|
|
0
|
return @OK; |
|
951
|
|
|
|
|
|
|
} |
|
952
|
|
|
|
|
|
|
|
|
953
|
|
|
|
|
|
|
sub _get_default_options { |
|
954
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
|
955
|
0
|
|
|
|
|
0
|
my $method = $self->{options}{-method}; |
|
956
|
0
|
|
|
|
|
0
|
my %DEF = (%OPTIONS_DEFAULT,$method->_get_default_options); |
|
957
|
0
|
|
|
|
|
0
|
return \%DEF; |
|
958
|
|
|
|
|
|
|
} |
|
959
|
|
|
|
|
|
|
sub _get_implementation_default_options { |
|
960
|
146
|
|
|
146
|
|
199
|
my $self = shift; |
|
961
|
146
|
|
|
|
|
300
|
my $method = $self->{options}{-method}; |
|
962
|
146
|
|
|
|
|
447
|
my %DEF = $method->_get_default_options; |
|
963
|
146
|
|
|
|
|
5728
|
return \%DEF; |
|
964
|
|
|
|
|
|
|
} |
|
965
|
|
|
|
|
|
|
|
|
966
|
|
|
|
|
|
|
=pod |
|
967
|
|
|
|
|
|
|
|
|
968
|
|
|
|
|
|
|
=head1 IMPLEMENTING AN ENCODING CLASS |
|
969
|
|
|
|
|
|
|
|
|
970
|
|
|
|
|
|
|
=head2 Required Functions |
|
971
|
|
|
|
|
|
|
|
|
972
|
|
|
|
|
|
|
It is assumed that the encoding utility class will implement the following functions. |
|
973
|
|
|
|
|
|
|
|
|
974
|
|
|
|
|
|
|
=over |
|
975
|
|
|
|
|
|
|
|
|
976
|
|
|
|
|
|
|
=item C<_get_hue()> |
|
977
|
|
|
|
|
|
|
|
|
978
|
|
|
|
|
|
|
=item C<_get_saturation()> |
|
979
|
|
|
|
|
|
|
|
|
980
|
|
|
|
|
|
|
=item C<_get_value()> |
|
981
|
|
|
|
|
|
|
|
|
982
|
|
|
|
|
|
|
=back |
|
983
|
|
|
|
|
|
|
|
|
984
|
|
|
|
|
|
|
Encodings must be done from a tuple to HSV color space. HSV is a |
|
985
|
|
|
|
|
|
|
natural choice because it is possible to visually identify individual |
|
986
|
|
|
|
|
|
|
H,S,V components of a color (e.g. orage saturated dark). On the other |
|
987
|
|
|
|
|
|
|
hand, doing so in RGB is very difficult (what is the R,G,B |
|
988
|
|
|
|
|
|
|
decomposition of a dark desaturated orange?). |
|
989
|
|
|
|
|
|
|
|
|
990
|
|
|
|
|
|
|
Each of these functions should be implemented as follows. For example, C<_get_saturation> |
|
991
|
|
|
|
|
|
|
|
|
992
|
|
|
|
|
|
|
sub _get_saturation { |
|
993
|
|
|
|
|
|
|
# obtain the Color::TupleEncode object |
|
994
|
|
|
|
|
|
|
my $self = shift; |
|
995
|
|
|
|
|
|
|
# extract data tuple |
|
996
|
|
|
|
|
|
|
my (@tuple) = $self->get_tuple; |
|
997
|
|
|
|
|
|
|
my $saturation; |
|
998
|
|
|
|
|
|
|
... now use @tuple to define $saturation |
|
999
|
|
|
|
|
|
|
return $saturation; |
|
1000
|
|
|
|
|
|
|
} |
|
1001
|
|
|
|
|
|
|
|
|
1002
|
|
|
|
|
|
|
=over |
|
1003
|
|
|
|
|
|
|
|
|
1004
|
|
|
|
|
|
|
=item C<_get_tuple_size()> |
|
1005
|
|
|
|
|
|
|
|
|
1006
|
|
|
|
|
|
|
=back |
|
1007
|
|
|
|
|
|
|
|
|
1008
|
|
|
|
|
|
|
This function returns the size of the tuple used by the encoding. You |
|
1009
|
|
|
|
|
|
|
can implement this as follows, |
|
1010
|
|
|
|
|
|
|
|
|
1011
|
|
|
|
|
|
|
Readonly::Scalar our $TUPLE_SIZE => 3; |
|
1012
|
|
|
|
|
|
|
|
|
1013
|
|
|
|
|
|
|
sub _get_tuple_size { |
|
1014
|
|
|
|
|
|
|
return $TUPLE_SIZE; |
|
1015
|
|
|
|
|
|
|
} |
|
1016
|
|
|
|
|
|
|
|
|
1017
|
|
|
|
|
|
|
=over |
|
1018
|
|
|
|
|
|
|
|
|
1019
|
|
|
|
|
|
|
=item C<_get_ok_options()> |
|
1020
|
|
|
|
|
|
|
|
|
1021
|
|
|
|
|
|
|
=item C<_get_default_options()> |
|
1022
|
|
|
|
|
|
|
|
|
1023
|
|
|
|
|
|
|
=back |
|
1024
|
|
|
|
|
|
|
|
|
1025
|
|
|
|
|
|
|
You must define a package variable C<@OPTIONS_OK>, which lists all |
|
1026
|
|
|
|
|
|
|
acceptable options for this encoding. Any options you wish to be set |
|
1027
|
|
|
|
|
|
|
by default when this method is initially set should be in C<%OPTIONS_DEFAULT>. |
|
1028
|
|
|
|
|
|
|
|
|
1029
|
|
|
|
|
|
|
For example, |
|
1030
|
|
|
|
|
|
|
|
|
1031
|
|
|
|
|
|
|
Readonly::Array our @OPTIONS_OK => |
|
1032
|
|
|
|
|
|
|
(qw(-ha -hb -hc -saturation -value)); |
|
1033
|
|
|
|
|
|
|
|
|
1034
|
|
|
|
|
|
|
Readonly::Hash our %OPTIONS_DEFAULT => |
|
1035
|
|
|
|
|
|
|
(-ha=>0,-hb=>120,-hc=>240,-saturation=>{dmin=>0,dmax=>1}); |
|
1036
|
|
|
|
|
|
|
|
|
1037
|
|
|
|
|
|
|
Two functions provice access to these variables |
|
1038
|
|
|
|
|
|
|
|
|
1039
|
|
|
|
|
|
|
sub _get_ok_options { |
|
1040
|
|
|
|
|
|
|
return @OPTIONS_OK; |
|
1041
|
|
|
|
|
|
|
} |
|
1042
|
|
|
|
|
|
|
|
|
1043
|
|
|
|
|
|
|
sub _get_default_options { |
|
1044
|
|
|
|
|
|
|
return %OPTIONS_DEFAULT; |
|
1045
|
|
|
|
|
|
|
} |
|
1046
|
|
|
|
|
|
|
|
|
1047
|
|
|
|
|
|
|
=head2 Using Your Implementation |
|
1048
|
|
|
|
|
|
|
|
|
1049
|
|
|
|
|
|
|
See the example files with this distribution |
|
1050
|
|
|
|
|
|
|
|
|
1051
|
|
|
|
|
|
|
# uses Color::TupleEncode::2Way |
|
1052
|
|
|
|
|
|
|
> examples/example-2way |
|
1053
|
|
|
|
|
|
|
|
|
1054
|
|
|
|
|
|
|
# uses Color::TupleEncode::Baran |
|
1055
|
|
|
|
|
|
|
> examples/example-3way |
|
1056
|
|
|
|
|
|
|
|
|
1057
|
|
|
|
|
|
|
of how to go about using your implementation. |
|
1058
|
|
|
|
|
|
|
|
|
1059
|
|
|
|
|
|
|
For example, if you have created C, which |
|
1060
|
|
|
|
|
|
|
encodes 4-tuples, then you would use it thus |
|
1061
|
|
|
|
|
|
|
|
|
1062
|
|
|
|
|
|
|
use Color::TupleEncode; |
|
1063
|
|
|
|
|
|
|
use Color::TupleEncode::4Way; |
|
1064
|
|
|
|
|
|
|
|
|
1065
|
|
|
|
|
|
|
# set the method to your implementation |
|
1066
|
|
|
|
|
|
|
$encoder = Color::TupleEncode->new(method=>"Color::TupleEncode::4Way"); |
|
1067
|
|
|
|
|
|
|
|
|
1068
|
|
|
|
|
|
|
# set any options for your implementation |
|
1069
|
|
|
|
|
|
|
$encoder->set-options(-option1=>1,-option2=>10) |
|
1070
|
|
|
|
|
|
|
|
|
1071
|
|
|
|
|
|
|
# encode |
|
1072
|
|
|
|
|
|
|
($h,$s,$v) = $encoder->as_HSV(1,2,3,4); |
|
1073
|
|
|
|
|
|
|
|
|
1074
|
|
|
|
|
|
|
=head1 AUTHOR |
|
1075
|
|
|
|
|
|
|
|
|
1076
|
|
|
|
|
|
|
Martin Krzywinski, C<< >> |
|
1077
|
|
|
|
|
|
|
|
|
1078
|
|
|
|
|
|
|
=head1 BUGS |
|
1079
|
|
|
|
|
|
|
|
|
1080
|
|
|
|
|
|
|
Please report any bugs or feature requests to C, or through |
|
1081
|
|
|
|
|
|
|
the web interface at L. I will be notified, and then you'll |
|
1082
|
|
|
|
|
|
|
automatically be notified of progress on your bug as I make changes. |
|
1083
|
|
|
|
|
|
|
|
|
1084
|
|
|
|
|
|
|
=head1 SUPPORT |
|
1085
|
|
|
|
|
|
|
|
|
1086
|
|
|
|
|
|
|
You can find documentation for this module with the perldoc command. |
|
1087
|
|
|
|
|
|
|
|
|
1088
|
|
|
|
|
|
|
perldoc Color::TupleEncode |
|
1089
|
|
|
|
|
|
|
|
|
1090
|
|
|
|
|
|
|
You can also look for information at: |
|
1091
|
|
|
|
|
|
|
|
|
1092
|
|
|
|
|
|
|
=over 4 |
|
1093
|
|
|
|
|
|
|
|
|
1094
|
|
|
|
|
|
|
=item * RT: CPAN's request tracker |
|
1095
|
|
|
|
|
|
|
|
|
1096
|
|
|
|
|
|
|
L |
|
1097
|
|
|
|
|
|
|
|
|
1098
|
|
|
|
|
|
|
=item * AnnoCPAN: Annotated CPAN documentation |
|
1099
|
|
|
|
|
|
|
|
|
1100
|
|
|
|
|
|
|
L |
|
1101
|
|
|
|
|
|
|
|
|
1102
|
|
|
|
|
|
|
=item * CPAN Ratings |
|
1103
|
|
|
|
|
|
|
|
|
1104
|
|
|
|
|
|
|
L |
|
1105
|
|
|
|
|
|
|
|
|
1106
|
|
|
|
|
|
|
=item * Search CPAN |
|
1107
|
|
|
|
|
|
|
|
|
1108
|
|
|
|
|
|
|
L |
|
1109
|
|
|
|
|
|
|
|
|
1110
|
|
|
|
|
|
|
=back |
|
1111
|
|
|
|
|
|
|
|
|
1112
|
|
|
|
|
|
|
=head1 SEE ALSO |
|
1113
|
|
|
|
|
|
|
|
|
1114
|
|
|
|
|
|
|
L for converting colors between color spaces. |
|
1115
|
|
|
|
|
|
|
|
|
1116
|
|
|
|
|
|
|
L for the 3-tuple encoding (by I). |
|
1117
|
|
|
|
|
|
|
|
|
1118
|
|
|
|
|
|
|
L for the 2-tuple encoding (by Author). |
|
1119
|
|
|
|
|
|
|
|
|
1120
|
|
|
|
|
|
|
=head1 ACKNOWLEDGEMENTS |
|
1121
|
|
|
|
|
|
|
|
|
1122
|
|
|
|
|
|
|
For details about the color encoding, see |
|
1123
|
|
|
|
|
|
|
|
|
1124
|
|
|
|
|
|
|
=over |
|
1125
|
|
|
|
|
|
|
|
|
1126
|
|
|
|
|
|
|
=item Color::TupleEncode::Baran |
|
1127
|
|
|
|
|
|
|
|
|
1128
|
|
|
|
|
|
|
Encodes a 3-tuple to a color using the scheme described in |
|
1129
|
|
|
|
|
|
|
|
|
1130
|
|
|
|
|
|
|
Visualization of three-way comparisons of omics data |
|
1131
|
|
|
|
|
|
|
Richard Baran Martin Robert, Makoto Suematsu, Tomoyoshi Soga and Masaru Tomita |
|
1132
|
|
|
|
|
|
|
BMC Bioinformatics 2007, 8:72 doi:10.1186/1471-2105-8-72 |
|
1133
|
|
|
|
|
|
|
|
|
1134
|
|
|
|
|
|
|
This publication can be accessed at L |
|
1135
|
|
|
|
|
|
|
|
|
1136
|
|
|
|
|
|
|
=back |
|
1137
|
|
|
|
|
|
|
|
|
1138
|
|
|
|
|
|
|
=head1 LICENSE AND COPYRIGHT |
|
1139
|
|
|
|
|
|
|
|
|
1140
|
|
|
|
|
|
|
Copyright 2010 Martin Krzywinski. |
|
1141
|
|
|
|
|
|
|
|
|
1142
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it |
|
1143
|
|
|
|
|
|
|
under the terms of either: the GNU General Public License as published |
|
1144
|
|
|
|
|
|
|
by the Free Software Foundation; or the Artistic License. |
|
1145
|
|
|
|
|
|
|
|
|
1146
|
|
|
|
|
|
|
See http://dev.perl.org/licenses/ for more information. |
|
1147
|
|
|
|
|
|
|
|
|
1148
|
|
|
|
|
|
|
=cut |
|
1149
|
|
|
|
|
|
|
|
|
1150
|
|
|
|
|
|
|
1; # End of Color::TupleEncode |