summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Imager/Fountain.pm
blob: 72d0b8a204223eeb595c80c723d214883cf0b7e5 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
package Imager::Fountain;
use strict;
use Imager::Color::Float;
use vars qw($VERSION);

$VERSION = "1.006";

=head1 NAME

  Imager::Fountain - a class for building fountain fills suitable for use by
 the fountain filter.

=head1 SYNOPSIS

  use Imager::Fountain;
  my $f1 = Imager::Fountain->read(gimp=>$filename);
  $f->write(gimp=>$filename);
  my $f1 = Imager::Fountain->new;
  $f1->add(start=>0, middle=>0.5, end=>1.0,
           c0=>Imager::Color->new(...),
           c1=>Imager::Color->new(...),
           type=>$trans_type, color=>$color_trans_type);

=head1 DESCRIPTION

Provide an interface to build arrays suitable for use by the Imager
fountain filter.  These can be loaded from or saved to a GIMP gradient
file or you can build them from scratch.

=over

=item read(gimp=>$filename)

=item read(gimp=>$filename, name=>\$name)

Loads a gradient from the given GIMP gradient file, and returns a
new Imager::Fountain object.

If the name parameter is supplied as a scalar reference then any name
field from newer GIMP gradient files will be returned in it.

  my $gradient = Imager::Fountain->read(gimp=>'foo.ggr');
  my $name;
  my $gradient2 = Imager::Fountain->read(gimp=>'bar.ggr', name=>\$name);

=cut

sub read {
  my ($class, %opts) = @_;

  if ($opts{gimp}) {
    my $fh;
    $fh = ref($opts{gimp}) ? $opts{gimp} : IO::File->new($opts{gimp});
    unless ($fh) {
      $Imager::ERRSTR = "Cannot open $opts{gimp}: $!";
      return;
    }

    my $trash_name;
    my $name_ref = $opts{name} && ref $opts{name} ? $opts{name} : \$trash_name;

    return $class->_load_gimp_gradient($fh, $opts{gimp}, $name_ref);
  }
  else {
    warn "$class::read: Nothing to do!";
    return;
  }
}

=item write(gimp=>$filename)

=item write(gimp=>$filename, name=>$name)

Save the gradient to a GIMP gradient file.

The second variant allows the gradient name to be set (for newer
versions of the GIMP).

  $gradient->write(gimp=>'foo.ggr')
    or die Imager->errstr;
  $gradient->write(gimp=>'bar.ggr', name=>'the bar gradient')
    or die Imager->errstr;

=cut

sub write {
  my ($self, %opts) = @_;

  if ($opts{gimp}) {
    my $fh;
    $fh = ref($opts{gimp}) ? $opts{gimp} : IO::File->new("> ".$opts{gimp});
    unless ($fh) {
      $Imager::ERRSTR = "Cannot open $opts{gimp}: $!";
      return;
    }

    return $self->_save_gimp_gradient($fh, $opts{gimp}, $opts{name});
  }
  else {
    warn "Nothing to do\n";
    return;
  }
}

=item new

Create an empty fountain fill description.

=cut

sub new {
  my ($class) = @_;

  return bless [], $class;
}

sub _first {
  for (@_) {
    return $_ if defined;
  }
  return undef;
}

=item add(start=>$start, middle=>$middle, end=>1.0, c0=>$start_color, c1=>$end_color, type=>$trans_type, color=>$color_trans_type)

Adds a new segment to the fountain fill, the possible options are:

=over

=item start

The start position in the gradient where this segment
takes effect between 0 and 1.  Default: 0.

=item middle

The mid-point of the transition between the 2
colors, between 0 and 1.  Default: average of I<start> and I<end>.

=item end

The end of the gradient, from 0 to 1.  Default: 1.

=item c0

The color of the fountain fill where the fill parameter is equal
to I<start>.  Default: opaque black.

=item c1

The color of the fountain fill where the fill parameter is equal to
I<end>.  Default: opaque black.

=item type

The type of segment, controls the way in which the fill parameter
moves from 0 to 1.  Default: linear.

This can take any of the following values:

=over

=item linear

=item curved

Unimplemented so far.

=item sine

=item sphereup

=item spheredown

=back

=item color

The way in which the color transitions between I<c0> and I<c1>.
Default: direct.

This can take any of the following values:

=over

=item direct

Each channel is simple scaled between c0 and c1.

=item hueup

The color is converted to a HSV value and the scaling is done such
that the hue increases as the fill parameter increases.

=item huedown

The color is converted to a HSV value and the scaling is done such
that the hue decreases as the fill parameter increases.

=back

=back

In most cases you can ignore some of the arguments, eg.

  # assuming $f is a new Imager::Fountain in each case here
  use Imager ':handy';
  # simple transition from red to blue
  $f->add(c0=>NC('#FF0000'), c1=>NC('#0000FF'));
  # simple 2 stages from red to green to blue
  $f->add(end=>0.5, c0=>NC('#FF0000'), c1=>NC('#00FF00'))
  $f->add(start=>0.5, c0=>NC('#00FF00'), c1=>NC('#0000FF'));

=cut

# used to translate segment types and color transition types to numbers
my %type_names =
  (
   linear => 0,
   curved => 1,
   sine => 2,
   sphereup=> 3,
   spheredown => 4,
  );

