<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">package Imager::Fountain;
use strict;
use Imager::Color::Float;
use vars qw($VERSION);

$VERSION = "1.007";

=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-&gt;read(gimp=&gt;$filename);
  $f-&gt;write(gimp=&gt;$filename);
  my $f1 = Imager::Fountain-&gt;new;
  $f1-&gt;add(start=&gt;0, middle=&gt;0.5, end=&gt;1.0,
           c0=&gt;Imager::Color-&gt;new(...),
           c1=&gt;Imager::Color-&gt;new(...),
           type=&gt;$trans_type, color=&gt;$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=&gt;$filename)

=item read(gimp=&gt;$filename, name=&gt;\$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-&gt;read(gimp=&gt;'foo.ggr');
  my $name;
  my $gradient2 = Imager::Fountain-&gt;read(gimp=&gt;'bar.ggr', name=&gt;\$name);

=cut

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

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

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

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

=item write(gimp=&gt;$filename)

=item write(gimp=&gt;$filename, name=&gt;$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-&gt;write(gimp=&gt;'foo.ggr')
    or die Imager-&gt;errstr;
  $gradient-&gt;write(gimp=&gt;'bar.ggr', name=&gt;'the bar gradient')
    or die Imager-&gt;errstr;

=cut

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

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

    return $self-&gt;_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=&gt;$start, middle=&gt;$middle, end=&gt;1.0, c0=&gt;$start_color, c1=&gt;$end_color, type=&gt;$trans_type, color=&gt;$color_trans_type)

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

=over

=item *

C&lt;start&gt; - the start position in the gradient where this segment takes
effect between 0 and 1.  Default: 0.

=item *

C&lt;middle&gt; - the mid-point of the transition between the 2
colors, between 0 and 1.  Default: average of C&lt;start&gt; and C&lt;end&gt;.

=item *

C&lt;end&gt; - the end of the gradient, from 0 to 1.  Default: 1.

=item *

C&lt;c0&gt; - the color of the fountain fill where the fill parameter is
equal to I&lt;start&gt;.  Default: opaque black.

=item *

C&lt;c1&gt; - the color of the fountain fill where the fill parameter is
equal to I&lt;end&gt;.  Default: opaque black.

=item *

C&lt;type&gt; - 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 *

C&lt;linear&gt;

=item *

C&lt;curved&gt; - unimplemented so far.

=item *

C&lt;sine&gt;

=item *

C&lt;sphereup&gt;

=item *

C&lt;spheredown&gt;

=back

=item *

C&lt;color&gt; - the way in which the color transitions between C&lt;c0&gt; and C&lt;c1&gt;.
Default: direct.

This can take any of the following values:

=over

=item *

C&lt;direct&gt; - each channel is simple scaled between c0 and c1.

=item *

C&lt;hueup&gt; - the color is converted to a HSV value and the scaling is
done such that the hue increases as the fill parameter increases.

=item *

C&lt;huedown&gt; - 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-&gt;add(c0=&gt;NC('#FF0000'), c1=&gt;NC('#0000FF'));
  # simple 2 stages from red to green to blue
  $f-&gt;add(end=&gt;0.5, c0=&gt;NC('#FF0000'), c1=&gt;NC('#00FF00'))
  $f-&gt;add(start=&gt;0.5, c0=&gt;NC('#00FF00'), c1=&gt;NC('#0000FF'));

=cut

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

my %color_names =
  (
   direct =&gt; 0,
   hueup =&gt; 1,
   huedown =&gt; 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-&gt;new(0,0,0,1)),
     _first($opts{c1}, Imager::Color::Float-&gt;new(1,1,1,0)),
     _first($opts{type} &amp;&amp; $type_names{$opts{type}}, $opts{type}, 0),
     _first($opts{color} &amp;&amp; $color_names{$opts{color}}, $opts{color}, 0)
    );
  push(@$self, \@row);

  $self;
}

=item simple(positions=&gt;[ ... ], colors=&gt;[...])

Creates a simple fountain fill object consisting of linear segments.

The array references 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-&gt;simple(positions=&gt;[0, 0.2, 1.0],
                                   colors=&gt;[ NC(255,0,0), NC(0,255,0), 
                                             NC(0,0,255) ]);

=cut

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

  if ($opts{positions} &amp;&amp; $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 &gt;= 2) {
      $Imager::ERRSTR = "not enough segments";
      return;
    }
    my $f = $class-&gt;new;
    for my $i (0.. $#$colors-1) {
      $f-&gt;add(start=&gt;$positions-&gt;[$i], end=&gt;$positions-&gt;[$i+1],
              c0 =&gt; $colors-&gt;[$i], c1=&gt;$colors-&gt;[$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 = &lt;$fh&gt;;
  chomp $head;
  unless ($head eq 'GIMP Gradient') {
    $Imager::ERRSTR = "$filename is not a GIMP gradient file";
    return;
  }
  my $count = &lt;$fh&gt;;
  chomp $count;
  if ($count =~ /^name:\s?(.*)/i) {
    ref $name and $$name = $1;
    $count = &lt;$fh&gt;; # 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 = &lt;$fh&gt;;
    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-&gt;new(splice(@row, 0, 4));
    my $c1 = Imager::Color::Float-&gt;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-&gt;[3+$i]-&gt;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 occasionally 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 &lt;tony@develop-help.com&gt;

=head1 SEE ALSO

Imager(3)

=cut
</pre></body></html>