- fix spelling errors patched by Debian (please report the issues you
[imager.git] / lib / Imager / Fountain.pm
CommitLineData
6607600c
TC
1package Imager::Fountain;
2use strict;
3use Imager::Color::Float;
f17b46d8
TC
4use vars qw($VERSION);
5
12e92882 6$VERSION = "1.006";
6607600c
TC
7
8=head1 NAME
9
10 Imager::Fountain - a class for building fountain fills suitable for use by
11 the fountain filter.
12
13=head1 SYNOPSIS
14
15 use Imager::Fountain;
16 my $f1 = Imager::Fountain->read(gimp=>$filename);
17 $f->write(gimp=>$filename);
18 my $f1 = Imager::Fountain->new;
19 $f1->add(start=>0, middle=>0.5, end=>1.0,
20 c0=>Imager::Color->new(...),
21 c1=>Imager::Color->new(...),
22 type=>$trans_type, color=>$color_trans_type);
23
24=head1 DESCRIPTION
25
26Provide an interface to build arrays suitable for use by the Imager
27fountain filter. These can be loaded from or saved to a GIMP gradient
28file or you can build them from scratch.
29
30=over
31
32=item read(gimp=>$filename)
33
817ba871
TC
34=item read(gimp=>$filename, name=>\$name)
35
36Loads a gradient from the given GIMP gradient file, and returns a
37new Imager::Fountain object.
38
39If the name parameter is supplied as a scalar reference then any name
40field from newer GIMP gradient files will be returned in it.
41
42 my $gradient = Imager::Fountain->read(gimp=>'foo.ggr');
43 my $name;
44 my $gradient2 = Imager::Fountain->read(gimp=>'bar.ggr', name=>\$name);
6607600c
TC
45
46=cut
47
48sub read {
49 my ($class, %opts) = @_;
50
51 if ($opts{gimp}) {
52 my $fh;
53 $fh = ref($opts{gimp}) ? $opts{gimp} : IO::File->new($opts{gimp});
54 unless ($fh) {
55 $Imager::ERRSTR = "Cannot open $opts{gimp}: $!";
56 return;
57 }
58
817ba871
TC
59 my $trash_name;
60 my $name_ref = $opts{name} && ref $opts{name} ? $opts{name} : \$trash_name;
61
62 return $class->_load_gimp_gradient($fh, $opts{gimp}, $name_ref);
6607600c
TC
63 }
64 else {
65 warn "$class::read: Nothing to do!";
66 return;
67 }
68}
69
70=item write(gimp=>$filename)
71
817ba871
TC
72=item write(gimp=>$filename, name=>$name)
73
6607600c
TC
74Save the gradient to a GIMP gradient file.
75
817ba871
TC
76The second variant allows the gradient name to be set (for newer
77versions of the GIMP).
78
79 $gradient->write(gimp=>'foo.ggr')
80 or die Imager->errstr;
81 $gradient->write(gimp=>'bar.ggr', name=>'the bar gradient')
82 or die Imager->errstr;
83
6607600c
TC
84=cut
85
86sub write {
87 my ($self, %opts) = @_;
88
89 if ($opts{gimp}) {
90 my $fh;
91 $fh = ref($opts{gimp}) ? $opts{gimp} : IO::File->new("> ".$opts{gimp});
92 unless ($fh) {
93 $Imager::ERRSTR = "Cannot open $opts{gimp}: $!";
94 return;
95 }
96
817ba871 97 return $self->_save_gimp_gradient($fh, $opts{gimp}, $opts{name});
6607600c
TC
98 }
99 else {
100 warn "Nothing to do\n";
101 return;
102 }
103}
104
105=item new
106
107Create an empty fountain fill description.
108
109=cut
110
111sub new {
112 my ($class) = @_;
113
114 return bless [], $class;
115}
116
117sub _first {
118 for (@_) {
119 return $_ if defined;
120 }
121 return undef;
122}
123
124=item add(start=>$start, middle=>$middle, end=>1.0, c0=>$start_color, c1=>$end_color, type=>$trans_type, color=>$color_trans_type)
125
126Adds a new segment to the fountain fill, the possible options are:
127
128=over
129
130=item start
131
132The start position in the gradient where this segment
133takes effect between 0 and 1. Default: 0.
134
135=item middle
136
137The mid-point of the transition between the 2
138colors, between 0 and 1. Default: average of I<start> and I<end>.
139
140=item end
141
142The end of the gradient, from 0 to 1. Default: 1.
143
144=item c0
145
146The color of the fountain fill where the fill parameter is equal
147to I<start>. Default: opaque black.
148
149=item c1
150
151The color of the fountain fill where the fill parameter is equal to
152I<end>. Default: opaque black.
153
154=item type
155
156The type of segment, controls the way in which the fill parameter
157moves from 0 to 1. Default: linear.
158
159This can take any of the following values:
160
161=over
162
163=item linear
164
165=item curved
166
167Unimplemented so far.
168
169=item sine
170
171=item sphereup
172
173=item spheredown
174
175=back
176
177=item color
178
179The way in which the color transitions between I<c0> and I<c1>.
180Default: direct.
181
182This can take any of the following values:
183
184=over
185
186=item direct
187
188Each channel is simple scaled between c0 and c1.
189
9b1ec2b8 190=item hueup
6607600c
TC
191
192The color is converted to a HSV value and the scaling is done such
193that the hue increases as the fill parameter increases.
194
9b1ec2b8 195=item huedown
6607600c
TC
196
197The color is converted to a HSV value and the scaling is done such
198that the hue decreases as the fill parameter increases.
199
200=back
201
202=back
203
204In most cases you can ignore some of the arguments, eg.
205
206 # assuming $f is a new Imager::Fountain in each case here
207 use Imager ':handy';
208 # simple transition from red to blue
12e92882 209 $f->add(c0=>NC('#FF0000'), c1=>NC('#0000FF'));
6607600c
TC
210 # simple 2 stages from red to green to blue
211 $f->add(end=>0.5, c0=>NC('#FF0000'), c1=>NC('#00FF00'))
caf1c836 212 $f->add(start=>0.5, c0=>NC('#00FF00'), c1=>NC('#0000FF'));
6607600c
TC
213
214=cut
215
216# used to translate segment types and color transition types to numbers
217my %type_names =
218 (
219 linear => 0,
220 curved => 1,
221 sine => 2,
222 sphereup=> 3,
223 spheredown => 4,
224 );
225
226my %color_names =
227 (
228 direct => 0,
229 hueup => 1,
230 huedown => 2
231 );
232
233sub add {
234 my ($self, %opts) = @_;
235
236 my $start = _first($opts{start}, 0);
237 my $end = _first($opts{end}, 1);
238 my $middle = _first($opts{middle}, ($start+$end)/2);
239 my @row =
240 (
241 $start, $middle, $end,
242 _first($opts{c0}, Imager::Color::Float->new(0,0,0,1)),
243 _first($opts{c1}, Imager::Color::Float->new(1,1,1,0)),
244 _first($opts{type} && $type_names{$opts{type}}, $opts{type}, 0),
245 _first($opts{color} && $color_names{$opts{color}}, $opts{color}, 0)
246 );
247 push(@$self, \@row);
248
249 $self;
250}
251
252=item simple(positions=>[ ... ], colors=>[...])
253
254Creates a simple fountain fill object consisting of linear segments.
255
256The arrayrefs passed as positions and colors must have the same number
257of elements. They must have at least 2 elements each.
258
259colors must contain Imager::Color or Imager::Color::Float objects.
260
261eg.
262
263 my $f = Imager::Fountain->simple(positions=>[0, 0.2, 1.0],
264 colors=>[ NC(255,0,0), NC(0,255,0),
265 NC(0,0,255) ]);
266
267=cut
268
269sub simple {
270 my ($class, %opts) = @_;
271
272 if ($opts{positions} && $opts{colors}) {
273 my $positions = $opts{positions};
274 my $colors = $opts{colors};
275 unless (@$positions == @$colors) {
276 $Imager::ERRSTR = "positions and colors must be the same size";
277 return;
278 }
279 unless (@$positions >= 2) {
280 $Imager::ERRSTR = "not enough segments";
281 return;
282 }
283 my $f = $class->new;
284 for my $i (0.. $#$colors-1) {
285 $f->add(start=>$positions->[$i], end=>$positions->[$i+1],
286 c0 => $colors->[$i], c1=>$colors->[$i+1]);
287 }
e119b16c 288 return $f;
6607600c
TC
289 }
290 else {
291 warn "Nothing to do";
292 return;
293 }
294}
295
296=back
297
298=head2 Implementation Functions
299
300Documented for internal use.
301
302=over
303
304=item _load_gimp_gradient($class, $fh, $name)
305
306Does the work of loading a GIMP gradient file.
307
308=cut
309
310sub _load_gimp_gradient {
817ba871 311 my ($class, $fh, $filename, $name) = @_;
6607600c
TC
312
313 my $head = <$fh>;
314 chomp $head;
315 unless ($head eq 'GIMP Gradient') {
817ba871 316 $Imager::ERRSTR = "$filename is not a GIMP gradient file";
6607600c
TC
317 return;
318 }
319 my $count = <$fh>;
320 chomp $count;
817ba871
TC
321 if ($count =~ /^name:\s?(.*)/i) {
322 ref $name and $$name = $1;
323 $count = <$fh>; # try again
cfa61c80 324 chomp $count;
817ba871 325 }
cfa61c80 326 unless ($count =~ /^\d+$/) {
817ba871 327 $Imager::ERRSTR = "$filename is missing the segment count";
6607600c
TC
328 return;
329 }
330 my @result;
331 for my $i (1..$count) {
332 my $row = <$fh>;
333 chomp $row;
334 my @row = split ' ', $row;
335 unless (@row == 13) {
336 $Imager::ERRSTR = "Bad segment definition";
337 return;
338 }
339 my ($start, $middle, $end) = splice(@row, 0, 3);
340 my $c0 = Imager::Color::Float->new(splice(@row, 0, 4));
341 my $c1 = Imager::Color::Float->new(splice(@row, 0, 4));
342 my ($type, $color) = @row;
343 push(@result, [ $start, $middle, $end, $c0, $c1, $type, $color ]);
344 }
345 return bless \@result,
346}
347
348=item _save_gimp_gradient($self, $fh, $name)
349
350Does the work of saving to a GIMP gradient file.
351
352=cut
353
354sub _save_gimp_gradient {
817ba871 355 my ($self, $fh, $filename, $name) = @_;
6607600c
TC
356
357 print $fh "GIMP Gradient\n";
817ba871
TC
358 defined $name or $name = '';
359 $name =~ tr/ -~/ /cds;
360 if ($name) {
361 print $fh "Name: $name\n";
362 }
6607600c
TC
363 print $fh scalar(@$self),"\n";
364 for my $row (@$self) {
365 printf $fh "%.6f %.6f %.6f ",@{$row}[0..2];
366 for my $i (0, 1) {
367 for ($row->[3+$i]->rgba) {
817ba871 368 printf $fh "%.6f ", $_/255.0;
6607600c
TC
369 }
370 }
817ba871 371 print $fh "@{$row}[5,6]";
6607600c
TC
372 unless (print $fh "\n") {
373 $Imager::ERRSTR = "write error: $!";
374 return;
375 }
376 }
377
378 return 1;
379}
380
381=back
382
383=head1 FILL PARAMETER
384
385The add() documentation mentions a fill parameter in a few places,
386this is as good a place as any to discuss it.
387
388The process of deciding the color produced by the gradient works
389through the following steps:
390
391=over
392
393=item 1.
394
395calculate the base value, which is typically a distance or an angle of
396some sort. This can be positive or occasinally negative, depending on
397the type of fill being performed (linear, radial, etc).
398
399=item 2.
400
401clamp or convert the base value to the range 0 through 1, how this is
402done depends on the repeat parameter. I'm calling this result the
403fill parameter.
404
405=item 3.
406
407the appropriate segment is found. This is currently done with a
408linear search, and the first matching segment is used. If there is no
409matching segment the pixel is not touched.
410
5cb9270b 411=item 4.
6607600c
TC
412
413the fill parameter is scaled from 0 to 1 depending on the segment type.
414
5cb9270b 415=item 5.
6607600c
TC
416
417the color produced, depending on the segment color type.
418
419=back
420
421=head1 AUTHOR
422
423Tony Cook <tony@develop-help.com>
424
425=head1 SEE ALSO
426
427Imager(3)
428
429=cut