my %color_names =
  (
   direct => 0,
   hueup => 1,
   huedown => 2
  );

sub add {
  my ($self, %opts) = @_;

  my $start = _first($opts{start}, 0);
  my $end = _first($opts{end}, 1);
  my $middle = _first($opts{middle}, ($start+$end)/2);
  my @row =
    (
     $start, $middle, $end,
     _first($opts{c0}, Imager::Color::Float->new(0,0,0,1)),
     _first($opts{c1}, Imager::Color::Float->new(1,1,1,0)),
     _first($opts{type} && $type_names{$opts{type}}, $opts{type}, 0),
     _first($opts{color} && $color_names{$opts{color}}, $opts{color}, 0)
    );
  push(@$self, \@row);

  $self;
}

=item simple(positions=>[ ... ], colors=>[...])

Creates a simple fountain fill object consisting of linear segments.

The arrayrefs passed as positions and colors must have the same number
of elements.  They must have at least 2 elements each.

colors must contain Imager::Color or Imager::Color::Float objects.

eg.

  my $f = Imager::Fountain->simple(positions=>[0, 0.2, 1.0],
                                   colors=>[ NC(255,0,0), NC(0,255,0), 
                                             NC(0,0,255) ]);

=cut

sub simple {
  my ($class, %opts) = @_;

  if ($opts{positions} && $opts{colors}) {
    my $positions = $opts{positions};
    my $colors = $opts{colors};
    unless (@$positions == @$colors) {
      $Imager::ERRSTR = "positions and colors must be the same size";
      return;
    }
    unless (@$positions >= 2) {
      $Imager::ERRSTR = "not enough segments";
      return;
    }
    my $f = $class->new;
    for my $i (0.. $#$colors-1) {
      $f->add(start=>$positions->[$i], end=>$positions->[$i+1],
              c0 => $colors->[$i], c1=>$colors->[$i+1]);
    }
    return $f;
  }
  else {
    warn "Nothing to do";
    return;
  }
}

=back

=head2 Implementation Functions

Documented for internal use.

=over

=item _load_gimp_gradient($class, $fh, $name)

Does the work of loading a GIMP gradient file.

=cut

sub _load_gimp_gradient {
  my ($class, $fh, $filename, $name) = @_;

  my $head = <$fh>;
  chomp $head;
  unless ($head eq 'GIMP Gradient') {
    $Imager::ERRSTR = "$filename is not a GIMP gradient file";
    return;
  }
  my $count = <$fh>;
  chomp $count;
  if ($count =~ /^name:\s?(.*)/i) {
    ref $name and $$name = $1;
    $count = <$fh>; # try again
    chomp $count;
  }
  unless ($count =~ /^\d+$/) {
    $Imager::ERRSTR = "$filename is missing the segment count";
    return;
  }
  my @result;
  for my $i (1..$count) {
    my $row = <$fh>;
    chomp $row;
    my @row = split ' ', $row;
    unless (@row == 13) {
      $Imager::ERRSTR = "Bad segment definition";
      return;
    }
    my ($start, $middle, $end) = splice(@row, 0, 3);
    my $c0 = Imager::Color::Float->new(splice(@row, 0, 4));
    my $c1 = Imager::Color::Float->new(splice(@row, 0, 4));
    my ($type, $color) = @row;
    push(@result, [ $start, $middle, $end, $c0, $c1, $type, $color ]);
  }
  return bless \@result, 
}

=item _save_gimp_gradient($self, $fh, $name)

Does the work of saving to a GIMP gradient file.

=cut

sub _save_gimp_gradient {
  my ($self, $fh, $filename, $name) = @_;

  print $fh "GIMP Gradient\n";
  defined $name or $name = '';
  $name =~ tr/ -~/ /cds;
  if ($name) {
    print $fh "Name: $name\n";
  }
  print $fh scalar(@$self),"\n";
  for my $row (@$self) {
    printf $fh "%.6f %.6f %.6f ",@{$row}[0..2];
    for my $i (0, 1) {
      for ($row->[3+$i]->rgba) {
        printf $fh "%.6f ", $_/255.0;
      }
    }
    print $fh "@{$row}[5,6]";
    unless (print $fh "\n") {
      $Imager::ERRSTR = "write error: $!";
      return;
    }
  }

  return 1;
}

=back

=head1 FILL PARAMETER

The add() documentation mentions a fill parameter in a few places,
this is as good a place as any to discuss it.

The process of deciding the color produced by the gradient works
through the following steps:

=over

=item 1.

calculate the base value, which is typically a distance or an angle of
some sort.  This can be positive or occasinally negative, depending on
the type of fill being performed (linear, radial, etc).

=item 2.

clamp or convert the base value to the range 0 through 1, how this is
done depends on the repeat parameter.  I'm calling this result the
fill parameter.

=item 3.

the appropriate segment is found.  This is currently done with a
linear search, and the first matching segment is used.  If there is no
matching segment the pixel is not touched.

=item 4.

the fill parameter is scaled from 0 to 1 depending on the segment type.

=item 5.

the color produced, depending on the segment color type.

=back

=head1 AUTHOR

Tony Cook <tony@develop-help.com>

=head1 SEE ALSO

Imager(3)

=cut