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