[imager.git] / lib / Imager / Fountain.pm

package Imager::Fountain;
use strict;
use Imager::Color::Float;
use vars qw($VERSION);

$VERSION = "1.006";

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

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

=cut

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

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

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

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

=item write(gimp=>$filename)

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

=cut

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

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

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

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

=over

=item start

The start position in the gradient where this segment
takes effect between 0 and 1.  Default: 0.

=item middle

The mid-point of the transition between the 2
colors, between 0 and 1.  Default: average of I<start> and I<end>.

=item end

The end of the gradient, from 0 to 1.  Default: 1.

=item c0

The color of the fountain fill where the fill parameter is equal
to I<start>.  Default: opaque black.

=item c1

The color of the fountain fill where the fill parameter is equal to
I<end>.  Default: opaque black.

=item type

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 linear

=item curved

Unimplemented so far.

=item sine

=item sphereup

=item spheredown

=back

=item color

The way in which the color transitions between I<c0> and I<c1>.
Default: direct.

This can take any of the following values:

=over

=item direct

Each channel is simple scaled between c0 and c1.

=item hueup

The color is converted to a HSV value and the scaling is done such
that the hue increases as the fill parameter increases.

=item huedown

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

=cut

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

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

  $self;
}

=item simple(positions=>[ ... ], colors=>[...])

Creates a simple fountain fill object consisting of linear segments.

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

=cut

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

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

=head1 SEE ALSO

Imager(3)

=cut
Commit	Line	Data
6607600c TC	1	package Imager::Fountain;
	2	use strict;
	3	use Imager::Color::Float;
f17b46d8 TC	4	use vars qw($VERSION);
f17b46d8 TC	5
12e92882	6	$VERSION = "1.006";
6607600c TC	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
817ba871 TC	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);
6607600c TC	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
817ba871 TC	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);
6607600c TC	63	}
	64	else {
	65	warn "$class::read: Nothing to do!";
	66	return;
	67	}
	68	}
	69
	70	=item write(gimp=>$filename)
	71
817ba871 TC	72	=item write(gimp=>$filename, name=>$name)
817ba871 TC	73
6607600c TC	74	Save the gradient to a GIMP gradient file.
6607600c TC	75
817ba871 TC	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
6607600c TC	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
817ba871	97	return $self->_save_gimp_gradient($fh, $opts{gimp}, $opts{name});
6607600c TC	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
9b1ec2b8	190	=item hueup
6607600c TC	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
9b1ec2b8	195	=item huedown
6607600c TC	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
12e92882	209	$f->add(c0=>NC('#FF0000'), c1=>NC('#0000FF'));
6607600c TC	210	# simple 2 stages from red to green to blue
6607600c TC	211	$f->add(end=>0.5, c0=>NC('#FF0000'), c1=>NC('#00FF00'))
caf1c836	212	$f->add(start=>0.5, c0=>NC('#00FF00'), c1=>NC('#0000FF'));
6607600c TC	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	}
e119b16c	288	return $f;
6607600c TC	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 {
817ba871	311	my ($class, $fh, $filename, $name) = @_;
6607600c TC	312
	313	my $head = <$fh>;
	314	chomp $head;
	315	unless ($head eq 'GIMP Gradient') {
817ba871	316	$Imager::ERRSTR = "$filename is not a GIMP gradient file";
6607600c TC	317	return;
	318	}
	319	my $count = <$fh>;
	320	chomp $count;
817ba871 TC	321	if ($count =~ /^name:\s?(.*)/i) {
	322	ref $name and $$name = $1;
	323	$count = <$fh>; # try again
cfa61c80	324	chomp $count;
817ba871	325	}
cfa61c80	326	unless ($count =~ /^\d+$/) {
817ba871	327	$Imager::ERRSTR = "$filename is missing the segment count";
6607600c TC	328	return;
	329	}
	330	my @result;
	331	for my $i (1..$count) {
	332	my $row = <$fh>;
	333	chomp $row;
	334	my @row = split ' ', $row;
	335	unless (@row == 13) {
	336	$Imager::ERRSTR = "Bad segment definition";
	337	return;
	338	}
	339	my ($start, $middle, $end) = splice(@row, 0, 3);
	340	my $c0 = Imager::Color::Float->new(splice(@row, 0, 4));
	341	my $c1 = Imager::Color::Float->new(splice(@row, 0, 4));
	342	my ($type, $color) = @row;
	343	push(@result, [ $start, $middle, $end, $c0, $c1, $type, $color ]);
	344	}
	345	return bless \@result,
	346	}
	347
	348	=item _save_gimp_gradient($self, $fh, $name)
	349
	350	Does the work of saving to a GIMP gradient file.
	351
	352	=cut
	353
	354	sub _save_gimp_gradient {
817ba871	355	my ($self, $fh, $filename, $name) = @_;
6607600c TC	356
6607600c TC	357	print $fh "GIMP Gradient\n";
817ba871 TC	358	defined $name or $name = '';
	359	$name =~ tr/ -~/ /cds;
	360	if ($name) {
	361	print $fh "Name: $name\n";
	362	}
6607600c TC	363	print $fh scalar(@$self),"\n";
	364	for my $row (@$self) {
	365	printf $fh "%.6f %.6f %.6f ",@{$row}[0..2];
	366	for my $i (0, 1) {
	367	for ($row->[3+$i]->rgba) {
817ba871	368	printf $fh "%.6f ", $_/255.0;
6607600c TC	369	}
6607600c TC	370	}
817ba871	371	print $fh "@{$row}[5,6]";
6607600c TC	372	unless (print $fh "\n") {
	373	$Imager::ERRSTR = "write error: $!";
	374	return;
	375	}
	376	}
	377
	378	return 1;
	379	}
	380
	381	=back
	382
	383	=head1 FILL PARAMETER
	384
	385	The add() documentation mentions a fill parameter in a few places,
	386	this is as good a place as any to discuss it.
	387
	388	The process of deciding the color produced by the gradient works
	389	through the following steps:
	390
	391	=over
	392
	393	=item 1.
	394
	395	calculate the base value, which is typically a distance or an angle of
	396	some sort. This can be positive or occasinally negative, depending on
	397	the type of fill being performed (linear, radial, etc).
	398
	399	=item 2.
	400
	401	clamp or convert the base value to the range 0 through 1, how this is
	402	done depends on the repeat parameter. I'm calling this result the
	403	fill parameter.
	404
	405	=item 3.
	406
	407	the appropriate segment is found. This is currently done with a
	408	linear search, and the first matching segment is used. If there is no
	409	matching segment the pixel is not touched.
	410
5cb9270b	411	=item 4.
6607600c TC	412
	413	the fill parameter is scaled from 0 to 1 depending on the segment type.
	414
5cb9270b	415	=item 5.
6607600c TC	416
	417	the color produced, depending on the segment color type.
	418
	419	=back
	420
	421	=head1 AUTHOR
	422
	423	Tony Cook <tony@develop-help.com>
	424
	425	=head1 SEE ALSO
	426
	427	Imager(3)
	428
	429	=cut