# Copyright 2010, 2011 Kevin Ryde

# This file is part of Image-Base-Imager.
#
# Image-Base-Imager is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Image-Base-Imager is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Image-Base-Imager.  If not, see <http://www.gnu.org/licenses/>.


package Image::Base::Imager;
use 5.004;
use strict;
use Carp;
use Imager;
use vars '$VERSION', '@ISA';

use Image::Base;
@ISA = ('Image::Base');

$VERSION = 3;

# uncomment this to run the ### lines
#use Smart::Comments '###';

# As of Imager 0.79 there's nothing to set the Zlib compression level for a
# -zlib_compression attribute.
#
# An -allow_partial could set allow_partial=> on read().
#
# A -quality_percent could set jpegquality=> on write().
#

sub new {
  my ($class, %params) = @_;
  ### Image-Base-Imager new(): %params

  # $obj->new(...) means make a copy, with some extra settings
  if (ref $class) {
    my $self = $class;
    $class = ref $class;
    if (! defined $params{'-imager'}) {
      $params{'-imager'} = $self->get('-imager')->copy;
    }
    # inherit everything else
    %params = (%$self, %params);
    ### copy params: \%params
  }

  my $want_load = 1;
  if (! defined $params{'-imager'}) {
    my $width  = delete $params{'-width'};
    my $height = delete $params{'-height'};
    my $filename = $params{'-file'};
    if (! defined $filename) {
      # default 1x1 image since xsize=>undef,ysize=>undef is a 0x0
      # nothingness where settag() won't store -file_format
      if (! defined $width) { $width = 1; }
      if (! defined $height) { $height = 1; }
    }
    my $i = $params{'-imager'} = Imager->new (xsize => $width,
                                              ysize => $height,
                                              file  => $filename)
      || croak "Cannot create image: ",Imager->errstr;
    # set -file as filename, but have already loaded
    $want_load = 0;
  }
  my $self = bless {}, $class;
  $self->set (%params);

  if ($want_load && defined $params{'-file'}) {
    $self->load;
  }

  ### new made: $self
  return $self;
}


my %attr_to_tag = (-hotx => 'cur_hotspotx', # get and set
                   -hoty => 'cur_hotspoty',
                  );
my %attr_to_get_method = (-width    => 'getwidth',
                          -height   => 'getheight',
                          -ncolours => 'colorcount',
                          -file_format => \&_imager_get_file_format,
                         );
sub _get {
  my ($self, $key) = @_;
  ### Image-Base-Imager _get(): $key

  if (my $tag = $attr_to_tag{$key}) {
    ### $tag
    ### is: [$self->{'-imager'}->tags(name=>$tag)]
    return scalar(($self->{'-imager'}->tags(name=>$tag))[0]);
  }
  if (my $method = $attr_to_get_method{$key}) {
    ### $method
    ### is: $self->{'-imager'}->$method
    return  $self->{'-imager'}->$method
  }
  return $self->SUPER::_get ($key);
}
sub _imager_get_file_format {
  my ($i) = @_;
  ### _imager_get_file_format() from tags: [$i->tags]
  # tags() returns a list of the values
  return scalar(($i->tags (name => 'i_format'))[0]);
}

my %attr_to_img_set = (-width  => 'xsize',
                       -height => 'ysize',
                      );
sub set {
  my ($self, %param) = @_;
  ### Image-Base-Imager set(): \%param

  foreach my $key ('-ncolours') {
    if (exists $param{$key}) {
      croak "Attribute $key is read-only";
    }
  }

  # apply this first
  if (my $i = delete $param{'-imager'}) {
    $self->{'-imager'} = $i;
  }

  my $i = $self->{'-imager'};
  if (exists $param{'-file_format'}) {
    my $format = delete $param{'-file_format'};
    if (defined $format) { $format = lc($format); }
    ### apply -file_format with settag() i_format: lc($param{'-file_format'})
    $i->settag (name => 'i_format', value => $format);
    ### tags now: [$i->tags]
  }
  foreach my $key (keys %param) {
    if (my $tag = $attr_to_tag{$key}) {
      ### settag: $tag
      $i->settag (name => $tag, value => delete $param{$key});
      ### tags now: [$i->tags]
    }
  }

  my @set;
  foreach my $key (keys %param) {
    if (my $attribute = $attr_to_img_set{$key}) {
      push @set, $attribute, delete $param{$key};
    }
  }
  if (@set) {
    ### @set
    $i->img_set(@set);
  }

  %$self = (%$self, %param);
}

