i_bezier_multi
i_poly_aa
+ i_poly_aa_cfill
i_copyto
i_rubthru
i_writepng_wiol
i_readgif
+ i_readgif_wiol
i_readgif_callback
i_writegif
i_writegifmc
NF
);
-@EXPORT=qw(
+@EXPORT=qw(
init_log
i_list_formats
i_has_format
require Exporter;
require DynaLoader;
- $VERSION = '0.39pre1';
+ $VERSION = '0.39';
@ISA = qw(Exporter DynaLoader);
bootstrap Imager $VERSION;
}
multiply => 2, mult => 2,
dissolve => 3,
add => 4,
- subtract => 5, sub => 5,
+ subtract => 5, 'sub' => 5,
diff => 6,
lighten => 7,
darken => 8,
return join(": ", map $_->[0], i_errors());
}
+# this function tries to DWIM for color parameters
+# color objects are used as is
+# simple scalars are simply treated as single parameters to Imager::Color->new
+# hashrefs are treated as named argument lists to Imager::Color->new
+# arrayrefs are treated as list arguments to Imager::Color->new iff any
+# parameter is > 1
+# other arrayrefs are treated as list arguments to Imager::Color::Float
+
+sub _color {
+ my $arg = shift;
+ my $result;
+
+ if (ref $arg) {
+ if (UNIVERSAL::isa($arg, "Imager::Color")
+ || UNIVERSAL::isa($arg, "Imager::Color::Float")) {
+ $result = $arg;
+ }
+ else {
+ if ($arg =~ /^HASH\(/) {
+ $result = Imager::Color->new(%$arg);
+ }
+ elsif ($arg =~ /^ARRAY\(/) {
+ if (grep $_ > 1, @$arg) {
+ $result = Imager::Color->new(@$arg);
+ }
+ else {
+ $result = Imager::Color::Float->new(@$arg);
+ }
+ }
+ else {
+ $Imager::ERRSTR = "Not a color";
+ }
+ }
+ }
+ else {
+ # assume Imager::Color::new knows how to handle it
+ $result = Imager::Color->new($arg);
+ }
+
+ return $result;
+}
+
+
#
# Methods to be called on objects.
#
return 0 unless $self->{IMG};
- if (defined $opts{index}) {
- return i_tags_delete($self->{IMG}, $opts{index});
+ if (defined $opts{'index'}) {
+ return i_tags_delete($self->{IMG}, $opts{'index'});
}
elsif (defined $opts{name}) {
return i_tags_delbyname($self->{IMG}, $opts{name});
}
}
+my @needseekcb = qw/tiff/;
+my %needseekcb = map { $_, $_ } @needseekcb;
+
+
+sub _get_reader_io {
+ my ($self, $input, $type) = @_;
+
+ if ($input->{fd}) {
+ return io_new_fd($input->{fd});
+ }
+ elsif ($input->{fh}) {
+ my $fd = fileno($input->{fh});
+ unless ($fd) {
+ $self->_set_error("Handle in fh option not opened");
+ return;
+ }
+ return io_new_fd($fd);
+ }
+ elsif ($input->{file}) {
+ my $file = IO::File->new($input->{file}, "r");
+ unless ($file) {
+ $self->_set_error("Could not open $input->{file}: $!");
+ return;
+ }
+ binmode $file;
+ return (io_new_fd(fileno($file)), $file);
+ }
+ elsif ($input->{data}) {
+ return io_new_buffer($input->{data});
+ }
+ elsif ($input->{callback} || $input->{readcb}) {
+ if ($needseekcb{$type} && !$input->{seekcb}) {
+ $self->_set_error("Format $type needs a seekcb parameter");
+ }
+ if ($input->{maxbuffer}) {
+ return io_new_cb($input->{writecb},
+ $input->{callback} || $input->{readcb},
+ $input->{seekcb}, $input->{closecb},
+ $input->{maxbuffer});
+ }
+ else {
+ return io_new_cb($input->{writecb},
+ $input->{callback} || $input->{readcb},
+ $input->{seekcb}, $input->{closecb});
+ }
+ }
+ else {
+ $self->_set_error("file/fd/fh/data/callback parameter missing");
+ return;
+ }
+}
+
+sub _get_writer_io {
+ my ($self, $input, $type) = @_;
+
+ if ($input->{fd}) {
+ return io_new_fd($input->{fd});
+ }
+ elsif ($input->{fh}) {
+ my $fd = fileno($input->{fh});
+ unless ($fd) {
+ $self->_set_error("Handle in fh option not opened");
+ return;
+ }
+ return io_new_fd($fd);
+ }
+ elsif ($input->{file}) {
+ my $fh = new IO::File($input->{file},"w+");
+ unless ($fh) {
+ $self->_set_error("Could not open file $input->{file}: $!");
+ return;
+ }
+ binmode($fh) or die;
+ return (io_new_fd(fileno($fh)), $fh);
+ }
+ elsif ($input->{data}) {
+ return io_new_bufchain();
+ }
+ elsif ($input->{callback} || $input->{writecb}) {
+ if ($input->{maxbuffer}) {
+ return io_new_cb($input->{callback} || $input->{writecb},
+ $input->{readcb},
+ $input->{seekcb}, $input->{closecb},
+ $input->{maxbuffer});
+ }
+ else {
+ return io_new_cb($input->{callback} || $input->{writecb},
+ $input->{readcb},
+ $input->{seekcb}, $input->{closecb});
+ }
+ }
+ else {
+ $self->_set_error("file/fd/fh/data/callback parameter missing");
+ return;
+ }
+}
+
# Read an image from file
sub read {
my $self = shift;
my %input=@_;
- my ($fh, $fd, $IO);
if (defined($self->{IMG})) {
# let IIM_DESTROY do the destruction, since the image may be
undef($self->{IMG});
}
- if (!$input{fd} and !$input{file} and !$input{data}) {
- $self->{ERRSTR}='no file, fd or data parameter'; return undef;
- }
- if ($input{file}) {
- $fh = new IO::File($input{file},"r");
- if (!defined $fh) {
- $self->{ERRSTR}='Could not open file'; return undef;
- }
- binmode($fh);
- $fd = $fh->fileno();
- }
- if ($input{fd}) {
- $fd=$input{fd};
- }
-
# FIXME: Find the format here if not specified
# yes the code isn't here yet - next week maybe?
# Next week? Are you high or something? That comment
# has been there for half a year dude.
# Look, i just work here, ok?
- if (!$input{type} and $input{file}) {
- $input{type}=$FORMATGUESS->($input{file});
+ if (!$input{'type'} and $input{file}) {
+ $input{'type'}=$FORMATGUESS->($input{file});
}
- if (!$formats{$input{type}}) {
+ unless ($input{'type'}) {
+ $self->_set_error('type parameter missing and not possible to guess from extension');
+ return undef;
+ }
+ if (!$formats{$input{'type'}}) {
$self->{ERRSTR}='format not supported'; return undef;
}
- my %iolready=(jpeg=>1, png=>1, tiff=>1, pnm=>1, raw=>1, bmp=>1, tga=>1);
+ my %iolready=(jpeg=>1, png=>1, tiff=>1, pnm=>1, raw=>1, bmp=>1, tga=>1, rgb=>1, gif=>1);
- if ($iolready{$input{type}}) {
+ if ($iolready{$input{'type'}}) {
# Setup data source
- $IO = io_new_fd($fd); # sort of simple for now eh?
+ my ($IO, $fh) = $self->_get_reader_io(\%input, $input{'type'})
+ or return;
- if ( $input{type} eq 'jpeg' ) {
+ if ( $input{'type'} eq 'jpeg' ) {
($self->{IMG},$self->{IPTCRAW})=i_readjpeg_wiol( $IO );
if ( !defined($self->{IMG}) ) {
$self->{ERRSTR}='unable to read jpeg image'; return undef;
return $self;
}
- if ( $input{type} eq 'tiff' ) {
+ if ( $input{'type'} eq 'tiff' ) {
$self->{IMG}=i_readtiff_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed
if ( !defined($self->{IMG}) ) {
- $self->{ERRSTR}='unable to read tiff image'; return undef;
+ $self->{ERRSTR}=$self->_error_as_msg(); return undef;
}
$self->{DEBUG} && print "loading a tiff file\n";
return $self;
}
- if ( $input{type} eq 'pnm' ) {
+ if ( $input{'type'} eq 'pnm' ) {
$self->{IMG}=i_readpnm_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed
if ( !defined($self->{IMG}) ) {
$self->{ERRSTR}='unable to read pnm image: '._error_as_msg(); return undef;
return $self;
}
- if ( $input{type} eq 'png' ) {
+ if ( $input{'type'} eq 'png' ) {
$self->{IMG}=i_readpng_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed
if ( !defined($self->{IMG}) ) {
$self->{ERRSTR}='unable to read png image';
$self->{DEBUG} && print "loading a png file\n";
}
- if ( $input{type} eq 'bmp' ) {
+ if ( $input{'type'} eq 'bmp' ) {
$self->{IMG}=i_readbmp_wiol( $IO );
if ( !defined($self->{IMG}) ) {
- $self->{ERRSTR}='unable to read bmp image';
+ $self->{ERRSTR}=$self->_error_as_msg();
return undef;
}
$self->{DEBUG} && print "loading a bmp file\n";
}
- if ( $input{type} eq 'tga' ) {
+ if ( $input{'type'} eq 'gif' ) {
+ if ($input{colors} && !ref($input{colors})) {
+ # must be a reference to a scalar that accepts the colour map
+ $self->{ERRSTR} = "option 'colors' must be a scalar reference";
+ return undef;
+ }
+ if ($input{colors}) {
+ my $colors;
+ ($self->{IMG}, $colors) =i_readgif_wiol( $IO );
+ if ($colors) {
+ ${ $input{colors} } = [ map { NC(@$_) } @$colors ];
+ }
+ }
+ else {
+ $self->{IMG} =i_readgif_wiol( $IO );
+ }
+ if ( !defined($self->{IMG}) ) {
+ $self->{ERRSTR}=$self->_error_as_msg();
+ return undef;
+ }
+ $self->{DEBUG} && print "loading a gif file\n";
+ }
+
+ if ( $input{'type'} eq 'tga' ) {
$self->{IMG}=i_readtga_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed
if ( !defined($self->{IMG}) ) {
$self->{ERRSTR}=$self->_error_as_msg();
-# $self->{ERRSTR}='unable to read tga image';
return undef;
}
$self->{DEBUG} && print "loading a tga file\n";
}
- if ( $input{type} eq 'raw' ) {
+ if ( $input{'type'} eq 'rgb' ) {
+ $self->{IMG}=i_readrgb_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed
+ if ( !defined($self->{IMG}) ) {
+ $self->{ERRSTR}=$self->_error_as_msg();
+ return undef;
+ }
+ $self->{DEBUG} && print "loading a tga file\n";
+ }
+
+
+ if ( $input{'type'} eq 'raw' ) {
my %params=(datachannels=>3,storechannels=>3,interleave=>1,%input);
if ( !($params{xsize} && $params{ysize}) ) {
# Old code for reference while changing the new stuff
- if (!$input{type} and $input{file}) {
- $input{type}=$FORMATGUESS->($input{file});
+ if (!$input{'type'} and $input{file}) {
+ $input{'type'}=$FORMATGUESS->($input{file});
}
- if (!$input{type}) {
+ if (!$input{'type'}) {
$self->{ERRSTR}='type parameter missing and not possible to guess from extension'; return undef;
}
- if (!$formats{$input{type}}) {
+ if (!$formats{$input{'type'}}) {
$self->{ERRSTR}='format not supported';
return undef;
}
+ my ($fh, $fd);
if ($input{file}) {
$fh = new IO::File($input{file},"r");
if (!defined $fh) {
$fd=$input{fd};
}
- if ( $input{type} eq 'gif' ) {
+ if ( $input{'type'} eq 'gif' ) {
my $colors;
if ($input{colors} && !ref($input{colors})) {
# must be a reference to a scalar that accepts the colour map
compress=>1,
wierdpack=>0,
fax_fine=>1, @_);
- my ($fh, $rc, $fd, $IO);
+ my $rc;
- my %iolready=( tiff=>1, raw=>1, png=>1, pnm=>1, bmp=>1, jpeg=>1, tga=>1 ); # this will be SO MUCH BETTER once they are all in there
+ my %iolready=( tiff=>1, raw=>1, png=>1, pnm=>1, bmp=>1, jpeg=>1, tga=>1,
+ gif=>1 ); # this will be SO MUCH BETTER once they are all in there
unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
- if (!$input{file} and !$input{'fd'} and !$input{'data'}) { $self->{ERRSTR}='file/fd/data parameter missing'; return undef; }
- if (!$input{type} and $input{file}) { $input{type}=$FORMATGUESS->($input{file}); }
- if (!$input{type}) { $self->{ERRSTR}='type parameter missing and not possible to guess from extension'; return undef; }
+ if (!$input{'type'} and $input{file}) {
+ $input{'type'}=$FORMATGUESS->($input{file});
+ }
+ if (!$input{'type'}) {
+ $self->{ERRSTR}='type parameter missing and not possible to guess from extension';
+ return undef;
+ }
- if (!$formats{$input{type}}) { $self->{ERRSTR}='format not supported'; return undef; }
+ if (!$formats{$input{'type'}}) { $self->{ERRSTR}='format not supported'; return undef; }
- if (exists $input{'fd'}) {
- $fd=$input{'fd'};
- } elsif (exists $input{'data'}) {
- $IO = Imager::io_new_bufchain();
- } else {
- $fh = new IO::File($input{file},"w+");
- if (!defined $fh) { $self->{ERRSTR}='Could not open file'; return undef; }
- binmode($fh) or die;
- $fd = $fh->fileno();
- }
+ my ($IO, $fh) = $self->_get_writer_io(\%input, $input{'type'})
+ or return undef;
- if ($iolready{$input{type}}) {
- if (defined $fd) {
- $IO = io_new_fd($fd);
- }
+ # this conditional is probably obsolete
+ if ($iolready{$input{'type'}}) {
- if ($input{type} eq 'tiff') {
+ if ($input{'type'} eq 'tiff') {
if (defined $input{class} && $input{class} eq 'fax') {
if (!i_writetiff_wiol_faxable($self->{IMG}, $IO, $input{fax_fine})) {
$self->{ERRSTR}='Could not write to buffer';
return undef;
}
}
- } elsif ( $input{type} eq 'pnm' ) {
+ } elsif ( $input{'type'} eq 'pnm' ) {
if ( ! i_writeppm_wiol($self->{IMG},$IO) ) {
$self->{ERRSTR}='unable to write pnm image';
return undef;
}
$self->{DEBUG} && print "writing a pnm file\n";
- } elsif ( $input{type} eq 'raw' ) {
+ } elsif ( $input{'type'} eq 'raw' ) {
if ( !i_writeraw_wiol($self->{IMG},$IO) ) {
$self->{ERRSTR}='unable to write raw image';
return undef;
}
$self->{DEBUG} && print "writing a raw file\n";
- } elsif ( $input{type} eq 'png' ) {
+ } elsif ( $input{'type'} eq 'png' ) {
if ( !i_writepng_wiol($self->{IMG}, $IO) ) {
$self->{ERRSTR}='unable to write png image';
return undef;
}
$self->{DEBUG} && print "writing a png file\n";
- } elsif ( $input{type} eq 'jpeg' ) {
+ } elsif ( $input{'type'} eq 'jpeg' ) {
if ( !i_writejpeg_wiol($self->{IMG}, $IO, $input{jpegquality})) {
$self->{ERRSTR} = $self->_error_as_msg();
return undef;
}
$self->{DEBUG} && print "writing a jpeg file\n";
- } elsif ( $input{type} eq 'bmp' ) {
+ } elsif ( $input{'type'} eq 'bmp' ) {
if ( !i_writebmp_wiol($self->{IMG}, $IO) ) {
$self->{ERRSTR}='unable to write bmp image';
return undef;
}
$self->{DEBUG} && print "writing a bmp file\n";
- } elsif ( $input{type} eq 'tga' ) {
+ } elsif ( $input{'type'} eq 'tga' ) {
if ( !i_writetga_wiol($self->{IMG}, $IO, $input{wierdpack}, $input{compress}, $input{idstring}) ) {
$self->{ERRSTR}=$self->_error_as_msg();
return undef;
}
$self->{DEBUG} && print "writing a tga file\n";
+ } elsif ( $input{'type'} eq 'gif' ) {
+ # compatibility with the old interfaces
+ if ($input{gifquant} eq 'lm') {
+ $input{make_colors} = 'addi';
+ $input{translate} = 'perturb';
+ $input{perturb} = $input{lmdither};
+ } elsif ($input{gifquant} eq 'gen') {
+ # just pass options through
+ } else {
+ $input{make_colors} = 'webmap'; # ignored
+ $input{translate} = 'giflib';
+ }
+ $rc = i_writegif_wiol($IO, \%input, $self->{IMG});
}
if (exists $input{'data'}) {
${$input{data}} = $data;
}
return $self;
- } else {
- if ( $input{type} eq 'gif' ) {
- if (not $input{gifplanes}) {
- my $gp;
- my $count=i_count_colors($self->{IMG}, 256);
- $gp=8 if $count == -1;
- $gp=1 if not $gp and $count <= 2;
- $gp=2 if not $gp and $count <= 4;
- $gp=3 if not $gp and $count <= 8;
- $gp=4 if not $gp and $count <= 16;
- $gp=5 if not $gp and $count <= 32;
- $gp=6 if not $gp and $count <= 64;
- $gp=7 if not $gp and $count <= 128;
- $input{gifplanes} = $gp || 8;
- }
-
- if ($input{gifplanes}>8) {
- $input{gifplanes}=8;
- }
- if ($input{gifquant} eq 'gen' || $input{callback}) {
-
-
- if ($input{gifquant} eq 'lm') {
-
- $input{make_colors} = 'addi';
- $input{translate} = 'perturb';
- $input{perturb} = $input{lmdither};
- } elsif ($input{gifquant} eq 'gen') {
- # just pass options through
- } else {
- $input{make_colors} = 'webmap'; # ignored
- $input{translate} = 'giflib';
- }
-
- if ($input{callback}) {
- defined $input{maxbuffer} or $input{maxbuffer} = -1;
- $rc = i_writegif_callback($input{callback}, $input{maxbuffer},
- \%input, $self->{IMG});
- } else {
- $rc = i_writegif_gen($fd, \%input, $self->{IMG});
- }
-
- } elsif ($input{gifquant} eq 'lm') {
- $rc=i_writegif($self->{IMG},$fd,$input{gifplanes},$input{lmdither},$input{lmfixed});
- } else {
- $rc=i_writegifmc($self->{IMG},$fd,$input{gifplanes});
- }
- if ( !defined($rc) ) {
- $self->{ERRSTR} = "Writing GIF file: "._error_as_msg(); return undef;
- }
- $self->{DEBUG} && print "writing a gif file\n";
-
- }
}
+
return $self;
}
sub write_multi {
my ($class, $opts, @images) = @_;
- if ($opts->{type} eq 'gif') {
+ if (!$opts->{'type'} && $opts->{'file'}) {
+ $opts->{'type'} = $FORMATGUESS->($opts->{'file'});
+ }
+ unless ($opts->{'type'}) {
+ $class->_set_error('type parameter missing and not possible to guess from extension');
+ return;
+ }
+ # translate to ImgRaw
+ if (grep !UNIVERSAL::isa($_, 'Imager') || !$_->{IMG}, @images) {
+ $class->_set_error('Usage: Imager->write_multi({ options }, @images)');
+ return 0;
+ }
+ my @work = map $_->{IMG}, @images;
+ my ($IO, $file) = $class->_get_writer_io($opts, $opts->{'type'})
+ or return undef;
+ if ($opts->{'type'} eq 'gif') {
my $gif_delays = $opts->{gif_delays};
local $opts->{gif_delays} = $gif_delays;
- unless (ref $opts->{gif_delays}) {
+ if ($opts->{gif_delays} && !ref $opts->{gif_delays}) {
# assume the caller wants the same delay for each frame
$opts->{gif_delays} = [ ($gif_delays) x @images ];
}
- # translate to ImgRaw
- if (grep !UNIVERSAL::isa($_, 'Imager') || !$_->{IMG}, @images) {
- $ERRSTR = "Usage: Imager->write_multi({ options }, @images)";
- return 0;
- }
- my @work = map $_->{IMG}, @images;
- if ($opts->{callback}) {
- # Note: you may need to fix giflib for this one to work
- my $maxbuffer = $opts->{maxbuffer};
- defined $maxbuffer or $maxbuffer = -1; # max by default
- return i_writegif_callback($opts->{callback}, $maxbuffer,
- $opts, @work);
- }
- if ($opts->{fd}) {
- return i_writegif_gen($opts->{fd}, $opts, @work);
+ my $res = i_writegif_wiol($IO, $opts, @work);
+ $res or $class->_set_error($class->_error_as_msg());
+ return $res;
+ }
+ elsif ($opts->{'type'} eq 'tiff') {
+ my $res;
+ $opts->{fax_fine} = 1 unless exists $opts->{fax_fine};
+ if ($opts->{'class'} && $opts->{'class'} eq 'fax') {
+ $res = i_writetiff_multi_wiol_faxable($IO, $opts->{fax_fine}, @work);
}
else {
- my $fh = IO::File->new($opts->{file}, "w+");
- unless ($fh) {
- $ERRSTR = "Error creating $opts->{file}: $!";
- return 0;
- }
- binmode($fh);
- return i_writegif_gen(fileno($fh), $opts, @work);
+ $res = i_writetiff_multi_wiol($IO, @work);
}
+ $res or $class->_set_error($class->_error_as_msg());
+ return $res;
}
else {
- $ERRSTR = "Sorry, write_multi doesn't support $opts->{type} yet";
+ $ERRSTR = "Sorry, write_multi doesn't support $opts->{'type'} yet";
return 0;
}
}
sub read_multi {
my ($class, %opts) = @_;
- if ($opts{file} && !exists $opts{type}) {
+ if ($opts{file} && !exists $opts{'type'}) {
# guess the type
my $type = $FORMATGUESS->($opts{file});
- $opts{type} = $type;
+ $opts{'type'} = $type;
}
- unless ($opts{type}) {
+ unless ($opts{'type'}) {
$ERRSTR = "No type parameter supplied and it couldn't be guessed";
return;
}
- my $fd;
- my $file;
- if ($opts{file}) {
- $file = IO::File->new($opts{file}, "r");
- unless ($file) {
- $ERRSTR = "Could not open file $opts{file}: $!";
- return;
- }
- binmode $file;
- $fd = fileno($file);
- }
- elsif ($opts{fh}) {
- $fd = fileno($opts{fh});
- unless ($fd) {
- $ERRSTR = "File handle specified with fh option not open";
- return;
- }
- }
- elsif ($opts{fd}) {
- $fd = $opts{fd};
- }
- elsif ($opts{callback} || $opts{data}) {
- # don't fail here
- }
- else {
- $ERRSTR = "You need to specify one of file, fd, fh, callback or data";
- return;
- }
- if ($opts{type} eq 'gif') {
+ my ($IO, $file) = $class->_get_reader_io(\%opts, $opts{'type'})
+ or return;
+ if ($opts{'type'} eq 'gif') {
my @imgs;
- if ($fd) {
- @imgs = i_readgif_multi($fd);
+ @imgs = i_readgif_multi_wiol($IO);
+ if (@imgs) {
+ return map {
+ bless { IMG=>$_, DEBUG=>$DEBUG, ERRSTR=>undef }, 'Imager'
+ } @imgs;
}
else {
- if (Imager::i_giflib_version() < 4.0) {
- $ERRSTR = "giflib3.x does not support callbacks";
- return;
- }
- if ($opts{callback}) {
- @imgs = i_readgif_multi_callback($opts{callback})
- }
- else {
- @imgs = i_readgif_multi_scalar($opts{data});
- }
+ $ERRSTR = _error_as_msg();
+ return;
}
+ }
+ elsif ($opts{'type'} eq 'tiff') {
+ my @imgs = i_readtiff_multi_wiol($IO, -1);
if (@imgs) {
return map {
bless { IMG=>$_, DEBUG=>$DEBUG, ERRSTR=>undef }, 'Imager'
}
}
- $ERRSTR = "Cannot read multiple images from $opts{type} files";
+ $ERRSTR = "Cannot read multiple images from $opts{'type'} files";
return;
}
my %hsh;
unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
- if (!$input{type}) { $self->{ERRSTR}='type parameter missing'; return undef; }
+ if (!$input{'type'}) { $self->{ERRSTR}='type parameter missing'; return undef; }
- if ( (grep { $_ eq $input{type} } keys %filters) != 1) {
+ if ( (grep { $_ eq $input{'type'} } keys %filters) != 1) {
$self->{ERRSTR}='type parameter not matching any filter'; return undef;
}
- if ($filters{$input{type}}{names}) {
- my $names = $filters{$input{type}}{names};
+ if ($filters{$input{'type'}}{names}) {
+ my $names = $filters{$input{'type'}}{names};
for my $name (keys %$names) {
if (defined $input{$name} && exists $names->{$name}{$input{$name}}) {
$input{$name} = $names->{$name}{$input{$name}};
}
}
}
- if (defined($filters{$input{type}}{defaults})) {
- %hsh=('image',$self->{IMG},%{$filters{$input{type}}{defaults}},%input);
+ if (defined($filters{$input{'type'}}{defaults})) {
+ %hsh=('image',$self->{IMG},%{$filters{$input{'type'}}{defaults}},%input);
} else {
%hsh=('image',$self->{IMG},%input);
}
- my @cs=@{$filters{$input{type}}{callseq}};
+ my @cs=@{$filters{$input{'type'}}{callseq}};
for(@cs) {
if (!defined($hsh{$_})) {
- $self->{ERRSTR}="missing parameter '$_' for filter ".$input{type}; return undef;
+ $self->{ERRSTR}="missing parameter '$_' for filter ".$input{'type'}; return undef;
}
}
- &{$filters{$input{type}}{callsub}}(%hsh);
+ &{$filters{$input{'type'}}{callsub}}(%hsh);
my @b=keys %hsh;
sub scale {
my $self=shift;
- my %opts=(scalefactor=>0.5,type=>'max',qtype=>'normal',@_);
+ my %opts=(scalefactor=>0.5,'type'=>'max',qtype=>'normal',@_);
my $img = Imager->new();
my $tmp = Imager->new();
unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
- if ($opts{xpixels} and $opts{ypixels} and $opts{type}) {
+ if ($opts{xpixels} and $opts{ypixels} and $opts{'type'}) {
my ($xpix,$ypix)=( $opts{xpixels}/$self->getwidth() , $opts{ypixels}/$self->getheight() );
- if ($opts{type} eq 'min') { $opts{scalefactor}=min($xpix,$ypix); }
- if ($opts{type} eq 'max') { $opts{scalefactor}=max($xpix,$ypix); }
+ if ($opts{'type'} eq 'min') { $opts{scalefactor}=min($xpix,$ypix); }
+ if ($opts{'type'} eq 'max') { $opts{scalefactor}=max($xpix,$ypix); }
} elsif ($opts{xpixels}) { $opts{scalefactor}=$opts{xpixels}/$self->getwidth(); }
elsif ($opts{ypixels}) { $opts{scalefactor}=$opts{ypixels}/$self->getheight(); }
{op=>'-',trans=>'Sub'},
{op=>'*',trans=>'Mult'},
{op=>'/',trans=>'Div'},
- {op=>'-',type=>'unary',trans=>'u-'},
+ {op=>'-','type'=>'unary',trans=>'u-'},
{op=>'**'},
- {op=>'func',type=>'unary'}],
+ {op=>'func','type'=>'unary'}],
'grouping'=>[qw( \( \) )],
'func'=>[qw( sin cos )],
'vars'=>[qw( x y )]
$Imager::ERRSTR = Imager::Expr::error();
return;
}
-
+
my $img = Imager->new();
$img->{IMG} = i_transform2($opts->{width}, $opts->{height}, $code->code(),
$code->nregs(), $code->cregs(),
$Imager::ERRSTR = Imager->_error_as_msg();
return;
}
-
+
return $img;
}
}
if ($opts{filled}) {
+ my $color = _color($opts{'color'});
+ unless ($color) {
+ $self->{ERRSTR} = $Imager::ERRSTR;
+ return;
+ }
i_box_filled($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},
- $opts{ymax},$opts{color});
+ $opts{ymax}, $color);
}
elsif ($opts{fill}) {
unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
$opts{ymax},$opts{fill}{fill});
}
else {
- i_box($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},$opts{ymax},$opts{color});
+ my $color = _color($opts{'color'});
+ unless ($color) {
+ $self->{ERRSTR} = $Imager::ERRSTR;
+ return;
+ }
+ i_box($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},$opts{ymax},
+ $color);
}
return $self;
}
unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
# assume it's a hash ref
require 'Imager/Fill.pm';
- $opts{fill} = Imager::Fill->new(%{$opts{fill}});
+ unless ($opts{fill} = Imager::Fill->new(%{$opts{fill}})) {
+ $self->{ERRSTR} = $Imager::ERRSTR;
+ return;
+ }
}
i_arc_cfill($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},$opts{'d1'},
$opts{'d2'}, $opts{fill}{fill});
}
else {
+ my $color = _color($opts{'color'});
+ unless ($color) {
+ $self->{ERRSTR} = $Imager::ERRSTR;
+ return;
+ }
if ($opts{d1} == 0 && $opts{d2} == 361 && $opts{aa}) {
i_circle_aa($self->{IMG}, $opts{'x'}, $opts{'y'}, $opts{'r'},
- $opts{'color'});
+ $color);
}
else {
- # i_arc($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},$opts{'d1'}, $opts{'d2'},$opts{'color'});
- if ($opts{'d1'} <= $opts{'d2'}) { i_arc($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},$opts{'d1'},$opts{'d2'},$opts{'color'}); }
- else { i_arc($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},$opts{'d1'}, 361,$opts{'color'});
- i_arc($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'}, 0,$opts{'d2'},$opts{'color'}); }
+ if ($opts{'d1'} <= $opts{'d2'}) {
+ i_arc($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},
+ $opts{'d1'}, $opts{'d2'}, $color);
+ }
+ else {
+ i_arc($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},
+ $opts{'d1'}, 361, $color);
+ i_arc($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},
+ 0, $opts{'d2'}, $color);
+ }
}
}
unless (exists $opts{x1} and exists $opts{y1}) { $self->{ERRSTR}='missing begining coord'; return undef; }
unless (exists $opts{x2} and exists $opts{y2}) { $self->{ERRSTR}='missing ending coord'; return undef; }
+ my $color = _color($opts{'color'});
+ unless ($color) {
+ $self->{ERRSTR} = $Imager::ERRSTR;
+ return;
+ }
+ $opts{antialias} = $opts{aa} if defined $opts{aa};
if ($opts{antialias}) {
- i_line_aa($self->{IMG},$opts{x1}, $opts{y1}, $opts{x2}, $opts{y2}, $opts{color});
+ i_line_aa($self->{IMG},$opts{x1}, $opts{y1}, $opts{x2}, $opts{y2},
+ $color);
} else {
- i_draw($self->{IMG},$opts{x1}, $opts{y1}, $opts{x2}, $opts{y2}, $opts{color});
+ i_draw($self->{IMG},$opts{x1}, $opts{y1}, $opts{x2}, $opts{y2},
+ $color);
}
return $self;
}
# print Dumper(\@points);
+ my $color = _color($opts{'color'});
+ unless ($color) {
+ $self->{ERRSTR} = $Imager::ERRSTR;
+ return;
+ }
+ $opts{antialias} = $opts{aa} if defined $opts{aa};
if ($opts{antialias}) {
for $pt(@points) {
- if (defined($ls)) { i_line_aa($self->{IMG},$ls->[0],$ls->[1],$pt->[0],$pt->[1],$opts{color}); }
+ if (defined($ls)) {
+ i_line_aa($self->{IMG},$ls->[0],$ls->[1],$pt->[0],$pt->[1],$color);
+ }
$ls=$pt;
}
} else {
for $pt(@points) {
- if (defined($ls)) { i_draw($self->{IMG},$ls->[0],$ls->[1],$pt->[0],$pt->[1],$opts{color}); }
+ if (defined($ls)) {
+ i_draw($self->{IMG},$ls->[0],$ls->[1],$pt->[0],$pt->[1],$color);
+ }
$ls=$pt;
}
}
return $self;
}
-# this the multipoint bezier curve
+sub polygon {
+ my $self = shift;
+ my ($pt,$ls,@points);
+ my $dflcl = i_color_new(0,0,0,0);
+ my %opts = (color=>$dflcl, @_);
+
+ unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
+
+ if (exists($opts{points})) {
+ $opts{'x'} = [ map { $_->[0] } @{$opts{points}} ];
+ $opts{'y'} = [ map { $_->[1] } @{$opts{points}} ];
+ }
+
+ if (!exists $opts{'x'} or !exists $opts{'y'}) {
+ $self->{ERRSTR} = 'no points array, or x and y arrays.'; return undef;
+ }
+
+ if ($opts{'fill'}) {
+ unless (UNIVERSAL::isa($opts{'fill'}, 'Imager::Fill')) {
+ # assume it's a hash ref
+ require 'Imager/Fill.pm';
+ unless ($opts{'fill'} = Imager::Fill->new(%{$opts{'fill'}})) {
+ $self->{ERRSTR} = $Imager::ERRSTR;
+ return undef;
+ }
+ }
+ i_poly_aa_cfill($self->{IMG}, $opts{'x'}, $opts{'y'},
+ $opts{'fill'}{'fill'});
+ }
+ else {
+ my $color = _color($opts{'color'});
+ unless ($color) {
+ $self->{ERRSTR} = $Imager::ERRSTR;
+ return;
+ }
+ i_poly_aa($self->{IMG}, $opts{'x'}, $opts{'y'}, $color);
+ }
+
+ return $self;
+}
+
+
+# this the multipoint bezier curve
# this is here more for testing that actual usage since
# this is not a good algorithm. Usually the curve would be
# broken into smaller segments and each done individually.
return;
}
- i_bezier_multi($self->{IMG},$opts{'x'},$opts{'y'},$opts{'color'});
+ my $color = _color($opts{'color'});
+ unless ($color) {
+ $self->{ERRSTR} = $Imager::ERRSTR;
+ return;
+ }
+ i_bezier_multi($self->{IMG},$opts{'x'},$opts{'y'},$color);
return $self;
}
my $self = shift;
my %opts = ( color=>Imager::Color->new(255, 255, 255), @_ );
- unless (exists $opts{x} && exists $opts{'y'}) {
+ unless (exists $opts{'x'} && exists $opts{'y'}) {
$self->{ERRSTR} = "missing seed x and y parameters";
return undef;
}
-
+
if ($opts{fill}) {
unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
# assume it's a hash ref
require 'Imager/Fill.pm';
- $opts{fill} = Imager::Fill->new(%{$opts{fill}});
+ unless ($opts{fill} = Imager::Fill->new(%{$opts{fill}})) {
+ $self->{ERRSTR} = $Imager::ERRSTR;
+ return;
+ }
}
- i_flood_cfill($self->{IMG}, $opts{x}, $opts{'y'}, $opts{fill}{fill});
+ i_flood_cfill($self->{IMG}, $opts{'x'}, $opts{'y'}, $opts{fill}{fill});
}
else {
- i_flood_fill($self->{IMG}, $opts{x}, $opts{'y'}, $opts{color});
+ my $color = _color($opts{'color'});
+ unless ($color) {
+ $self->{ERRSTR} = $Imager::ERRSTR;
+ return;
+ }
+ i_flood_fill($self->{IMG}, $opts{'x'}, $opts{'y'}, $color);
}
$self;
sub getcolorcount {
my $self=shift;
- my %opts=(maxcolors=>2**30,@_);
+ my %opts=('maxcolors'=>2**30,@_);
if (!defined($self->{IMG})) { $self->{ERRSTR}='image is empty'; return undef; }
my $rc=i_count_colors($self->{IMG},$opts{'maxcolors'});
return ($rc==-1? undef : $rc);
ref $_[0] ? $_[0]->{ERRSTR} : $ERRSTR
}
+sub _set_error {
+ my ($self, $msg) = @_;
+
+ if (ref $self) {
+ $self->{ERRSTR} = $msg;
+ }
+ else {
+ $ERRSTR = $msg;
+ }
+}
+
# Default guess for the type of an image from extension
sub def_guess_type {
return 'png' if ($ext eq "png");
return 'bmp' if ($ext eq "bmp" || $ext eq "dib");
return 'tga' if ($ext eq "tga");
+ return 'rgb' if ($ext eq "rgb");
return 'gif' if ($ext eq "gif");
+ return 'raw' if ($ext eq "raw");
return ();
}
=head1 SYNOPSIS
- use Imager qw(init);
+ use Imager;
- init();
$img = Imager->new();
$img->open(file=>'image.ppm',type=>'pnm')
|| print "failed: ",$img->{ERRSTR},"\n";
=head2 Reading and writing images
+You can read and write a variety of images formats, assuming you have
+the appropriate libraries, and images can be read or written to/from
+files, file handles, file descriptors, scalars, or through callbacks.
+
+To see which image formats Imager is compiled to support the following
+code snippet is sufficient:
+
+ use Imager;
+ print join " ", keys %Imager::formats;
+
+This will include some other information identifying libraries rather
+than file formats.
+
+Reading writing to and from files is simple, use the C<read()>
+method to read an image:
+
+ my $img = Imager->new;
+ $img->read(file=>$filename, type=>$type)
+ or die "Cannot read $filename: ", $img->errstr;
+
+and the C<write()> method to write an image:
+
+ $img->write(file=>$filename, type=>$type)
+ or die "Cannot write $filename: ", $img->errstr;
+
+If the I<filename> includes an extension that Imager recognizes, then
+you don't need the I<type>, but you may want to provide one anyway.
+Imager currently does not check the files magic to determine the
+format. It is possible to override the method for determining the
+filetype from the filename. If the data is given in another form than
+a file name a
+
+When you read an image, Imager may set some tags, possibly including
+information about the spatial resolution, textual information, and
+animation information. See L</Tags> for specifics.
+
+When reading or writing you can specify one of a variety of sources or
+targets:
+
+=over
+
+=item file
+
+The C<file> parameter is the name of the image file to be written to
+or read from. If Imager recognizes the extension of the file you do
+not need to supply a C<type>.
+
+=item fh
+
+C<fh> is a file handle, typically either returned from
+C<<IO::File->new()>>, or a glob from an C<open> call. You should call
+C<binmode> on the handle before passing it to Imager.
+
+=item fd
+
+C<fd> is a file descriptor. You can get this by calling the
+C<fileno()> function on a file handle, or by using one of the standard
+file descriptor numbers.
+
+=item data
+
+When reading data, C<data> is a scalar containing the image file data,
+when writing, C<data> is a reference to the scalar to save the image
+file data too. For GIF images you will need giflib 4 or higher, and
+you may need to patch giflib to use this option for writing.
+
+=item callback
+
+Imager will make calls back to your supplied coderefs to read, write
+and seek from/to/through the image file.
+
+When reading from a file you can use either C<callback> or C<readcb>
+to supply the read callback, and when writing C<callback> or
+C<writecb> to supply the write callback.
+
+When writing you can also supply the C<maxbuffer> option to set the
+maximum amount of data that will be buffered before your write
+callback is called. Note: the amount of data supplied to your
+callback can be smaller or larger than this size.
+
+The read callback is called with 2 parameters, the minimum amount of
+data required, and the maximum amount that Imager will store in it's C
+level buffer. You may want to return the minimum if you have a slow
+data source, or the maximum if you have a fast source and want to
+prevent many calls to your perl callback. The read data should be
+returned as a scalar.
+
+Your write callback takes exactly one parameter, a scalar containing
+the data to be written. Return true for success.
+
+The seek callback takes 2 parameters, a I<POSITION>, and a I<WHENCE>,
+defined in the same way as perl's seek function.
+
+You can also supply a C<closecb> which is called with no parameters
+when there is no more data to be written. This could be used to flush
+buffered data.
+
+=back
+
C<$img-E<gt>read()> generally takes two parameters, 'file' and 'type'.
If the type of the file can be determined from the suffix of the file
it can be omitted. Format dependant parameters are: For images of
much more cpu time but also gives considerable better results than the
median cut algorithm.
+When storing targa images rle compression can be activated with the
+'compress' parameter, the 'idstring' parameter can be used to set the
+targa comment field and the 'wierdpack' option can be used to use the
+15 and 16 bit targa formats for rgb and rgba data. The 15 bit format
+has 5 of each red, green and blue. The 16 bit format in addition
+allows 1 bit of alpha. The most significant bits are used for each
+channel.
+
Currently just for gif files, you can specify various options for the
conversion from Imager's internal RGB format to the target's indexed
file format. If you set the gifquant option to 'gen', you can use the
DOCUMENTATION OF THIS SECTION OUT OF SYNC
It is possible to draw with graphics primitives onto images. Such
-primitives include boxes, arcs, circles and lines. A reference
-oriented list follows.
+primitives include boxes, arcs, circles, polygons and lines. A
+reference oriented list follows.
Box:
$img->box(color=>$blue,xmin=>10,ymin=>30,xmax=>200,ymax=>300,filled=>1);
This creates a filled red arc with a 'center' at (200, 100) and spans
10 degrees and the slice has a radius of 20. SEE section on BUGS.
-Both the arc() and box() methods can take a C<fill> parameter which
-can either be an Imager::Fill object, or a reference to a hash
-containing the parameters used to create the fill:
-
- $img->box(xmin=>10, ymin=>30, xmax=>150, ymax=>60,
- fill => { hatch=>'cross2' });
- use Imager::Fill;
- my $fill = Imager::Fill->new(hatch=>'stipple');
- $img->box(fill=>$fill);
-
-See L<Imager::Fill> for the type of fills you can use.
-
Circle:
$img->circle(color=>$green, r=50, x=>200, y=>100);
radius of 20.
Line:
- $img->line(color=>$green, x1=10, x2=>100,
- y1=>20, y2=>50, antialias=>1 );
+ $img->line(color=>$green, x1=>10, x2=>100,
+ y1=>20, y2=>50, aa=>1 );
That draws an antialiased line from (10,100) to (20,50).
+The I<antialias> parameter is still available for backwards compatibility.
+
Polyline:
$img->polyline(points=>[[$x0,$y0],[$x1,$y1],[$x2,$y2]],color=>$red);
- $img->polyline(x=>[$x0,$x1,$x2], y=>[$y0,$y1,$y2], antialias=>1);
+ $img->polyline(x=>[$x0,$x1,$x2], y=>[$y0,$y1,$y2], aa=>1);
Polyline is used to draw multilple lines between a series of points.
The point set can either be specified as an arrayref to an array of
array references (where each such array represents a point). The
other way is to specify two array references.
+The I<antialias> parameter is still available for backwards compatibility.
+
+Polygon:
+ $img->polygon(points=>[[$x0,$y0],[$x1,$y1],[$x2,$y2]],color=>$red);
+ $img->polygon(x=>[$x0,$x1,$x2], y=>[$y0,$y1,$y2]);
+
+Polygon is used to draw a filled polygon. Currently the polygon is
+always drawn antialiased, although that will change in the future.
+Like other antialiased drawing functions its coordinates can be
+specified with floating point values.
+
+Flood Fill:
+
You can fill a region that all has the same color using the
flood_fill() method, for example:
will fill all regions the same color connected to the point (50, 50).
-You can also use a general fill, so you could fill the same region
-with a check pattern using:
+The arc(), box(), polygon() and flood_fill() methods can take a
+C<fill> parameter which can either be an Imager::Fill object, or a
+reference to a hash containing the parameters used to create the fill:
- $img->flood_fill(x=>50, y=>50, fill=>{ hatch=>'check2x2' });
+ $img->box(xmin=>10, ymin=>30, xmax=>150, ymax=>60,
+ fill => { hatch=>'cross2' });
+ use Imager::Fill;
+ my $fill = Imager::Fill->new(hatch=>'stipple');
+ $img->box(fill=>$fill);
-See L<Imager::Fill> for more information on general fills.
+Currently you can create opaque or transparent plain color fills,
+hatched fills, image based fills and fountain fills. See
+L<Imager::Fill> for more information.
+
+The C<color> parameter for any of the drawing methods can be an
+L<Imager::Color> object, a simple scalar that Imager::Color can
+understand, a hashref of parameters that Imager::Color->new
+understands, or an arrayref of red, green, blue values.
=head2 Text rendering
both are given the one resulting in a larger image is used. example:
C<$img> is 700 pixels wide and 500 pixels tall.
- $img->scale(xpixels=>400); # 400x285
- $img->scale(ypixels=>400); # 560x400
+ $newimg = $img->scale(xpixels=>400); # 400x285
+ $newimg = $img->scale(ypixels=>400); # 560x400
- $img->scale(xpixels=>400,ypixels=>400); # 560x400
- $img->scale(xpixels=>400,ypixels=>400,type=>min); # 400x285
+ $newimg = $img->scale(xpixels=>400,ypixels=>400); # 560x400
+ $newimg = $img->scale(xpixels=>400,ypixels=>400,type=>min); # 400x285
- $img->scale(scalefactor=>0.25); 175x125 $img->scale(); # 350x250
+ $newimg = $img->scale(scalefactor=>0.25); 175x125
+ $newimg = $img->scale(); # 350x250
if you want to create low quality previews of images you can pass
C<qtype=E<gt>'preview'> to scale and it will use nearest neighbor
dyntest.c modified and recompiled.
load_plugin("dynfilt/dyntest.so") || die "unable to load plugin\n";
- $img->filter(%hsh);
+ $img->filter(%hsh);
-An example plugin comes with the module - Please send feedback to
+An example plugin comes with the module - Please send feedback to
addi@umich.edu if you test this.
Note: This seems to test ok on the following systems:
The value of the ResolutionUnit tag. This is ignored on writing if
the i_aspect_only tag is non-zero.
+=item tiff_documentname
+
+=item tiff_imagedescription
+
+=item tiff_make
+
+=item tiff_model
+
+=item tiff_pagename
+
+=item tiff_software
+
+=item tiff_datetime
+
+=item tiff_artist
+
+=item tiff_hostcomputer
+
+Various strings describing the image. tiff_datetime must be formatted
+as "YYYY:MM:DD HH:MM:SS". These correspond directly to the mixed case
+names in the TIFF specification. These are set in images read from a
+TIFF and save when writing a TIFF image.
+
=back
The following tags are set when a Windows BMP file is read:
as a ratio only. If the image format does not support aspect ratios
then this is scaled so the smaller value is 72dpi.
+=item i_incomplete
+
+If this tag is present then the whole image could not be read. This
+isn't implemented for all images yet.
+
=back
=head1 BUGS
=head1 SEE ALSO
-perl(1), Imager::Color(3), Imager::Font(3), Imager::Matrix2d(3),
+perl(1), Imager::Color(3), Imager::Font(3), Imager::Matrix2d(3),
Affix::Infix2Postfix(3), Parse::RecDescent(3)
http://www.eecs.umich.edu/~addi/perl/Imager/
projects / imager.git / blobdiff