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.007";
   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