sub load {
  my ($self, $filename) = @_;
  ### Image-Base-Imager load(): @_
  if (@_ == 1) {
    $filename = $self->get('-file');
  } else {
    $self->set('-file', $filename);
  }
  my $i = $self->{'-imager'};
  $i->read (file => $filename)
    or croak "Cannot load: ",$i->errstr;
  ### $i
  ### size: $i->getwidth.'x'.$i->getheight
  ### tags: [$i->tags]
}

# not yet documented ...
sub load_fh {
  my ($self, $fh) = @_;
  my $i = $self->{'-imager'};
  $i->read (fh => $fh)
    or croak "Cannot load: ",$i->errstr;
}

sub save {
  my ($self, $filename) = @_;
  ### Image-Base-Imager save(): @_
  if (@_ == 2) {
    $self->set('-file', $filename);
  } else {
    $filename = $self->get('-file');
  }
  my $i = $self->{'-imager'};
  ### file: $filename
  ### type: _imager_get_file_format($i)
  $i->write (file => $filename,
             type => _imager_get_file_format($i))
    or croak "Cannot save: ",$i->errstr;
}

# not yet documented ...
sub save_fh {
  my ($self, $fh) = @_;
  my $i = $self->{'-imager'};
  $i->write (fh => $fh,
             type => _imager_get_file_format($i))
    or croak "Cannot save: ",$i->errstr;
}

sub xy {
  my ($self, $x, $y, $colour) = @_;
  ### Image-Base-Imager xy: $x,$y,$colour
  my $i = $self->{'-imager'};
  if (@_ == 4) {
    $i->setpixel (x => $x, y => $y, color => $colour);

  } else {
    my $cobj = $i->getpixel (x => $x, y => $y);
    my ($r,$g,$b,$a) = $cobj->rgba;
    ### rgba: "$r,$g,$b,$a"
    # if ($a == 0) {
    #   return 'None';
    # }
    return sprintf ('#%02X%02X%02X', $r, $b, $g);
  }
}
sub line {
  my ($self, $x1, $y1, $x2, $y2, $colour) = @_;
  ### Image-Base-Imager line: @_
  $self->{'-imager'}->line (x1 => $x1,
                            y1 => $y1,
                            x2 => $x2,
                            y2 => $y2,
                            color => $colour);
}
sub rectangle {
  my ($self, $x1, $y1, $x2, $y2, $colour, $fill) = @_;
  ### Image-Base-Imager rectangle: @_

  $self->{'-imager'}->box (xmin => $x1,
                           ymin => $y1,
                           xmax => $x2,
                           ymax => $y2,
                           color => $colour,
                           filled => $fill);
}

sub ellipse {
  my ($self, $x1, $y1, $x2, $y2, $colour, $fill) = @_;
  ### Image-Imager ellipse: "$x1, $y1, $x2, $y2, $colour"

  my $i = $self->{'-imager'};
  my $diam = $x2-$x1;
  if (! ($diam & 1) && $y2-$y1 == $diam) {
    ### use circle
    $self->{'-imager'}->circle (x => ($x2+$x1)/2,
                                y => ($y2+$y1)/2,
                                r => $diam/2,
                                color => $colour,
                                filled => $fill);
  } else {
    ### use superclass ellipse
    shift->SUPER::ellipse (@_);
  }
}

sub add_colours {
  my $self = shift;
  ### add_colours: @_
  $self->{'-imager'}->addcolors (colors => \@_);
}


# sub _validate_file_format {
#   my ($format) = @_;
#   if (! defined $format) {
#     return; # undef is ok
#   }
# 
#   # in Imager 0.80 'cur' works but isn't in the types lists
#   my $lform = lc($format);
#   foreach my $f ('cur', Imager->read_types, Imager->write_types) {
#     if ($lform eq $f) {
#       return;
#     }
#   }
# 
#   croak 'Unrecognised -file_format: ',$format;
# }

1;
__END__

=for stopwords PNG Imager filename undef Ryde Zlib Imager RGB

=head1 NAME

Image::Base::Imager -- draw images using Imager

=head1 SYNOPSIS

 use Image::Base::Imager;
 my $image = Image::Base::Imager->new (-width => 100,
                                       -height => 100);
 $image->rectangle (0,0, 99,99, 'white');
 $image->xy (20,20, 'black');
 $image->line (50,50, 70,70, '#FF00FF');
 $image->line (50,50, 70,70, '#0000AAAA9999');
 $image->save ('/some/filename.png');

=head1 CLASS HIERARCHY

C<Image::Base::Imager> is a subclass of C<Image::Base>,

    Image::Base
      Image::Base::Imager

=head1 DESCRIPTION

C<Image::Base::Imager> extends C<Image::Base> to create or
update image files using the C<Imager> module.

