X-Git-Url: http://git.imager.perl.org/imager.git/blobdiff_plain/7581284100ae1c2ccbb921764d53e2af721f3ded..b96f5e9e574301854c7f78f3f55a40f3cc5e85e9:/Imager.pm diff --git a/Imager.pm b/Imager.pm index 1cc70d72..d8417145 100644 --- a/Imager.pm +++ b/Imager.pm @@ -1,7 +1,7 @@ package Imager; use strict; -use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS %formats $DEBUG %filters %DSOs $ERRSTR $fontstate %OPCODES $I2P $FORMATGUESS $warn_obsolete); +use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS %formats $DEBUG %filters %DSOs $ERRSTR %OPCODES $I2P $FORMATGUESS $warn_obsolete); use IO::File; use Imager::Color; @@ -19,17 +19,11 @@ use Imager::Font; unload_plugin i_list_formats - i_has_format i_color_new i_color_set i_color_info - i_img_empty - i_img_empty_ch - i_img_exorcise - i_img_destroy - i_img_info i_img_setmask @@ -61,37 +55,11 @@ use Imager::Font; i_img_diff - i_init_fonts - i_t1_new - i_t1_destroy - i_t1_set_aa - i_t1_cp - i_t1_text - i_t1_bbox - i_tt_set_aa i_tt_cp i_tt_text i_tt_bbox - i_readjpeg_wiol - i_writejpeg_wiol - - i_readtiff_wiol - i_writetiff_wiol - i_writetiff_wiol_faxable - - i_readpng_wiol - i_writepng_wiol - - i_readgif - i_readgif_wiol - i_readgif_callback - i_writegif - i_writegifmc - i_writegif_gen - i_writegif_callback - i_readpnm_wiol i_writeppm_wiol @@ -121,14 +89,6 @@ use Imager::Font; ); @EXPORT=qw( - init_log - i_list_formats - i_has_format - malloc_state - i_color_new - - i_img_empty - i_img_empty_ch ); %EXPORT_TAGS= @@ -154,6 +114,13 @@ my %writers; # modules we attempted to autoload my %attempted_to_load; +# errors from loading files +my %file_load_errors; + +# what happened when we tried to load +my %reader_load_errors; +my %writer_load_errors; + # library keys that are image file formats my %file_formats = map { $_ => 1 } qw/tiff pnm gif png jpeg raw bmp tga/; @@ -172,27 +139,31 @@ my %defaults; BEGIN { require Exporter; - @ISA = qw(Exporter); - $VERSION = '0.75'; - eval { - require XSLoader; - XSLoader::load(Imager => $VERSION); - 1; - } or do { - require DynaLoader; - push @ISA, 'DynaLoader'; - bootstrap Imager $VERSION; + my $ex_version = eval $Exporter::VERSION; + if ($ex_version < 5.57) { + @ISA = qw(Exporter); } + $VERSION = '0.93'; + require XSLoader; + XSLoader::load(Imager => $VERSION); } -BEGIN { - Imager::Font::__init(); - for(i_list_formats()) { $formats{$_}++; } +my %formats_low; +my %format_classes = + ( + png => "Imager::File::PNG", + gif => "Imager::File::GIF", + tiff => "Imager::File::TIFF", + jpeg => "Imager::File::JPEG", + w32 => "Imager::Font::W32", + ft2 => "Imager::Font::FT2", + t1 => "Imager::Font::T1", + ); - if (!$formats{'t1'} and !$formats{'tt'} - && !$formats{'ft2'} && !$formats{'w32'}) { - $fontstate='no font support'; - } +tie %formats, "Imager::FORMATS", \%formats_low, \%format_classes; + +BEGIN { + for(i_list_formats()) { $formats_low{$_}++; } %OPCODES=(Add=>[0],Sub=>[1],Mult=>[2],Div=>[3],Parm=>[4],'sin'=>[5],'cos'=>[6],'x'=>[4,0],'y'=>[4,1]); @@ -225,6 +196,13 @@ BEGIN { callsub => sub { my %hsh=@_; i_hardinvert($hsh{image}); } }; + $filters{hardinvertall} = + { + callseq => ['image'], + defaults => { }, + callsub => sub { my %hsh=@_; i_hardinvertall($hsh{image}); } + }; + $filters{autolevels} ={ callseq => ['image','lsat','usat','skew'], defaults => { lsat=>0.1,usat=>0.1,skew=>0.0 }, @@ -463,28 +441,67 @@ sub import { } sub init_log { - i_init_log($_[0],$_[1]); - i_log_entry("Imager $VERSION starting\n", 1); + Imager->open_log(log => $_[0], level => $_[1]); } sub init { my %parms=(loglevel=>1,@_); - if ($parms{'log'}) { - init_log($parms{'log'},$parms{'loglevel'}); - } if (exists $parms{'warn_obsolete'}) { $warn_obsolete = $parms{'warn_obsolete'}; } -# if ($parms{T1LIB_CONFIG}) { $ENV{T1LIB_CONFIG}=$parms{T1LIB_CONFIG}; } -# if ( $ENV{T1LIB_CONFIG} and ( $fontstate eq 'missing conf' )) { -# i_init_fonts(); -# $fontstate='ok'; -# } + if ($parms{'log'}) { + Imager->open_log(log => $parms{log}, level => $parms{loglevel}) + or return; + } + if (exists $parms{'t1log'}) { - i_init_fonts($parms{'t1log'}); + if ($formats{t1}) { + if (Imager::Font::T1::i_init_t1($parms{'t1log'})) { + Imager->_set_error(Imager->_error_as_msg); + return; + } + } + } + + return 1; +} + +{ + my $is_logging = 0; + + sub open_log { + my $class = shift; + my (%opts) = ( loglevel => 1, @_ ); + + $is_logging = i_init_log($opts{log}, $opts{loglevel}); + unless ($is_logging) { + Imager->_set_error(Imager->_error_as_msg()); + return; + } + + Imager->log("Imager $VERSION starting\n", 1); + + return $is_logging; + } + + sub close_log { + i_init_log(undef, -1); + $is_logging = 0; + } + + sub log { + my ($class, $message, $level) = @_; + + defined $level or $level = 1; + + i_log_entry($message, $level); + } + + sub is_logging { + return $is_logging; } } @@ -600,11 +617,13 @@ sub _combine { } sub _valid_image { - my ($self) = @_; + my ($self, $method) = @_; $self->{IMG} and return 1; - $self->_set_error('empty input image'); + my $msg = 'empty input image'; + $msg = "$method: $msg" if $method; + $self->_set_error($msg); return; } @@ -889,8 +908,8 @@ sub img_set { $self->{IMG} = i_img_16_new($hsh{xsize}, $hsh{ysize}, $hsh{channels}); } else { - $self->{IMG}=Imager::ImgRaw::new($hsh{'xsize'}, $hsh{'ysize'}, - $hsh{'channels'}); + $self->{IMG}= i_img_8_new($hsh{'xsize'}, $hsh{'ysize'}, + $hsh{'channels'}); } unless ($self->{IMG}) { @@ -917,11 +936,16 @@ sub masked { $result->{IMG} = i_img_masked_new($self->{IMG}, $mask, $opts{left}, $opts{top}, $opts{right} - $opts{left}, $opts{bottom} - $opts{top}); + unless ($result->{IMG}) { + $self->_set_error(Imager->_error_as_msg); + return; + } + # keep references to the mask and base images so they don't # disappear on us $result->{DEPENDS} = [ $self->{IMG}, $mask ]; - $result; + return $result; } # convert an RGB image into a paletted image @@ -941,24 +965,40 @@ sub to_paletted { return; } + $self->_valid_image + or return; + my $result = Imager->new; - $result->{IMG} = i_img_to_pal($self->{IMG}, $opts); + unless ($result->{IMG} = i_img_to_pal($self->{IMG}, $opts)) { + $self->_set_error(Imager->_error_as_msg); + return; + } - #print "Type ", i_img_type($result->{IMG}), "\n"; + return $result; +} - if ($result->{IMG}) { - return $result; - } - else { - $self->{ERRSTR} = $self->_error_as_msg; +sub make_palette { + my ($class, $quant, @images) = @_; + + unless (@images) { + Imager->_set_error("make_palette: supply at least one image"); return; } + my $index = 1; + for my $img (@images) { + unless ($img->{IMG}) { + Imager->_set_error("make_palette: image $index is empty"); + return; + } + ++$index; + } + + return i_img_make_palette($quant, map $_->{IMG}, @images); } -# convert a paletted (or any image) to an 8-bit/channel RGB images +# convert a paletted (or any image) to an 8-bit/channel RGB image sub to_rgb8 { my $self = shift; - my $result; unless (defined wantarray) { my @caller = caller; @@ -966,30 +1006,57 @@ sub to_rgb8 { return; } - if ($self->{IMG}) { - $result = Imager->new; - $result->{IMG} = i_img_to_rgb($self->{IMG}) - or undef $result; + $self->_valid_image + or return; + + my $result = Imager->new; + unless ($result->{IMG} = i_img_to_rgb($self->{IMG})) { + $self->_set_error(Imager->_error_as_msg()); + return; } return $result; } -# convert a paletted (or any image) to an 8-bit/channel RGB images +# convert a paletted (or any image) to a 16-bit/channel RGB image sub to_rgb16 { my $self = shift; - my $result; unless (defined wantarray) { my @caller = caller; - warn "to_rgb16() called in void context - to_rgb8() returns the converted image at $caller[1] line $caller[2]\n"; + warn "to_rgb16() called in void context - to_rgb16() returns the converted image at $caller[1] line $caller[2]\n"; return; } - if ($self->{IMG}) { - $result = Imager->new; - $result->{IMG} = i_img_to_rgb16($self->{IMG}) - or undef $result; + $self->_valid_image + or return; + + my $result = Imager->new; + unless ($result->{IMG} = i_img_to_rgb16($self->{IMG})) { + $self->_set_error(Imager->_error_as_msg()); + return; + } + + return $result; +} + +# convert a paletted (or any image) to an double/channel RGB image +sub to_rgb_double { + my $self = shift; + + unless (defined wantarray) { + my @caller = caller; + warn "to_rgb16() called in void context - to_rgb_double() returns the converted image at $caller[1] line $caller[2]\n"; + return; + } + + $self->_valid_image + or return; + + my $result = Imager->new; + unless ($result->{IMG} = i_img_to_drgb($self->{IMG})) { + $self->_set_error(Imager->_error_as_msg()); + return; } return $result; @@ -1278,13 +1345,17 @@ sub _get_reader_io { } sub _get_writer_io { - my ($self, $input, $type) = @_; + my ($self, $input) = @_; + + my $buffered = exists $input->{buffered} ? $input->{buffered} : 1; + my $io; + my @extras; if ($input->{io}) { - return $input->{io}; + $io = $input->{io}; } elsif ($input->{fd}) { - return io_new_fd($input->{fd}); + $io = io_new_fd($input->{fd}); } elsif ($input->{fh}) { my $fd = fileno($input->{fh}); @@ -1297,7 +1368,7 @@ sub _get_writer_io { # flush anything that's buffered, and make sure anything else is flushed $| = 1; select($oldfh); - return io_new_fd($fd); + $io = io_new_fd($fd); } elsif ($input->{file}) { my $fh = new IO::File($input->{file},"w+"); @@ -1306,28 +1377,30 @@ sub _get_writer_io { return; } binmode($fh) or die; - return (io_new_fd(fileno($fh)), $fh); + $io = io_new_fd(fileno($fh)); + push @extras, $fh; } elsif ($input->{data}) { - return io_new_bufchain(); + $io = 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}); + if ($input->{maxbuffer} && $input->{maxbuffer} == 1) { + $buffered = 0; } + $io = 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; } + + unless ($buffered) { + $io->set_buffered(0); + } + + return ($io, @extras); } # Read an image from file @@ -1345,52 +1418,39 @@ sub read { my ($IO, $fh) = $self->_get_reader_io(\%input) or return; - unless ($input{'type'}) { - $input{'type'} = i_test_format_probe($IO, -1); + my $type = $input{'type'}; + unless ($type) { + $type = i_test_format_probe($IO, -1); + } + + if ($input{file} && !$type) { + # guess the type + $type = $FORMATGUESS->($input{file}); } - unless ($input{'type'}) { - $self->_set_error('type parameter missing and not possible to guess from extension'); + unless ($type) { + my $msg = "type parameter missing and it couldn't be determined from the file contents"; + $input{file} and $msg .= " or file name"; + $self->_set_error($msg); return undef; } - _reader_autoload($input{type}); + _reader_autoload($type); - if ($readers{$input{type}} && $readers{$input{type}}{single}) { - return $readers{$input{type}}{single}->($self, $IO, %input); + if ($readers{$type} && $readers{$type}{single}) { + return $readers{$type}{single}->($self, $IO, %input); } - unless ($formats{$input{'type'}}) { + unless ($formats_low{$type}) { my $read_types = join ', ', sort Imager->read_types(); - $self->_set_error("format '$input{'type'}' not supported - formats $read_types available for reading"); + $self->_set_error("format '$type' not supported - formats $read_types available for reading - $reader_load_errors{$type}"); return; } - # Setup data source - if ( $input{'type'} eq 'jpeg' ) { - ($self->{IMG},$self->{IPTCRAW}) = i_readjpeg_wiol( $IO ); - if ( !defined($self->{IMG}) ) { - $self->{ERRSTR}=$self->_error_as_msg(); return undef; - } - $self->{DEBUG} && print "loading a jpeg file\n"; - return $self; - } - my $allow_incomplete = $input{allow_incomplete}; defined $allow_incomplete or $allow_incomplete = 0; - if ( $input{'type'} eq 'tiff' ) { - my $page = $input{'page'}; - defined $page or $page = 0; - $self->{IMG}=i_readtiff_wiol( $IO, $allow_incomplete, $page ); - if ( !defined($self->{IMG}) ) { - $self->{ERRSTR}=$self->_error_as_msg(); return undef; - } - $self->{DEBUG} && print "loading a tiff file\n"; - return $self; - } - - if ( $input{'type'} eq 'pnm' ) { + if ( $type eq 'pnm' ) { $self->{IMG}=i_readpnm_wiol( $IO, $allow_incomplete ); if ( !defined($self->{IMG}) ) { $self->{ERRSTR}='unable to read pnm image: '._error_as_msg(); @@ -1400,16 +1460,7 @@ sub read { return $self; } - 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} = $self->_error_as_msg(); - return undef; - } - $self->{DEBUG} && print "loading a png file\n"; - } - - if ( $input{'type'} eq 'bmp' ) { + if ( $type eq 'bmp' ) { $self->{IMG}=i_readbmp_wiol( $IO, $allow_incomplete ); if ( !defined($self->{IMG}) ) { $self->{ERRSTR}=$self->_error_as_msg(); @@ -1418,42 +1469,7 @@ sub read { $self->{DEBUG} && print "loading a bmp file\n"; } - 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{'gif_consolidate'}) { - 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 ); - } - } - else { - my $page = $input{'page'}; - defined $page or $page = 0; - $self->{IMG} = i_readgif_single_wiol( $IO, $page ); - if ($self->{IMG} && $input{colors}) { - ${ $input{colors} } = - [ i_getcolors($self->{IMG}, 0, i_colorcount($self->{IMG})) ]; - } - } - - 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' ) { + if ( $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(); @@ -1462,7 +1478,7 @@ sub read { $self->{DEBUG} && print "loading a tga file\n"; } - if ( $input{'type'} eq 'raw' ) { + if ( $type eq 'raw' ) { unless ( $input{xsize} && $input{ysize} ) { $self->_set_error('missing xsize or ysize parameter for raw'); return undef; @@ -1561,60 +1577,87 @@ sub write_types { return keys %types; } +sub _load_file { + my ($file, $error) = @_; + + if ($attempted_to_load{$file}) { + if ($file_load_errors{$file}) { + $$error = $file_load_errors{$file}; + return 0; + } + else { + return 1; + } + } + else { + local $SIG{__DIE__}; + my $loaded = eval { + ++$attempted_to_load{$file}; + require $file; + return 1; + }; + if ($loaded) { + return 1; + } + else { + my $work = $@ || "Unknown error"; + chomp $work; + $work =~ s/\n?Compilation failed in require at .*Imager\.pm line .*\z//m; + $work =~ s/\n/\\n/g; + $work =~ s/\s*\.?\z/ loading $file/; + $file_load_errors{$file} = $work; + $$error = $work; + return 0; + } + } +} + # probes for an Imager::File::whatever module sub _reader_autoload { my $type = shift; - return if $formats{$type} || $readers{$type}; + return if $formats_low{$type} || $readers{$type}; return unless $type =~ /^\w+$/; my $file = "Imager/File/\U$type\E.pm"; - unless ($attempted_to_load{$file}) { - eval { - ++$attempted_to_load{$file}; - require $file; - }; - if ($@) { - # try to get a reader specific module - my $file = "Imager/File/\U$type\EReader.pm"; - unless ($attempted_to_load{$file}) { - eval { - ++$attempted_to_load{$file}; - require $file; - }; - } + my $error; + my $loaded = _load_file($file, \$error); + if (!$loaded && $error =~ /^Can't locate /) { + my $filer = "Imager/File/\U$type\EReader.pm"; + $loaded = _load_file($filer, \$error); + if ($error =~ /^Can't locate /) { + $error = "Can't locate $file or $filer"; } } + unless ($loaded) { + $reader_load_errors{$type} = $error; + } } # probes for an Imager::File::whatever module sub _writer_autoload { my $type = shift; - return if $formats{$type} || $readers{$type}; + return if $formats_low{$type} || $writers{$type}; return unless $type =~ /^\w+$/; my $file = "Imager/File/\U$type\E.pm"; - unless ($attempted_to_load{$file}) { - eval { - ++$attempted_to_load{$file}; - require $file; - }; - if ($@) { - # try to get a writer specific module - my $file = "Imager/File/\U$type\EWriter.pm"; - unless ($attempted_to_load{$file}) { - eval { - ++$attempted_to_load{$file}; - require $file; - }; - } + my $error; + my $loaded = _load_file($file, \$error); + if (!$loaded && $error =~ /^Can't locate /) { + my $filew = "Imager/File/\U$type\EWriter.pm"; + $loaded = _load_file($filew, \$error); + if ($error =~ /^Can't locate /) { + $error = "Can't locate $file or $filew"; } } + unless ($loaded) { + $writer_load_errors{$type} = $error; + } } sub _fix_gif_positions { @@ -1733,52 +1776,36 @@ sub write { unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; } - if (!$input{'type'} and $input{file}) { - $input{'type'}=$FORMATGUESS->($input{file}); + my $type = $input{'type'}; + if (!$type and $input{file}) { + $type = $FORMATGUESS->($input{file}); } - if (!$input{'type'}) { + unless ($type) { $self->{ERRSTR}='type parameter missing and not possible to guess from extension'; return undef; } - _writer_autoload($input{type}); + _writer_autoload($type); my ($IO, $fh); - if ($writers{$input{type}} && $writers{$input{type}}{single}) { - ($IO, $fh) = $self->_get_writer_io(\%input, $input{'type'}) + if ($writers{$type} && $writers{$type}{single}) { + ($IO, $fh) = $self->_get_writer_io(\%input) or return undef; - $writers{$input{type}}{single}->($self, $IO, %input) + $writers{$type}{single}->($self, $IO, %input, type => $type) or return undef; } else { - if (!$formats{$input{'type'}}) { + if (!$formats_low{$type}) { my $write_types = join ', ', sort Imager->write_types(); - $self->_set_error("format '$input{'type'}' not supported - formats $write_types available for writing"); + $self->_set_error("format '$type' not supported - formats $write_types available for writing - $writer_load_errors{$type}"); return undef; } - ($IO, $fh) = $self->_get_writer_io(\%input, $input{'type'}) + ($IO, $fh) = $self->_get_writer_io(\%input, $type) or return undef; - - if ($input{'type'} eq 'tiff') { - $self->_set_opts(\%input, "tiff_", $self) - or return undef; - $self->_set_opts(\%input, "exif_", $self) - or return undef; - - if (defined $input{class} && $input{class} eq 'fax') { - if (!i_writetiff_wiol_faxable($self->{IMG}, $IO, $input{fax_fine})) { - $self->{ERRSTR} = $self->_error_as_msg(); - return undef; - } - } else { - if (!i_writetiff_wiol($self->{IMG}, $IO)) { - $self->{ERRSTR} = $self->_error_as_msg(); - return undef; - } - } - } elsif ( $input{'type'} eq 'pnm' ) { + + if ( $type eq 'pnm' ) { $self->_set_opts(\%input, "pnm_", $self) or return undef; if ( ! i_writeppm_wiol($self->{IMG},$IO) ) { @@ -1786,7 +1813,8 @@ sub write { return undef; } $self->{DEBUG} && print "writing a pnm file\n"; - } elsif ( $input{'type'} eq 'raw' ) { + } + elsif ( $type eq 'raw' ) { $self->_set_opts(\%input, "raw_", $self) or return undef; if ( !i_writeraw_wiol($self->{IMG},$IO) ) { @@ -1794,25 +1822,8 @@ sub write { return undef; } $self->{DEBUG} && print "writing a raw file\n"; - } elsif ( $input{'type'} eq 'png' ) { - $self->_set_opts(\%input, "png_", $self) - or return undef; - 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' ) { - $self->_set_opts(\%input, "jpeg_", $self) - or return undef; - $self->_set_opts(\%input, "exif_", $self) - or return undef; - 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 ( $type eq 'bmp' ) { $self->_set_opts(\%input, "bmp_", $self) or return undef; if ( !i_writebmp_wiol($self->{IMG}, $IO) ) { @@ -1820,7 +1831,8 @@ sub write { return undef; } $self->{DEBUG} && print "writing a bmp file\n"; - } elsif ( $input{'type'} eq 'tga' ) { + } + elsif ( $type eq 'tga' ) { $self->_set_opts(\%input, "tga_", $self) or return undef; @@ -1829,24 +1841,6 @@ sub write { return undef; } $self->{DEBUG} && print "writing a tga file\n"; - } elsif ( $input{'type'} eq 'gif' ) { - $self->_set_opts(\%input, "gif_", $self) - or return undef; - # 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'; - } - if (!i_writegif_wiol($IO, \%input, $self->{IMG})) { - $self->{ERRSTR} = $self->_error_as_msg; - return; - } } } @@ -1902,37 +1896,7 @@ sub write_multi { ($IO, $file) = $class->_get_writer_io($opts, $type) or return undef; - if ($type eq 'gif') { - $class->_set_opts($opts, "gif_", @images) - or return; - my $gif_delays = $opts->{gif_delays}; - local $opts->{gif_delays} = $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 ]; - } - unless (i_writegif_wiol($IO, $opts, @work)) { - $class->_set_error($class->_error_as_msg()); - return undef; - } - } - elsif ($type eq 'tiff') { - $class->_set_opts($opts, "tiff_", @images) - or return; - $class->_set_opts($opts, "exif_", @images) - or return; - 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 { - $res = i_writetiff_multi_wiol($IO, @work); - } - unless ($res) { - $class->_set_error($class->_error_as_msg()); - return undef; - } + if (0) { # eventually PNM in here, now that TIFF/GIF are elsewhere } else { if (@images == 1) { @@ -1976,7 +1940,9 @@ sub read_multi { } unless ($type) { - $ERRSTR = "No type parameter supplied and it couldn't be guessed"; + my $msg = "type parameter missing and it couldn't be determined from the file contents"; + $opts{file} and $msg .= " or file name"; + Imager->_set_error($msg); return; } @@ -1992,30 +1958,9 @@ sub read_multi { return; } - if ($type eq 'gif') { - my @imgs; - @imgs = i_readgif_multi_wiol($IO); - if (@imgs) { - return map { - bless { IMG=>$_, DEBUG=>$DEBUG, ERRSTR=>undef }, 'Imager' - } @imgs; - } - else { - $ERRSTR = _error_as_msg(); - return; - } - } - elsif ($type eq 'tiff') { - my @imgs = i_readtiff_multi_wiol($IO, -1); - if (@imgs) { - return map { - bless { IMG=>$_, DEBUG=>$DEBUG, ERRSTR=>undef }, 'Imager' - } @imgs; - } - else { - $ERRSTR = _error_as_msg(); - return; - } + my @imgs; + if ($type eq 'pnm') { + @imgs = i_readpnm_multi_wiol($IO, $opts{allow_incomplete}||0); } else { my $img = Imager->new; @@ -2023,9 +1968,16 @@ sub read_multi { return ( $img ); } Imager->_set_error($img->errstr); + return; } + if (!@imgs) { + $ERRSTR = _error_as_msg(); return; + } + return map { + bless { IMG=>$_, DEBUG=>$DEBUG, ERRSTR=>undef }, 'Imager' + } @imgs; } # Destroy an Imager object @@ -2610,16 +2562,20 @@ sub compose { defined $mask_top or $mask_top = $opts{mask_miny}; defined $mask_top or $mask_top = 0; - i_compose_mask($self->{IMG}, $src->{IMG}, $opts{mask}{IMG}, + unless (i_compose_mask($self->{IMG}, $src->{IMG}, $opts{mask}{IMG}, $left, $top, $src_left, $src_top, $mask_left, $mask_top, $width, $height, - $combine, $opts{opacity}) - or return; + $combine, $opts{opacity})) { + $self->_set_error(Imager->_error_as_msg); + return; + } } else { - i_compose($self->{IMG}, $src->{IMG}, $left, $top, $src_left, $src_top, - $width, $height, $combine, $opts{opacity}) - or return; + unless (i_compose($self->{IMG}, $src->{IMG}, $left, $top, $src_left, $src_top, + $width, $height, $combine, $opts{opacity})) { + $self->_set_error(Imager->_error_as_msg); + return; + } } return $self; @@ -2671,7 +2627,7 @@ sub rotate { } } elsif (defined $opts{radians} || defined $opts{degrees}) { - my $amount = $opts{radians} || $opts{degrees} * 3.1415926535 / 180; + my $amount = $opts{radians} || $opts{degrees} * 3.14159265358979 / 180; my $back = $opts{back}; my $result = Imager->new; @@ -2751,25 +2707,51 @@ sub i_color_set { # Draws a box between the specified corner points. sub box { my $self=shift; - unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; } - my $dflcl=i_color_new(255,255,255,255); - my %opts=(color=>$dflcl,xmin=>0,ymin=>0,xmax=>$self->getwidth()-1,ymax=>$self->getheight()-1,@_); + my $raw = $self->{IMG}; + + unless ($raw) { + $self->{ERRSTR}='empty input image'; + return undef; + } + my %opts = @_; + + my ($xmin, $ymin, $xmax, $ymax); if (exists $opts{'box'}) { - $opts{'xmin'} = _min($opts{'box'}->[0],$opts{'box'}->[2]); - $opts{'xmax'} = _max($opts{'box'}->[0],$opts{'box'}->[2]); - $opts{'ymin'} = _min($opts{'box'}->[1],$opts{'box'}->[3]); - $opts{'ymax'} = _max($opts{'box'}->[1],$opts{'box'}->[3]); + $xmin = _min($opts{'box'}->[0],$opts{'box'}->[2]); + $xmax = _max($opts{'box'}->[0],$opts{'box'}->[2]); + $ymin = _min($opts{'box'}->[1],$opts{'box'}->[3]); + $ymax = _max($opts{'box'}->[1],$opts{'box'}->[3]); + } + else { + defined($xmin = $opts{xmin}) or $xmin = 0; + defined($xmax = $opts{xmax}) or $xmax = $self->getwidth()-1; + defined($ymin = $opts{ymin}) or $ymin = 0; + defined($ymax = $opts{ymax}) or $ymax = $self->getheight()-1; } if ($opts{filled}) { - my $color = _color($opts{'color'}); - unless ($color) { - $self->{ERRSTR} = $Imager::ERRSTR; - return; + my $color = $opts{'color'}; + + if (defined $color) { + unless (_is_color_object($color)) { + $color = _color($color); + unless ($color) { + $self->{ERRSTR} = $Imager::ERRSTR; + return; + } + } + } + else { + $color = i_color_new(255,255,255,255); + } + + if ($color->isa("Imager::Color")) { + i_box_filled($raw, $xmin, $ymin,$xmax, $ymax, $color); + } + else { + i_box_filledf($raw, $xmin, $ymin,$xmax, $ymax, $color); } - i_box_filled($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax}, - $opts{ymax}, $color); } elsif ($opts{fill}) { unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) { @@ -2780,18 +2762,29 @@ sub box { return undef; } } - i_box_cfill($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax}, - $opts{ymax},$opts{fill}{fill}); + i_box_cfill($raw, $xmin, $ymin, $xmax, $ymax, $opts{fill}{fill}); } else { - my $color = _color($opts{'color'}); + my $color = $opts{'color'}; + if (defined $color) { + unless (_is_color_object($color)) { + $color = _color($color); + unless ($color) { + $self->{ERRSTR} = $Imager::ERRSTR; + return; + } + } + } + else { + $color = i_color_new(255, 255, 255, 255); + } unless ($color) { $self->{ERRSTR} = $Imager::ERRSTR; return; } - i_box($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},$opts{ymax}, - $color); + i_box($raw, $xmin, $ymin, $xmax, $ymax, $color); } + return $self; } @@ -3113,38 +3106,65 @@ sub flood_fill { } sub setpixel { - my $self = shift; + my ($self, %opts) = @_; + + $self->_valid_image("setpixel") + or return; + + my $color = $opts{color}; + unless (defined $color) { + $color = $self->{fg}; + defined $color or $color = NC(255, 255, 255); + } - my %opts = ( color=>$self->{fg} || NC(255, 255, 255), @_); + unless (ref $color && UNIVERSAL::isa($color, "Imager::Color")) { + unless ($color = _color($color, 'setpixel')) { + $self->_set_error("setpixel: " . Imager->errstr); + return; + } + } unless (exists $opts{'x'} && exists $opts{'y'}) { - $self->{ERRSTR} = 'missing x and y parameters'; - return undef; + $self->_set_error('setpixel: missing x or y parameter'); + return; } my $x = $opts{'x'}; my $y = $opts{'y'}; - my $color = _color($opts{color}) - or return undef; - if (ref $x && ref $y) { - unless (@$x == @$y) { - $self->{ERRSTR} = 'length of x and y mismatch'; + if (ref $x || ref $y) { + $x = ref $x ? $x : [ $x ]; + $y = ref $y ? $y : [ $y ]; + unless (@$x) { + $self->_set_error("setpixel: x is a reference to an empty array"); + return; + } + unless (@$y) { + $self->_set_error("setpixel: y is a reference to an empty array"); return; } + + # make both the same length, replicating the last element + if (@$x < @$y) { + $x = [ @$x, ($x->[-1]) x (@$y - @$x) ]; + } + elsif (@$y < @$x) { + $y = [ @$y, ($y->[-1]) x (@$x - @$y) ]; + } + my $set = 0; if ($color->isa('Imager::Color')) { - for my $i (0..$#{$opts{'x'}}) { + for my $i (0..$#$x) { i_ppix($self->{IMG}, $x->[$i], $y->[$i], $color) or ++$set; } } else { - for my $i (0..$#{$opts{'x'}}) { + for my $i (0..$#$x) { i_ppixf($self->{IMG}, $x->[$i], $y->[$i], $color) or ++$set; } } - $set or return; + return $set; } else { @@ -3158,7 +3178,7 @@ sub setpixel { } } - $self; + return $self; } sub getpixel { @@ -3166,41 +3186,66 @@ sub getpixel { my %opts = ( "type"=>'8bit', @_); + $self->_valid_image("getpixel") + or return; + unless (exists $opts{'x'} && exists $opts{'y'}) { - $self->{ERRSTR} = 'missing x and y parameters'; - return undef; + $self->_set_error('getpixel: missing x or y parameter'); + return; } my $x = $opts{'x'}; my $y = $opts{'y'}; - if (ref $x && ref $y) { - unless (@$x == @$y) { - $self->{ERRSTR} = 'length of x and y mismatch'; - return undef; + my $type = $opts{'type'}; + if (ref $x || ref $y) { + $x = ref $x ? $x : [ $x ]; + $y = ref $y ? $y : [ $y ]; + unless (@$x) { + $self->_set_error("getpixel: x is a reference to an empty array"); + return; + } + unless (@$y) { + $self->_set_error("getpixel: y is a reference to an empty array"); + return; + } + + # make both the same length, replicating the last element + if (@$x < @$y) { + $x = [ @$x, ($x->[-1]) x (@$y - @$x) ]; + } + elsif (@$y < @$x) { + $y = [ @$y, ($y->[-1]) x (@$x - @$y) ]; } + my @result; - if ($opts{"type"} eq '8bit') { - for my $i (0..$#{$opts{'x'}}) { + if ($type eq '8bit') { + for my $i (0..$#$x) { push(@result, i_get_pixel($self->{IMG}, $x->[$i], $y->[$i])); } } - else { - for my $i (0..$#{$opts{'x'}}) { + elsif ($type eq 'float' || $type eq 'double') { + for my $i (0..$#$x) { push(@result, i_gpixf($self->{IMG}, $x->[$i], $y->[$i])); } } + else { + $self->_set_error("getpixel: type must be '8bit' or 'float'"); + return; + } return wantarray ? @result : \@result; } else { - if ($opts{"type"} eq '8bit') { + if ($type eq '8bit') { return i_get_pixel($self->{IMG}, $x, $y); } - else { + elsif ($type eq 'float' || $type eq 'double') { return i_gpixf($self->{IMG}, $x, $y); } + else { + $self->_set_error("getpixel: type must be '8bit' or 'float'"); + return; + } } - - $self; } sub getscanline { @@ -3310,24 +3355,20 @@ sub getsamples { return; } - unless ($opts{channels}) { - $opts{channels} = [ 0 .. $self->getchannels()-1 ]; - } - if ($opts{target}) { my $target = $opts{target}; my $offset = $opts{offset}; if ($opts{type} eq '8bit') { my @samples = i_gsamp($self->{IMG}, $opts{x}, $opts{x}+$opts{width}, - $opts{y}, @{$opts{channels}}) + $opts{y}, $opts{channels}) or return; - @{$target}{$offset .. $offset + @samples - 1} = @samples; + @{$target}[$offset .. $offset + @samples - 1] = @samples; return scalar(@samples); } elsif ($opts{type} eq 'float') { my @samples = i_gsampf($self->{IMG}, $opts{x}, $opts{x}+$opts{width}, - $opts{y}, @{$opts{channels}}); - @{$target}{$offset .. $offset + @samples - 1} = @samples; + $opts{y}, $opts{channels}); + @{$target}[$offset .. $offset + @samples - 1] = @samples; return scalar(@samples); } elsif ($opts{type} =~ /^(\d+)bit$/) { @@ -3336,7 +3377,7 @@ sub getsamples { my @data; my $count = i_gsamp_bits($self->{IMG}, $opts{x}, $opts{x}+$opts{width}, $opts{y}, $bits, $target, - $offset, @{$opts{channels}}); + $offset, $opts{channels}); unless (defined $count) { $self->_set_error(Imager->_error_as_msg); return; @@ -3352,18 +3393,18 @@ sub getsamples { else { if ($opts{type} eq '8bit') { return i_gsamp($self->{IMG}, $opts{x}, $opts{x}+$opts{width}, - $opts{y}, @{$opts{channels}}); + $opts{y}, $opts{channels}); } elsif ($opts{type} eq 'float') { return i_gsampf($self->{IMG}, $opts{x}, $opts{x}+$opts{width}, - $opts{y}, @{$opts{channels}}); + $opts{y}, $opts{channels}); } elsif ($opts{type} =~ /^(\d+)bit$/) { my $bits = $1; my @data; i_gsamp_bits($self->{IMG}, $opts{x}, $opts{x}+$opts{width}, - $opts{y}, $bits, \@data, 0, @{$opts{channels}}) + $opts{y}, $bits, \@data, 0, $opts{channels}) or return; return @data; } @@ -3376,35 +3417,68 @@ sub getsamples { sub setsamples { my $self = shift; - my %opts = ( x => 0, offset => 0, @_ ); unless ($self->{IMG}) { $self->_set_error('setsamples: empty input image'); return; } - unless(defined $opts{data} && ref $opts{data}) { - $self->_set_error('setsamples: data parameter missing or invalid'); - return; - } + my %opts = ( x => 0, offset => 0 ); + my $data_index; + # avoid duplicating the data parameter, it may be a large scalar + my $i = 0; + while ($i < @_ -1) { + if ($_[$i] eq 'data') { + $data_index = $i+1; + } + else { + $opts{$_[$i]} = $_[$i+1]; + } - unless ($opts{channels}) { - $opts{channels} = [ 0 .. $self->getchannels()-1 ]; + $i += 2; } - unless ($opts{type} && $opts{type} =~ /^(\d+)bit$/) { - $self->_set_error('setsamples: type parameter missing or invalid'); + unless(defined $data_index) { + $self->_set_error('setsamples: data parameter missing'); + return; + } + unless (defined $_[$data_index]) { + $self->_set_error('setsamples: data parameter not defined'); return; } - my $bits = $1; - unless (defined $opts{width}) { - $opts{width} = $self->getwidth() - $opts{x}; + my $type = $opts{type}; + defined $type or $type = '8bit'; + + my $width = defined $opts{width} ? $opts{width} + : $self->getwidth() - $opts{x}; + + my $count; + if ($type eq '8bit') { + $count = i_psamp($self->{IMG}, $opts{x}, $opts{y}, $opts{channels}, + $_[$data_index], $opts{offset}, $width); + } + elsif ($type eq 'float') { + $count = i_psampf($self->{IMG}, $opts{x}, $opts{y}, $opts{channels}, + $_[$data_index], $opts{offset}, $width); + } + elsif ($type =~ /^([0-9]+)bit$/) { + my $bits = $1; + + unless (ref $_[$data_index]) { + $self->_set_error("setsamples: data must be an array ref for type not 8bit or float"); + return; + } + + $count = i_psamp_bits($self->{IMG}, $opts{x}, $opts{y}, $bits, + $opts{channels}, $_[$data_index], $opts{offset}, + $width); + } + else { + $self->_set_error('setsamples: type parameter invalid'); + return; } - my $count = i_psamp_bits($self->{IMG}, $opts{x}, $opts{y}, $bits, - $opts{channels}, $opts{data}, $opts{offset}, - $opts{width}); unless (defined $count) { $self->_set_error(Imager->_error_as_msg); return; @@ -3524,12 +3598,53 @@ sub convert { $new->{IMG} = i_convert($self->{IMG}, $matrix); unless ($new->{IMG}) { # most likely a bad matrix + i_push_error(0, "convert"); $self->{ERRSTR} = _error_as_msg(); return undef; } return $new; } +# combine channels from multiple input images, a class method +sub combine { + my ($class, %opts) = @_; + + my $src = delete $opts{src}; + unless ($src) { + $class->_set_error("src parameter missing"); + return; + } + my @imgs; + my $index = 0; + for my $img (@$src) { + unless (eval { $img->isa("Imager") }) { + $class->_set_error("src must contain image objects"); + return; + } + unless ($img->{IMG}) { + $class->_set_error("empty input image"); + return; + } + push @imgs, $img->{IMG}; + } + my $result; + if (my $channels = delete $opts{channels}) { + $result = i_combine(\@imgs, $channels); + } + else { + $result = i_combine(\@imgs); + } + unless ($result) { + $class->_set_error($class->_error_as_msg); + return; + } + + my $img = $class->new; + $img->{IMG} = $result; + + return $img; +} + # general function to map an image through lookup tables @@ -3588,16 +3703,26 @@ sub border { sub getwidth { my $self = shift; - if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; } - return (i_img_info($self->{IMG}))[0]; + + if (my $raw = $self->{IMG}) { + return i_img_get_width($raw); + } + else { + $self->{ERRSTR} = 'image is empty'; return undef; + } } # Get the height of an image sub getheight { my $self = shift; - if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; } - return (i_img_info($self->{IMG}))[1]; + + if (my $raw = $self->{IMG}) { + return i_img_get_height($raw); + } + else { + $self->{ERRSTR} = 'image is empty'; return undef; + } } # Get number of channels in an image @@ -3741,7 +3866,8 @@ sub align_string { } my %input=('x'=>0, 'y'=>0, @_); - $input{string}||=$input{text}; + defined $input{string} + or $input{string} = $input{text}; unless(exists $input{string}) { $self->_set_error("missing required parameter 'string'"); @@ -3787,11 +3913,49 @@ sub get_file_limits { i_get_image_file_limits(); } +my @check_args = qw(width height channels sample_size); + +sub check_file_limits { + my $class = shift; + + my %opts = + ( + channels => 3, + sample_size => 1, + @_, + ); + + if ($opts{sample_size} && $opts{sample_size} eq 'float') { + $opts{sample_size} = length(pack("d", 0)); + } + + for my $name (@check_args) { + unless (defined $opts{$name}) { + $class->_set_error("check_file_limits: $name must be defined"); + return; + } + unless ($opts{$name} == int($opts{$name})) { + $class->_set_error("check_file_limits: $name must be a positive integer"); + return; + } + } + + my $result = i_int_check_image_file_limits(@opts{@check_args}); + unless ($result) { + $class->_set_error($class->_error_as_msg()); + } + + return $result; +} + # Shortcuts that can be exported sub newcolor { Imager::Color->new(@_); } sub newfont { Imager::Font->new(@_); } -sub NCF { Imager::Color::Float->new(@_) } +sub NCF { + require Imager::Color::Float; + return Imager::Color::Float->new(@_); +} *NC=*newcolour=*newcolor; *NF=*newfont; @@ -3820,21 +3984,39 @@ sub _set_error { # Default guess for the type of an image from extension +my @simple_types = qw(png tga gif raw ico cur xpm mng jng ilbm pcx psd eps); + +my %ext_types = + ( + ( map { $_ => $_ } @simple_types ), + tiff => "tiff", + tif => "tiff", + pbm => "pnm", + pgm => "pnm", + ppm => "pnm", + pnm => "pnm", # technically wrong, but historically it works in Imager + jpeg => "jpeg", + jpg => "jpeg", + bmp => "bmp", + dib => "bmp", + rgb => "sgi", + bw => "sgi", + sgi => "sgi", + fit => "fits", + fits => "fits", + rle => "utah", + ); + sub def_guess_type { my $name=lc(shift); - my $ext; - $ext=($name =~ m/\.([^\.]+)$/)[0]; - return 'tiff' if ($ext =~ m/^tiff?$/); - return 'jpeg' if ($ext =~ m/^jpe?g$/); - return 'pnm' if ($ext =~ m/^p[pgb]m$/); - return 'png' if ($ext eq "png"); - return 'bmp' if ($ext eq "bmp" || $ext eq "dib"); - return 'tga' if ($ext eq "tga"); - return 'sgi' if ($ext eq "rgb" || $ext eq "bw" || $ext eq "sgi" || $ext eq "rgba"); - return 'gif' if ($ext eq "gif"); - return 'raw' if ($ext eq "raw"); - return lc $ext; # best guess - return (); + + my ($ext) = $name =~ /\.([^.]+)$/ + or return; + + my $type = $ext_types{$ext} + or return; + + return $type; } sub combines { @@ -3923,6 +4105,131 @@ sub Inline { # threads shouldn't try to close raw Imager objects sub Imager::ImgRaw::CLONE_SKIP { 1 } +sub preload { + # this serves two purposes: + # - a class method to load the file support modules included with Imager + # (or were included, once the library dependent modules are split out) + # - something for Module::ScanDeps to analyze + # https://rt.cpan.org/Ticket/Display.html?id=6566 + local $@; + eval { require Imager::File::GIF }; + eval { require Imager::File::JPEG }; + eval { require Imager::File::PNG }; + eval { require Imager::File::SGI }; + eval { require Imager::File::TIFF }; + eval { require Imager::File::ICO }; + eval { require Imager::Font::W32 }; + eval { require Imager::Font::FT2 }; + eval { require Imager::Font::T1 }; +} + +# backward compatibility for %formats +package Imager::FORMATS; +use strict; +use constant IX_FORMATS => 0; +use constant IX_LIST => 1; +use constant IX_INDEX => 2; +use constant IX_CLASSES => 3; + +sub TIEHASH { + my ($class, $formats, $classes) = @_; + + return bless [ $formats, [ ], 0, $classes ], $class; +} + +sub _check { + my ($self, $key) = @_; + + (my $file = $self->[IX_CLASSES]{$key} . ".pm") =~ s(::)(/)g; + my $value; + my $error; + my $loaded = Imager::_load_file($file, \$error); + if ($loaded) { + $value = 1; + } + else { + if ($error =~ /^Can't locate /) { + $error = "Can't locate $file"; + } + $reader_load_errors{$key} = $writer_load_errors{$key} = $error; + $value = undef; + } + $self->[IX_FORMATS]{$key} = $value; + + return $value; +} + +sub FETCH { + my ($self, $key) = @_; + + exists $self->[IX_FORMATS]{$key} and return $self->[IX_FORMATS]{$key}; + + $self->[IX_CLASSES]{$key} or return undef; + + return $self->_check($key); +} + +sub STORE { + die "%Imager::formats is not user monifiable"; +} + +sub DELETE { + die "%Imager::formats is not user monifiable"; +} + +sub CLEAR { + die "%Imager::formats is not user monifiable"; +} + +sub EXISTS { + my ($self, $key) = @_; + + if (exists $self->[IX_FORMATS]{$key}) { + my $value = $self->[IX_FORMATS]{$key} + or return; + return 1; + } + + $self->_check($key) or return 1==0; + + return 1==1; +} + +sub FIRSTKEY { + my ($self) = @_; + + unless (@{$self->[IX_LIST]}) { + # full populate it + @{$self->[IX_LIST]} = grep $self->[IX_FORMATS]{$_}, + keys %{$self->[IX_FORMATS]}; + + for my $key (keys %{$self->[IX_CLASSES]}) { + $self->[IX_FORMATS]{$key} and next; + $self->_check($key) + and push @{$self->[IX_LIST]}, $key; + } + } + + @{$self->[IX_LIST]} or return; + $self->[IX_INDEX] = 1; + return $self->[IX_LIST][0]; +} + +sub NEXTKEY { + my ($self) = @_; + + $self->[IX_INDEX] < @{$self->[IX_LIST]} + or return; + + return $self->[IX_LIST][$self->[IX_INDEX]++]; +} + +sub SCALAR { + my ($self) = @_; + + return scalar @{$self->[IX_LIST]}; +} + 1; __END__ # Below is the stub of documentation for your module. You better edit it! @@ -3945,7 +4252,7 @@ Imager - Perl extension for Generating 24 bit Images my $format; # see Imager::Files for information on the read() method - my $im = Imager->new(file=>$file) + my $img = Imager->new(file=>$file) or die Imager->errstr(); $file =~ s/\.[^.]*$//; @@ -4070,6 +4377,10 @@ L - using Imager's C API from Inline::C L - tools to get access to Imager's C API. +=item * + +L - brief security notes. + =back =head2 Basic Overview @@ -4096,7 +4407,7 @@ the C method to find out why: =over -=item C +=item errstr() Returns the last error message in that context. @@ -4124,230 +4435,256 @@ L. Where to find information on methods for Imager class objects. -addcolors() - L - add colors to a +addcolors() - L - add colors to a paletted image -addtag() - L - add image tags +addtag() - L - add image tags -align_string() - L - draw text aligned on a +align_string() - L - draw text aligned on a point -arc() - L - draw a filled arc +arc() - L - draw a filled arc -bits() - L - number of bits per sample for the +bits() - L - number of bits per sample for the image -box() - L - draw a filled or outline box. +box() - L - draw a filled or outline box. + +check_file_limits() - L + +circle() - L - draw a filled circle -circle() - L - draw a filled circle +close_log() - L - close the Imager +debugging log. -colorcount() - L - the number of colors in an -image's palette (paletted images only) +colorcount() - L - the number of +colors in an image's palette (paletted images only) -combines() - L - return a list of the different -combine type keywords +combine() - L - combine channels +from one or more images. -compose() - L - compose one image +combines() - L - return a list of the +different combine type keywords + +compose() - L - compose one image over another. -convert() - L - -transform the color space +convert() - L - transform the color +space -copy() - L - make a duplicate of an +copy() - L - make a duplicate of an image -crop() - L - extract part of an image +crop() - L - extract part of an image -def_guess_type() - L - default function +def_guess_type() - L - default function used to guess the output file format based on the output file name -deltag() - L - delete image tags +deltag() - L - delete image tags -difference() - L - produce a -difference images from two input images. +difference() - L - produce a difference +images from two input images. -errstr() - L<"Basic Overview"> - the error from the last failed -operation. +errstr() - L - the error from the last failed operation. -filter() - L - image filtering +filter() - L - image filtering -findcolor() - L - search the image +findcolor() - L - search the image palette, if it has one -flip() - L - flip an image, vertically, +flip() - L - flip an image, vertically, horizontally -flood_fill() - L - fill an enclosed or same +flood_fill() - L - fill an enclosed or same color area -getchannels() - L - the number of +getchannels() - L - the number of samples per pixel for an image -getcolorcount() - L - the number of +getcolorcount() - L - the number of different colors used by an image (works for direct color images) -getcolors() - L - get colors from the image +getcolors() - L - get colors from the image palette, if it has one -getcolorusage() - L +getcolorusage() - L -getcolorusagehash() - L +getcolorusagehash() - L -get_file_limits() - L +get_file_limits() - L -getheight() - L - height of the image in +getheight() - L - height of the image in pixels -getmask() - L - write mask for the image +getmask() - L - write mask for the image -getpixel() - L - retrieve one or more pixel +getpixel() - L - retrieve one or more pixel colors -getsamples() - L - retrieve samples from a +getsamples() - L - retrieve samples from a row or partial row of pixels. -getscanline() - L - retrieve colors for a +getscanline() - L - retrieve colors for a row or partial row of pixels. -getwidth() - L - width of the image in +getwidth() - L - width of the image in pixels. -img_set() - L - re-use an Imager object +img_set() - L - re-use an Imager object for a new image. -init() - L +init() - L -is_bilevel() - L - returns whether +is_bilevel() - L - returns whether image write functions should write the image in their bilevel (blank and white, no gray levels) format -line() - L - draw an interval +is_logging() L - test if the debug +log is active. + +line() - L - draw an interval + +load_plugin() - L + +log() - L - send a message to the debugging +log. -load_plugin() - L +make_palette() - L - produce a +color palette from one or more input images. -map() - L - remap color +map() - L - remap color channel values -masked() - L - make a masked image +masked() - L - make a masked image -matrix_transform() - L +matrix_transform() - L -maxcolors() - L +maxcolors() - L -NC() - L +NC() - L -NCF() - L +NCF() - L -new() - L +new() - L -newcolor() - L +newcolor() - L -newcolour() - L +newcolour() - L -newfont() - L +newfont() - L -NF() - L +NF() - L -open() - L - an alias for read() +open() - L - an alias for read() + +open_log() - L - open the debug log. =for stopwords IPTC -parseiptc() - L - parse IPTC data from a JPEG +parseiptc() - L - parse IPTC data from a JPEG +image + +paste() - L - draw an image onto an image -paste() - L - draw an image onto an image +polygon() - L -polygon() - L +polyline() - L -polyline() - L +preload() - L -read() - L - read a single image from an image file +read() - L - read a single image from an image file -read_multi() - L - read multiple images from an image +read_multi() - L - read multiple images from an image file -read_types() - L - list image types Imager +read_types() - L - list image types Imager can read. -register_filter() - L +register_filter() - L + +register_reader() - L -register_reader() - L +register_writer() - L -register_writer() - L +rotate() - L -rotate() - L +rubthrough() - L - draw an image +onto an image and use the alpha channel -rubthrough() - L - draw an image onto an -image and use the alpha channel +scale() - L -scale() - L +scale_calculate() - L -scale_calculate() - L +scaleX() - L -scaleX() - L +scaleY() - L -scaleY() - L +setcolors() - L - set palette colors +in a paletted image -setcolors() - L - set palette colors in -a paletted image +set_file_limits() - L -set_file_limits() - L +setmask() - L -setmask() - L +setpixel() - L -setpixel() - L +setsamples() - L -setsamples() - L +setscanline() - L -setscanline() - L +settag() - L -settag() - L +string() - L - draw text on an image -string() - L - draw text on an image +tags() - L - fetch image tags -tags() - L - fetch image tags +to_paletted() - L -to_paletted() - L +to_rgb16() - L -to_rgb16() - L +to_rgb8() - L -to_rgb8() - L +to_rgb_double() - L - convert to +double per sample image. -transform() - L +transform() - L -transform2() - L +transform2() - L -type() - L - type of image (direct vs paletted) +type() - L - type of image (direct vs paletted) -unload_plugin() - L +unload_plugin() - L -virtual() - L - whether the image has it's own +virtual() - L - whether the image has it's own data -write() - L - write an image to a file +write() - L - write an image to a file -write_multi() - L - write multiple image to an image +write_multi() - L - write multiple image to an image file. -write_types() - L - list image types Imager +write_types() - L - list image types Imager can write. =head1 CONCEPT INDEX animated GIF - L -aspect ratio - L, -L, L +aspect ratio - C, C, C in +L. blend - alpha blending one image onto another -L +L -blur - L, L +blur - L, L -boxes, drawing - L +boxes, drawing - L changes between image - L +channels, combine into one image - L + color - L color names - L, L @@ -4360,22 +4697,22 @@ contrast - L, L convolution - L -cropping - L +cropping - L CUR files - L C images - L -dpi - L, +dpi - C, C in L, L -drawing boxes - L +drawing boxes - L -drawing lines - L +drawing lines - L -drawing text - L, L +drawing text - L, L -error message - L<"ERROR HANDLING"> +error message - L files, font - L @@ -4383,18 +4720,18 @@ files, image - L filling, types of fill - L -filling, boxes - L +filling, boxes - L -filling, flood fill - L +filling, flood fill - L -flood fill - L +flood fill - L fonts - L -fonts, drawing with - L, -L, L +fonts, drawing with - L, +L, L -fonts, metrics - L, L +fonts, metrics - L, L fonts, multiple master - L @@ -4404,33 +4741,34 @@ L GIF files - L -GIF files, animated - L +GIF files, animated - L gradient fill - L, L, L, L -gray scale, convert image to - L +gray scale, convert image to - L -guassian blur - L +gaussian blur - L hatch fills - L ICO files - L -invert image - L +invert image - L, +L JPEG - L limiting image sizes - L -lines, drawing - L +lines, drawing - L matrix - L, -L, -L +L, +L -metadata, image - L +metadata, image - L, L mosaic - L @@ -4439,11 +4777,11 @@ noise, filter - L noise, rendered - L, L -paste - L, -L +paste - L, +L -pseudo-color image - L, -L +pseudo-color image - L, +L =for stopwords posterize @@ -4453,37 +4791,42 @@ PNG files - L, L PNM - L -rectangles, drawing - L +rectangles, drawing - L -resizing an image - L, -L +resizing an image - L, +L RGB (SGI) files - L saving an image - L -scaling - L +scaling - L + +security - L SGI files - L sharpen - L, L -size, image - L, -L +size, image - L, +L -size, text - L +size, text - L tags, image metadata - L -text, drawing - L, L, +text, drawing - L, L, L text, wrapping text in an area - L -text, measuring - L, L +text, measuring - L, L tiles, color - L +transparent images - L, +L + =for stopwords unsharp unsharp mask - L @@ -4568,22 +4911,50 @@ Tracker. =head2 Patches -I accept patches, preferably against the main branch in subversion. -You should include an explanation of the reason for why the patch is -needed or useful. +I accept patches, preferably against the master branch in git. Please +include an explanation of the reason for why the patch is needed or +useful. Your patch should include regression tests where possible, otherwise it will be delayed until I get a chance to write them. +To browse Imager's git repository: + + http://git.imager.perl.org/imager.git + +or: + + https://github.com/tonycoz/imager + +To clone: + + git clone git://git.imager.perl.org/imager.git + +or: + + git clone git://github.com/tonycoz/imager.git + =head1 AUTHOR -Tony Cook is the current maintainer for Imager. +Tony Cook is the current maintainer for Imager. Arnar M. Hrafnkelsson is the original author of Imager. Many others have contributed to Imager, please see the C for a complete list. +=head1 LICENSE + +Imager is licensed under the same terms as perl itself. + +=for stopwords +makeblendedfont Fontforge + +A test font, generated by the Debian packaged Fontforge, +F, contains a Postscript operator definition +copyrighted by Adobe. See F in the source for license +information. + =head1 SEE ALSO L(1), L(3), L(3), @@ -4598,6 +4969,12 @@ L(3), L(3) Other perl imaging modules include: -L(3), L(3), L(3). +L(3), L(3), L(3), +L, L. + +For manipulating image metadata see L. + +If you're trying to use Imager for array processing, you should +probably using L. =cut