lib/Imager/Fountain.pm

   1 package Imager::Fountain;
   2 use strict;
   3 use Imager::Color::Float;
   4 use vars qw($VERSION);
   5
   6 $VERSION = "1.005";
   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 start
 131
 132 The start position in the gradient where this segment
 133 takes effect between 0 and 1.  Default: 0.
 134
 135 =item middle
 136
 137 The mid-point of the transition between the 2
 138 colors, between 0 and 1.  Default: average of I<start> and I<end>.
 139
 140 =item end
 141
 142 The end of the gradient, from 0 to 1.  Default: 1.
 143
 144 =item c0
 145
 146 The color of the fountain fill where the fill parameter is equal
 147 to I<start>.  Default: opaque black.
 148
 149 =item c1
 150
 151 The color of the fountain fill where the fill parameter is equal to
 152 I<end>.  Default: opaque black.
 153
 154 =item type
 155
 156 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 linear
 164
 165 =item curved
 166
 167 Unimplemented so far.
 168
 169 =item sine
 170
 171 =item sphereup
 172
 173 =item spheredown
 174
 175 =back
 176
 177 =item color
 178
 179 The way in which the color transitions between I<c0> and I<c1>.
 180 Default: direct.
 181
 182 This can take any of the following values:
 183
 184 =over
 185
 186 =item direct
 187
 188 Each channel is simple scaled between c0 and c1.
 189
 190 =item hsvup
 191
 192 The color is converted to a HSV value and the scaling is done such
 193 that the hue increases as the fill parameter increases.
 194
 195 =item hsvdown
 196
 197 The color is converted to a HSV value and the scaling is done such
 198 that the hue decreases as the fill parameter increases.
 199
 200 =back
 201
 202 =back
 203
 204 In 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
 209   $f->add(c0=>NC('#FF0000), c1=>NC('#0000FF'));
 210   # simple 2 stages from red to green to blue
 211   $f->add(end=>0.5, c0=>NC('#FF0000'), c1=>NC('#00FF00'))
 212   $f->add(start=>0.5, c0=>NC('#00FF00'), c1->NC('#0000FF'));
 213
 214 =cut
 215
 216 # used to translate segment types and color transition types to numbers
 217 my %type_names =
 218   (
 219    linear => 0,
 220    curved => 1,
 221    sine => 2,
 222    sphereup=> 3,
 223    spheredown => 4,
 224   );
 225
 226 my %color_names =
 227   (
 228    direct => 0,
 229    hueup => 1,
 230    huedown => 2
 231   );
 232
 233 sub 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
 254 Creates a simple fountain fill object consisting of linear segments.
 255
 256 The arrayrefs passed as positions and colors must have the same number
 257 of elements.  They must have at least 2 elements each.
 258
 259 colors must contain Imager::Color or Imager::Color::Float objects.
 260
 261 eg.
 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
 269 sub 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     }
 288     return $f;
 289   }
 290   else {
 291     warn "Nothing to do";
 292     return;
 293   }
 294 }
 295
 296 =back
 297
 298 =head2 Implementation Functions
 299
 300 Documented for internal use.
 301
 302 =over
 303
 304 =item _load_gimp_gradient($class, $fh, $name)
 305
 306 Does the work of loading a GIMP gradient file.
 307
 308 =cut
 309
 310 sub _load_gimp_gradient {
 311   my ($class, $fh, $filename, $name) = @_;
 312
 313   my $head = <$fh>;
 314   chomp $head;
 315   unless ($head eq 'GIMP Gradient') {
 316     $Imager::ERRSTR = "$filename is not a GIMP gradient file";
 317     return;
 318   }
 319   my $count = <$fh>;
 320   chomp $count;
 321   if ($count =~ /^name:\s?(.*)/i) {
 322     ref $name and $$name = $1;
 323     $count = <$fh>; # try again
 324   }
 325   unless ($count =~ /^\d$/) {
 326     $Imager::ERRSTR = "$filename is missing the segment count";
 327     return;
 328   }
 329   my @result;
 330   for my $i (1..$count) {
 331     my $row = <$fh>;
 332     chomp $row;
 333     my @row = split ' ', $row;
 334     unless (@row == 13) {
 335       $Imager::ERRSTR = "Bad segment definition";
 336       return;
 337     }
 338     my ($start, $middle, $end) = splice(@row, 0, 3);
 339     my $c0 = Imager::Color::Float->new(splice(@row, 0, 4));
 340     my $c1 = Imager::Color::Float->new(splice(@row, 0, 4));
 341     my ($type, $color) = @row;
 342     push(@result, [ $start, $middle, $end, $c0, $c1, $type, $color ]);
 343   }
 344   return bless \@result,
 345 }
 346
 347 =item _save_gimp_gradient($self, $fh, $name)
 348
 349 Does the work of saving to a GIMP gradient file.
 350
 351 =cut
 352
 353 sub _save_gimp_gradient {
 354   my ($self, $fh, $filename, $name) = @_;
 355
 356   print $fh "GIMP Gradient\n";
 357   defined $name or $name = '';
 358   $name =~ tr/ -~/ /cds;
 359   if ($name) {
 360     print $fh "Name: $name\n";
 361   }
 362   print $fh scalar(@$self),"\n";
 363   for my $row (@$self) {
 364     printf $fh "%.6f %.6f %.6f ",@{$row}[0..2];
 365     for my $i (0, 1) {
 366       for ($row->[3+$i]->rgba) {
 367         printf $fh "%.6f ", $_/255.0;
 368       }
 369     }
 370     print $fh "@{$row}[5,6]";
 371     unless (print $fh "\n") {
 372       $Imager::ERRSTR = "write error: $!";
 373       return;
 374     }
 375   }
 376
 377   return 1;
 378 }
 379
 380 =back
 381
 382 =head1 FILL PARAMETER
 383
 384 The add() documentation mentions a fill parameter in a few places,
 385 this is as good a place as any to discuss it.
 386
 387 The process of deciding the color produced by the gradient works
 388 through the following steps:
 389
 390 =over
 391
 392 =item 1.
 393
 394 calculate the base value, which is typically a distance or an angle of
 395 some sort.  This can be positive or occasinally negative, depending on
 396 the type of fill being performed (linear, radial, etc).
 397
 398 =item 2.
 399
 400 clamp or convert the base value to the range 0 through 1, how this is
 401 done depends on the repeat parameter.  I'm calling this result the
 402 fill parameter.
 403
 404 =item 3.
 405
 406 the appropriate segment is found.  This is currently done with a
 407 linear search, and the first matching segment is used.  If there is no
 408 matching segment the pixel is not touched.
 409
 410 =item 4.
 411
 412 the fill parameter is scaled from 0 to 1 depending on the segment type.
 413
 414 =item 5.
 415
 416 the color produced, depending on the segment color type.
 417
 418 =back
 419
 420 =head1 AUTHOR
 421
 422 Tony Cook <tony@develop-help.com>
 423
 424 =head1 SEE ALSO
 425
 426 Imager(3)
 427
 428 =cut