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