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 |