lib/Imager/Fountain.pm

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