X-Git-Url: http://git.imager.perl.org/imager.git/blobdiff_plain/c68de909d11ad19f9a9d5dbdbd52336b712a7d94..62adede52b9074b0842981ab33e6942fc36eaa13:/Imager.pm diff --git a/Imager.pm b/Imager.pm index d53b38d8..71af0686 100644 --- a/Imager.pm +++ b/Imager.pm @@ -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,14 +55,6 @@ 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 @@ -103,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= @@ -136,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/; @@ -154,17 +139,13 @@ my %defaults; BEGIN { require Exporter; - @ISA = qw(Exporter); - $VERSION = '0.79'; - 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.92'; + require XSLoader; + XSLoader::load(Imager => $VERSION); } my %formats_low; @@ -176,6 +157,7 @@ my %format_classes = jpeg => "Imager::File::JPEG", w32 => "Imager::Font::W32", ft2 => "Imager::Font::FT2", + t1 => "Imager::Font::T1", ); tie %formats, "Imager::FORMATS", \%formats_low, \%format_classes; @@ -459,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; } } @@ -596,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; } @@ -885,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}) { @@ -913,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 @@ -937,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; + } + + return $result; +} - #print "Type ", i_img_type($result->{IMG}), "\n"; +sub make_palette { + my ($class, $quant, @images) = @_; - if ($result->{IMG}) { - return $result; - } - else { - $self->{ERRSTR} = $self->_error_as_msg; + 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; @@ -962,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; @@ -1274,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}); @@ -1293,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+"); @@ -1302,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 @@ -1341,31 +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_low{$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; } my $allow_incomplete = $input{allow_incomplete}; defined $allow_incomplete or $allow_incomplete = 0; - 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(); @@ -1375,7 +1460,7 @@ sub read { return $self; } - 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(); @@ -1384,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(); @@ -1428,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; @@ -1527,6 +1577,41 @@ 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; @@ -1537,50 +1622,42 @@ sub _reader_autoload { 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_low{$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 { @@ -1699,35 +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_low{$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 'pnm' ) { + + if ( $type eq 'pnm' ) { $self->_set_opts(\%input, "pnm_", $self) or return undef; if ( ! i_writeppm_wiol($self->{IMG},$IO) ) { @@ -1735,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) ) { @@ -1743,17 +1822,8 @@ sub write { return undef; } $self->{DEBUG} && print "writing a raw 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) ) { @@ -1761,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; @@ -1770,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; - } } } @@ -1887,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; } @@ -2507,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; @@ -2568,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; @@ -2687,7 +2746,12 @@ sub box { $color = i_color_new(255,255,255,255); } - i_box_filled($raw, $xmin, $ymin,$xmax, $ymax, $color); + if ($color->isa("Imager::Color")) { + i_box_filled($raw, $xmin, $ymin,$xmax, $ymax, $color); + } + else { + i_box_filledf($raw, $xmin, $ymin,$xmax, $ymax, $color); + } } elsif ($opts{fill}) { unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) { @@ -3044,6 +3108,9 @@ sub flood_fill { sub setpixel { my ($self, %opts) = @_; + $self->_valid_image("setpixel") + or return; + my $color = $opts{color}; unless (defined $color) { $color = $self->{fg}; @@ -3051,36 +3118,53 @@ sub setpixel { } unless (ref $color && UNIVERSAL::isa($color, "Imager::Color")) { - $color = _color($color) - or return undef; + 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'}; - 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 { @@ -3094,7 +3178,7 @@ sub setpixel { } } - $self; + return $self; } sub getpixel { @@ -3102,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 { @@ -3246,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$/) { @@ -3272,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; @@ -3288,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; } @@ -3319,28 +3424,44 @@ sub setsamples { return; } - unless(defined $opts{data} && ref $opts{data}) { - $self->_set_error('setsamples: data parameter missing or invalid'); + my $data = $opts{data}; + unless(defined $data) { + $self->_set_error('setsamples: data parameter missing'); return; } - unless ($opts{channels}) { - $opts{channels} = [ 0 .. $self->getchannels()-1 ]; - } + my $type = $opts{type}; + defined $type or $type = '8bit'; - unless ($opts{type} && $opts{type} =~ /^(\d+)bit$/) { - $self->_set_error('setsamples: type parameter missing or invalid'); - return; + 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, $opts{offset}, $width); + } + elsif ($type eq 'float') { + $count = i_psampf($self->{IMG}, $opts{x}, $opts{y}, $opts{channels}, + $data, $opts{offset}, $width); } - my $bits = $1; + elsif ($type =~ /^([0-9]+)bit$/) { + my $bits = $1; + + unless (ref $data) { + $self->_set_error("setsamples: data must be an array ref for type not 8bit or float"); + return; + } - unless (defined $opts{width}) { - $opts{width} = $self->getwidth() - $opts{x}; + $count = i_psamp_bits($self->{IMG}, $opts{x}, $opts{y}, $bits, + $opts{channels}, $data, $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; @@ -3774,6 +3895,41 @@ 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(@_); } @@ -3810,21 +3966,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 { @@ -3913,6 +4087,24 @@ 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; @@ -3932,10 +4124,16 @@ sub _check { (my $file = $self->[IX_CLASSES]{$key} . ".pm") =~ s(::)(/)g; my $value; - if (eval { require $file; 1 }) { + 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; @@ -4036,7 +4234,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/\.[^.]*$//; @@ -4161,6 +4359,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 @@ -4187,7 +4389,7 @@ the C method to find out why: =over -=item C +=item errstr() Returns the last error message in that context. @@ -4215,234 +4417,255 @@ 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) -combine() - L - combine channels from one or -more images. +combine() - L - combine channels +from one or more images. -combines() - L - return a list of the different -combine type keywords +combines() - L - return a list of the +different combine type keywords -compose() - L - compose one image +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. -load_plugin() - L +line() - L - draw an interval -map() - L - remap color +load_plugin() - L + +log() - L - send a message to the debugging +log. + +make_palette() - L - produce a +color palette from one or more input images. + +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 -read() - L - read a single image from an image file +preload() - L -read_multi() - L - read multiple images from an image +read() - L - read a single image from an image file + +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 +channels, combine into one image - L color - L @@ -4456,22 +4679,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 @@ -4479,18 +4702,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 @@ -4500,15 +4723,15 @@ 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 @@ -4521,11 +4744,11 @@ JPEG - L limiting image sizes - L -lines, drawing - L +lines, drawing - L matrix - L, -L, -L +L, +L metadata, image - L @@ -4536,11 +4759,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 @@ -4550,34 +4773,36 @@ 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 @@ -4668,16 +4893,32 @@ 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. @@ -4691,9 +4932,10 @@ Imager is licensed under the same terms as perl itself. =for stopwords makeblendedfont Fontforge -A test font, FT2/fontfiles/MMOne.pfb, contains a Postscript operator -definition copyrighted by Adobe. See F in the source for -license information. +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 @@ -4709,6 +4951,10 @@ L(3), L(3) Other perl imaging modules include: -L(3), L(3), L(3). +L(3), L(3), L(3), +L, L. + +If you're trying to use Imager for array processing, you should +probably using L. =cut