As of Imager 0.80 the supported file formats for read and write include PNG,
JPEG, TIFF, PNM, GIF, BMP, and ICO (including CUR).  See L<Imager::Files>
for the full list.

Colour names are anything recognised by C<Imager::Color>.  As of Imager 0.80
this means the GIMP F<Named_Colors> if you have the GIMP installed, the X11
F<rgb.txt>, hex "#RGB", "#RRGGBB", etc.  The system F<rgb.txt> is used if
available, otherwise a copy in C<Imager::Color::Table>.  An C<Imager::Color>
object can also be given.

=head2 Paletted Images

For a paletted image, if Imager is given a colour not already in the palette
then it converts the whole image to RGB.  C<Image::Base::Imager> doesn't try
do anything about that yet.  An C<add_colours> can pre-load the palette.

The C<Image::Base> intention is just to throw colour names at drawing
functions, so perhaps C<Image::Base::Imager> should extend the palette when
necessary, or choose a close colour if full.  But an
C<$imager-E<gt>to_paletted> after all drawing might come out better than
colours as drawing proceeds.

=head1 FUNCTIONS

=over 4

=item C<$image = Image::Base::Imager-E<gt>new (key=E<gt>value,...)>

Create and return a new image object.  A new image can be started with
C<-width> and C<-height>,

    $image = Image::Base::Imager->new (-width => 200, -height => 100);

Or an existing file can be read,

    $image = Image::Base::Imager->new (-file => '/some/filename.png');

Or an C<Imager> object can be given,

    $image = Image::Base::Imager->new (-imager => $iobj);

=item C<$image-E<gt>ellipse ($x1,$y1, $x2,$y2, $colour, $fill)>

Draw an ellipse within the rectangle with top-left corner C<$x1>,C<$y1> and
bottom-right C<$x2>,C<$y2>.  Optional C<$fill> true means a filled ellipse.

In the current implementation circles (width==height) drawn with Imager and
ellipses as such go to C<Image::Base>.  This is a bit inconsistent but uses
the features of Imager as far as possible and its drawing should be faster.

=item C<$image-E<gt>save>

=item C<$image-E<gt>save ($filename)>

Save to C<-file>, or with a C<$filename> argument set C<-file> then save to
that.

The file format is taken from the C<-file_format> (see below) if that was
set by a C<load> or explicit C<set>, otherwise Imager follows the filename
extension.  In both cases if format or extension is unrecognised then
C<save()> croaks.

=item C<$image-E<gt>add_colours ($name, $name, ...)>

Add colours to the image palette.  Colour names are the same as to the
drawing functions.

    $image->add_colours ('red', 'green', '#FF00FF');

For a non-paletted image C<add_colours> does nothing since in that case each
pixel has RGB component values, rather than an index into a palette.

=back

=head1 ATTRIBUTES

=over

=item C<-width> (integer)

=item C<-height> (integer)

Setting these changes the size of the image.

=item C<-imager>

The underlying C<Imager> object.

=item C<-file_format> (string or C<undef>)

The file format as a string like "png" or "jpeg", or C<undef> if unknown or
never set.

After C<load> the C<-file_format> is the format read.  Setting
C<-file_format> can change the format for a subsequent C<save>.

This is held in the imager "i_format" tag and passed as the C<type> when
saving.  If C<undef> when saving, Imager will look at the filename
extension.

There's no attempt to check or validate the C<-file_format> value, since
it's possible to add new formats to Imager at run time.  Expect C<save()> to
croak if the format is unknown.

=item C<-hotx> (integer or undef, default undef)

=item C<-hoty> (integer or undef, default undef)

The cursor hotspot in CUR images (variant of ICO).  These are the
C<cur_hotspotx> and C<cur_hotspoty> tags in the Imager object.

=item C<-ncolours> (integer, read-only)

The number of colours allocated in the palette, or C<undef> on a
non-paletted image.  (The Imager C<colorcount>.)

This is similar to the C<-ncolours> of C<Image::Xpm>.

=back

=head1 SEE ALSO

L<Image::Base>,
L<Imager>

L<Image::Base::GD>,
L<Image::Base::PNGwriter>,
L<Image::Base::Prima>,
L<Image::Xbm>,
L<Image::Xpm>,
L<Image::Pbm>

=head1 HOME PAGE

http://user42.tuxfamily.org/image-base-imager/index.html

=head1 LICENSE

Image-Base-Imager is Copyright 2010, 2011 Kevin Ryde

Image-Base-Imager is free software; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by the Free
Software Foundation; either version 3, or (at your option) any later
version.

Image-Base-Imager is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
more details.

You should have received a copy of the GNU General Public License along with
Image-Base-Imager.  If not, see <http://www.gnu.org/licenses/>.

=cut
