X-Git-Url: http://git.imager.perl.org/imager.git/blobdiff_plain/efdc2568ee6be1b2922fd89f9d0d371ddcd7aec4..ad809a288f3d9d56d0e490d2b80286ff2d6212a5:/Imager.pm diff --git a/Imager.pm b/Imager.pm index 9469fa81..fd4280e6 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); +use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS %formats $DEBUG %filters %DSOs $ERRSTR $fontstate %OPCODES $I2P $FORMATGUESS $warn_obsolete); use IO::File; use Imager::Color; @@ -35,7 +35,7 @@ use Imager::Font; i_img_setmask i_img_getmask - i_draw + i_line i_line_aa i_box i_box_filled @@ -44,6 +44,7 @@ use Imager::Font; i_bezier_multi i_poly_aa + i_poly_aa_cfill i_copyto i_rubthru @@ -84,6 +85,7 @@ use Imager::Font; i_writepng_wiol i_readgif + i_readgif_wiol i_readgif_callback i_writegif i_writegifmc @@ -117,7 +119,7 @@ use Imager::Font; NF ); -@EXPORT=qw( +@EXPORT=qw( init_log i_list_formats i_has_format @@ -145,7 +147,7 @@ BEGIN { require Exporter; require DynaLoader; - $VERSION = '0.39pre1'; + $VERSION = '0.45'; @ISA = qw(Exporter DynaLoader); bootstrap Imager $VERSION; } @@ -219,11 +221,19 @@ BEGIN { callsub => sub { my %hsh=@_; i_conv($hsh{image},$hsh{coef}); } }; - $filters{gradgen} ={ - callseq => ['image', 'xo', 'yo', 'colors', 'dist'], - defaults => { }, - callsub => sub { my %hsh=@_; i_gradgen($hsh{image}, $hsh{xo}, $hsh{yo}, $hsh{colors}, $hsh{dist}); } - }; + $filters{gradgen} = + { + callseq => ['image', 'xo', 'yo', 'colors', 'dist'], + defaults => { dist => 0 }, + callsub => + sub { + my %hsh=@_; + my @colors = @{$hsh{colors}}; + $_ = _color($_) + for @colors; + i_gradgen($hsh{image}, $hsh{xo}, $hsh{yo}, \@colors, $hsh{dist}); + } + }; $filters{nearest_color} ={ callseq => ['image', 'xo', 'yo', 'colors', 'dist'], @@ -245,12 +255,37 @@ BEGIN { { callseq => [ qw(image bump elevation lightx lighty st) ], defaults => { elevation=>0, st=> 2 }, - callsub => sub { + callsub => sub { my %hsh = @_; i_bumpmap($hsh{image}, $hsh{bump}{IMG}, $hsh{elevation}, $hsh{lightx}, $hsh{lighty}, $hsh{st}); }, }; + $filters{bumpmap_complex} = + { + callseq => [ qw(image bump channel tx ty Lx Ly Lz cd cs n Ia Il Is) ], + defaults => { + channel => 0, + tx => 0, + ty => 0, + Lx => 0.2, + Ly => 0.4, + Lz => -1.0, + cd => 1.0, + cs => 40, + n => 1.3, + Ia => Imager::Color->new(rgb=>[0,0,0]), + Il => Imager::Color->new(rgb=>[255,255,255]), + Is => Imager::Color->new(rgb=>[255,255,255]), + }, + callsub => sub { + my %hsh = @_; + i_bumpmap_complex($hsh{image}, $hsh{bump}{IMG}, $hsh{channel}, + $hsh{tx}, $hsh{ty}, $hsh{Lx}, $hsh{Ly}, $hsh{Lz}, + $hsh{cd}, $hsh{cs}, $hsh{n}, $hsh{Ia}, $hsh{Il}, + $hsh{Is}); + }, + }; $filters{postlevels} = { callseq => [ qw(image levels) ], @@ -296,7 +331,7 @@ BEGIN { multiply => 2, mult => 2, dissolve => 3, add => 4, - subtract => 5, sub => 5, + subtract => 5, 'sub' => 5, diff => 6, lighten => 7, darken => 8, @@ -319,13 +354,35 @@ BEGIN { callsub => sub { my %hsh = @_; + + # make sure the segments are specified with colors + my @segments; + for my $segment (@{$hsh{segments}}) { + my @new_segment = @$segment; + + $_ = _color($_) or die $Imager::ERRSTR."\n" for @new_segment[3,4]; + push @segments, \@new_segment; + } + i_fountain($hsh{image}, $hsh{xa}, $hsh{ya}, $hsh{xb}, $hsh{yb}, $hsh{ftype}, $hsh{repeat}, $hsh{combine}, $hsh{super_sample}, - $hsh{ssample_param}, $hsh{segments}); + $hsh{ssample_param}, \@segments); + }, + }; + $filters{unsharpmask} = + { + callseq => [ qw(image stddev scale) ], + defaults => { stddev=>2.0, scale=>1.0 }, + callsub => + sub { + my %hsh = @_; + i_unsharp_mask($hsh{image}, $hsh{stddev}, $hsh{scale}); }, }; $FORMATGUESS=\&def_guess_type; + + $warn_obsolete = 1; } # @@ -343,17 +400,30 @@ BEGIN { # print Dumper(@_); #} +sub init_log { + m_init_log($_[0],$_[1]); + log_entry("Imager $VERSION starting\n", 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 (exists $parms{'t1log'}) { + i_init_fonts($parms{'t1log'}); + } } END { @@ -409,6 +479,54 @@ sub _error_as_msg { return join(": ", map $_->[0], i_errors()); } +# this function tries to DWIM for color parameters +# color objects are used as is +# simple scalars are simply treated as single parameters to Imager::Color->new +# hashrefs are treated as named argument lists to Imager::Color->new +# arrayrefs are treated as list arguments to Imager::Color->new iff any +# parameter is > 1 +# other arrayrefs are treated as list arguments to Imager::Color::Float + +sub _color { + my $arg = shift; + # perl 5.6.0 seems to do weird things to $arg if we don't make an + # explicitly stringified copy + # I vaguely remember a bug on this on p5p, but couldn't find it + # through bugs.perl.org (I had trouble getting it to find any bugs) + my $copy = $arg . ""; + my $result; + + if (ref $arg) { + if (UNIVERSAL::isa($arg, "Imager::Color") + || UNIVERSAL::isa($arg, "Imager::Color::Float")) { + $result = $arg; + } + else { + if ($copy =~ /^HASH\(/) { + $result = Imager::Color->new(%$arg); + } + elsif ($copy =~ /^ARRAY\(/) { + if (grep $_ > 1, @$arg) { + $result = Imager::Color->new(@$arg); + } + else { + $result = Imager::Color::Float->new(@$arg); + } + } + else { + $Imager::ERRSTR = "Not a color"; + } + } + } + else { + # assume Imager::Color::new knows how to handle it + $result = Imager::Color->new($arg); + } + + return $result; +} + + # # Methods to be called on objects. # @@ -426,7 +544,12 @@ sub new { $self->{ERRSTR}=undef; # $self->{DEBUG}=$DEBUG; $self->{DEBUG} && print "Initialized Imager\n"; - if ($hsh{xsize} && $hsh{ysize}) { $self->img_set(%hsh); } + if (defined $hsh{xsize} && defined $hsh{ysize}) { + unless ($self->img_set(%hsh)) { + $Imager::ERRSTR = $self->{ERRSTR}; + return; + } + } return $self; } @@ -437,6 +560,12 @@ sub copy { my $self = shift; unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; } + unless (defined wantarray) { + my @caller = caller; + warn "copy() called in void context - copy() returns the copied image at $caller[1] line $caller[2]\n"; + return; + } + my $newcopy=Imager->new(); $newcopy->{IMG}=i_img_new(); i_copy($newcopy->{IMG},$self->{IMG}); @@ -468,46 +597,111 @@ sub paste { sub crop { my $self=shift; unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; } - my %hsh=(left=>0,right=>0,top=>0,bottom=>0,@_); + + unless (defined wantarray) { + my @caller = caller; + warn "crop() called in void context - crop() returns the cropped image at $caller[1] line $caller[2]\n"; + return; + } - my ($w,$h,$l,$r,$b,$t)=($self->getwidth(),$self->getheight(), - @hsh{qw(left right bottom top)}); - $l=0 if not defined $l; - $t=0 if not defined $t; + my %hsh=@_; - $r||=$l+delete $hsh{'width'} if defined $l and exists $hsh{'width'}; - $b||=$t+delete $hsh{'height'} if defined $t and exists $hsh{'height'}; - $l||=$r-delete $hsh{'width'} if defined $r and exists $hsh{'width'}; - $t||=$b-delete $hsh{'height'} if defined $b and exists $hsh{'height'}; + my ($w, $h, $l, $r, $b, $t) = + @hsh{qw(width height left right bottom top)}; - $r=$self->getwidth if not defined $r; - $b=$self->getheight if not defined $b; + # work through the various possibilities + if (defined $l) { + if (defined $w) { + $r = $l + $w; + } + elsif (!defined $r) { + $r = $self->getwidth; + } + } + elsif (defined $r) { + if (defined $w) { + $l = $r - $w; + } + else { + $l = 0; + } + } + elsif (defined $w) { + $l = int(0.5+($self->getwidth()-$w)/2); + $r = $l + $w; + } + else { + $l = 0; + $r = $self->getwidth; + } + if (defined $t) { + if (defined $h) { + $b = $t + $h; + } + elsif (!defined $b) { + $b = $self->getheight; + } + } + elsif (defined $b) { + if (defined $h) { + $t = $b - $h; + } + else { + $t = 0; + } + } + elsif (defined $h) { + $t=int(0.5+($self->getheight()-$h)/2); + $b=$t+$h; + } + else { + $t = 0; + $b = $self->getheight; + } ($l,$r)=($r,$l) if $l>$r; ($t,$b)=($b,$t) if $t>$b; - if ($hsh{'width'}) { - $l=int(0.5+($w-$hsh{'width'})/2); - $r=$l+$hsh{'width'}; - } else { - $hsh{'width'}=$r-$l; - } - if ($hsh{'height'}) { - $b=int(0.5+($h-$hsh{'height'})/2); - $t=$h+$hsh{'height'}; - } else { - $hsh{'height'}=$b-$t; - } + $l < 0 and $l = 0; + $r > $self->getwidth and $r = $self->getwidth; + $t < 0 and $t = 0; + $b > $self->getheight and $b = $self->getheight; -# print "l=$l, r=$r, h=$hsh{'width'}\n"; -# print "t=$t, b=$b, w=$hsh{'height'}\n"; + if ($l == $r || $t == $b) { + $self->_set_error("resulting image would have no content"); + return; + } - my $dst=Imager->new(xsize=>$hsh{'width'}, ysize=>$hsh{'height'}, channels=>$self->getchannels()); + my $dst = $self->_sametype(xsize=>$r-$l, ysize=>$b-$t); i_copyto($dst->{IMG},$self->{IMG},$l,$t,$r,$b,0,0); return $dst; } +sub _sametype { + my ($self, %opts) = @_; + + $self->{IMG} or return $self->_set_error("Not a valid image"); + + my $x = $opts{xsize} || $self->getwidth; + my $y = $opts{ysize} || $self->getheight; + my $channels = $opts{channels} || $self->getchannels; + + my $out = Imager->new; + if ($channels == $self->getchannels) { + $out->{IMG} = i_sametype($self->{IMG}, $x, $y); + } + else { + $out->{IMG} = i_sametype_chans($self->{IMG}, $x, $y, $channels); + } + unless ($out->{IMG}) { + $self->{ERRSTR} = $self->_error_as_msg; + return; + } + + return $out; +} + # Sets an image to a certain size and channel number # if there was previously data in the image it is discarded @@ -527,6 +721,9 @@ sub img_set { $self->{IMG} = i_img_pal_new($hsh{xsize}, $hsh{ysize}, $hsh{channels}, $hsh{maxcolors} || 256); } + elsif ($hsh{bits} eq 'double') { + $self->{IMG} = i_img_double_new($hsh{xsize}, $hsh{ysize}, $hsh{channels}); + } elsif ($hsh{bits} == 16) { $self->{IMG} = i_img_16_new($hsh{xsize}, $hsh{ysize}, $hsh{channels}); } @@ -534,6 +731,13 @@ sub img_set { $self->{IMG}=Imager::ImgRaw::new($hsh{'xsize'}, $hsh{'ysize'}, $hsh{'channels'}); } + + unless ($self->{IMG}) { + $self->{ERRSTR} = Imager->_error_as_msg(); + return; + } + + $self; } # created a masked version of the current image @@ -570,14 +774,24 @@ sub to_paletted { $opts = shift; } + unless (defined wantarray) { + my @caller = caller; + warn "to_paletted() called in void context - to_paletted() returns the converted image at $caller[1] line $caller[2]\n"; + return; + } + my $result = Imager->new; $result->{IMG} = i_img_to_pal($self->{IMG}, $opts); #print "Type ", i_img_type($result->{IMG}), "\n"; - $result->{IMG} or undef $result; - - return $result; + if ($result->{IMG}) { + return $result; + } + else { + $self->{ERRSTR} = $self->_error_as_msg; + return; + } } # convert a paletted (or any image) to an 8-bit/channel RGB images @@ -585,6 +799,12 @@ sub to_rgb8 { my $self = shift; my $result; + unless (defined wantarray) { + my @caller = caller; + warn "to_rgb8() called in void context - to_rgb8() returns the cropped image at $caller[1] line $caller[2]\n"; + return; + } + if ($self->{IMG}) { $result = Imager->new; $result->{IMG} = i_img_to_rgb($self->{IMG}) @@ -648,7 +868,11 @@ sub findcolor { sub bits { my $self = shift; - $self->{IMG} and i_img_bits($self->{IMG}); + my $bits = $self->{IMG} && i_img_bits($self->{IMG}); + if ($bits && $bits == length(pack("d", 1)) * 8) { + $bits = 'double'; + } + $bits; } sub type { @@ -752,8 +976,8 @@ sub deltag { return 0 unless $self->{IMG}; - if (defined $opts{index}) { - return i_tags_delete($self->{IMG}, $opts{index}); + if (defined $opts{'index'}) { + return i_tags_delete($self->{IMG}, $opts{'index'}); } elsif (defined $opts{name}) { return i_tags_delbyname($self->{IMG}, $opts{name}); @@ -767,12 +991,129 @@ sub deltag { } } +sub settag { + my ($self, %opts) = @_; + + if ($opts{name}) { + $self->deltag(name=>$opts{name}); + return $self->addtag(name=>$opts{name}, value=>$opts{value}); + } + elsif (defined $opts{code}) { + $self->deltag(code=>$opts{code}); + return $self->addtag(code=>$opts{code}, value=>$opts{value}); + } + else { + return undef; + } +} + + +sub _get_reader_io { + my ($self, $input) = @_; + + if ($input->{io}) { + return $input->{io}, undef; + } + elsif ($input->{fd}) { + return io_new_fd($input->{fd}); + } + elsif ($input->{fh}) { + my $fd = fileno($input->{fh}); + unless ($fd) { + $self->_set_error("Handle in fh option not opened"); + return; + } + return io_new_fd($fd); + } + elsif ($input->{file}) { + my $file = IO::File->new($input->{file}, "r"); + unless ($file) { + $self->_set_error("Could not open $input->{file}: $!"); + return; + } + binmode $file; + return (io_new_fd(fileno($file)), $file); + } + elsif ($input->{data}) { + return io_new_buffer($input->{data}); + } + elsif ($input->{callback} || $input->{readcb}) { + if (!$input->{seekcb}) { + $self->_set_error("Need a seekcb parameter"); + } + if ($input->{maxbuffer}) { + return io_new_cb($input->{writecb}, + $input->{callback} || $input->{readcb}, + $input->{seekcb}, $input->{closecb}, + $input->{maxbuffer}); + } + else { + return io_new_cb($input->{writecb}, + $input->{callback} || $input->{readcb}, + $input->{seekcb}, $input->{closecb}); + } + } + else { + $self->_set_error("file/fd/fh/data/callback parameter missing"); + return; + } +} + +sub _get_writer_io { + my ($self, $input, $type) = @_; + + if ($input->{fd}) { + return io_new_fd($input->{fd}); + } + elsif ($input->{fh}) { + my $fd = fileno($input->{fh}); + unless ($fd) { + $self->_set_error("Handle in fh option not opened"); + return; + } + # flush it + my $oldfh = select($input->{fh}); + # flush anything that's buffered, and make sure anything else is flushed + $| = 1; + select($oldfh); + return io_new_fd($fd); + } + elsif ($input->{file}) { + my $fh = new IO::File($input->{file},"w+"); + unless ($fh) { + $self->_set_error("Could not open file $input->{file}: $!"); + return; + } + binmode($fh) or die; + return (io_new_fd(fileno($fh)), $fh); + } + elsif ($input->{data}) { + return io_new_bufchain(); + } + elsif ($input->{callback} || $input->{writecb}) { + if ($input->{maxbuffer}) { + return io_new_cb($input->{callback} || $input->{writecb}, + $input->{readcb}, + $input->{seekcb}, $input->{closecb}, + $input->{maxbuffer}); + } + else { + return io_new_cb($input->{callback} || $input->{writecb}, + $input->{readcb}, + $input->{seekcb}, $input->{closecb}); + } + } + else { + $self->_set_error("file/fd/fh/data/callback parameter missing"); + return; + } +} + # Read an image from file sub read { my $self = shift; my %input=@_; - my ($fh, $fd, $IO); if (defined($self->{IMG})) { # let IIM_DESTROY do the destruction, since the image may be @@ -781,310 +1122,348 @@ sub read { undef($self->{IMG}); } - if (!$input{fd} and !$input{file} and !$input{data}) { - $self->{ERRSTR}='no file, fd or data parameter'; return undef; - } - if ($input{file}) { - $fh = new IO::File($input{file},"r"); - if (!defined $fh) { - $self->{ERRSTR}='Could not open file'; return undef; - } - binmode($fh); - $fd = $fh->fileno(); - } - if ($input{fd}) { - $fd=$input{fd}; - } - - # FIXME: Find the format here if not specified - # yes the code isn't here yet - next week maybe? - # Next week? Are you high or something? That comment - # has been there for half a year dude. - # Look, i just work here, ok? + my ($IO, $fh) = $self->_get_reader_io(\%input) or return; - if (!$input{type} and $input{file}) { - $input{type}=$FORMATGUESS->($input{file}); - } - if (!$formats{$input{type}}) { - $self->{ERRSTR}='format not supported'; return undef; + unless ($input{'type'}) { + $input{'type'} = i_test_format_probe($IO, -1); } - my %iolready=(jpeg=>1, png=>1, tiff=>1, pnm=>1, raw=>1, bmp=>1); + unless ($input{'type'}) { + $self->_set_error('type parameter missing and not possible to guess from extension'); + return undef; + } - if ($iolready{$input{type}}) { - # Setup data source - $IO = io_new_fd($fd); # sort of simple for now eh? + unless ($formats{$input{'type'}}) { + $self->_set_error("format '$input{'type'}' not supported"); + return; + } - if ( $input{type} eq 'jpeg' ) { - ($self->{IMG},$self->{IPTCRAW})=i_readjpeg_wiol( $IO ); - if ( !defined($self->{IMG}) ) { - $self->{ERRSTR}='unable to read jpeg image'; return undef; - } - $self->{DEBUG} && print "loading a jpeg file\n"; - return $self; + # Setup data source + if ( $input{'type'} eq 'jpeg' ) { + ($self->{IMG},$self->{IPTCRAW}) = i_readjpeg_wiol( $IO ); + if ( !defined($self->{IMG}) ) { + $self->{ERRSTR}='unable to read jpeg image'; return undef; } + $self->{DEBUG} && print "loading a jpeg file\n"; + return $self; + } - if ( $input{type} eq 'tiff' ) { - $self->{IMG}=i_readtiff_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed - if ( !defined($self->{IMG}) ) { - $self->{ERRSTR}='unable to read tiff image'; return undef; - } - $self->{DEBUG} && print "loading a tiff file\n"; - return $self; + if ( $input{'type'} eq 'tiff' ) { + $self->{IMG}=i_readtiff_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed + if ( !defined($self->{IMG}) ) { + $self->{ERRSTR}=$self->_error_as_msg(); return undef; } + $self->{DEBUG} && print "loading a tiff file\n"; + return $self; + } - if ( $input{type} eq 'pnm' ) { - $self->{IMG}=i_readpnm_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed - if ( !defined($self->{IMG}) ) { - $self->{ERRSTR}='unable to read pnm image: '._error_as_msg(); return undef; - } - $self->{DEBUG} && print "loading a pnm file\n"; - return $self; + if ( $input{'type'} eq 'pnm' ) { + $self->{IMG}=i_readpnm_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed + if ( !defined($self->{IMG}) ) { + $self->{ERRSTR}='unable to read pnm image: '._error_as_msg(); return undef; } + $self->{DEBUG} && print "loading a pnm file\n"; + 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}='unable to read png image'; - return undef; - } - $self->{DEBUG} && print "loading a png file\n"; + if ( $input{'type'} eq 'png' ) { + $self->{IMG}=i_readpng_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed + if ( !defined($self->{IMG}) ) { + $self->{ERRSTR}='unable to read png image'; + return undef; } + $self->{DEBUG} && print "loading a png file\n"; + } - if ( $input{type} eq 'bmp' ) { - $self->{IMG}=i_readbmp_wiol( $IO ); - if ( !defined($self->{IMG}) ) { - $self->{ERRSTR}='unable to read bmp image'; - return undef; - } - $self->{DEBUG} && print "loading a bmp file\n"; + if ( $input{'type'} eq 'bmp' ) { + $self->{IMG}=i_readbmp_wiol( $IO ); + if ( !defined($self->{IMG}) ) { + $self->{ERRSTR}=$self->_error_as_msg(); + return undef; } + $self->{DEBUG} && print "loading a bmp file\n"; + } - if ( $input{type} eq 'raw' ) { - my %params=(datachannels=>3,storechannels=>3,interleave=>1,%input); - - if ( !($params{xsize} && $params{ysize}) ) { - $self->{ERRSTR}='missing xsize or ysize parameter for raw'; - return undef; + if ( $input{'type'} eq 'gif' ) { + if ($input{colors} && !ref($input{colors})) { + # must be a reference to a scalar that accepts the colour map + $self->{ERRSTR} = "option 'colors' must be a scalar reference"; + return undef; + } + if ($input{colors}) { + my $colors; + ($self->{IMG}, $colors) =i_readgif_wiol( $IO ); + if ($colors) { + ${ $input{colors} } = [ map { NC(@$_) } @$colors ]; } + } + else { + $self->{IMG} =i_readgif_wiol( $IO ); + } + if ( !defined($self->{IMG}) ) { + $self->{ERRSTR}=$self->_error_as_msg(); + return undef; + } + $self->{DEBUG} && print "loading a gif file\n"; + } - $self->{IMG} = i_readraw_wiol( $IO, - $params{xsize}, - $params{ysize}, - $params{datachannels}, - $params{storechannels}, - $params{interleave}); - if ( !defined($self->{IMG}) ) { - $self->{ERRSTR}='unable to read raw image'; - return undef; - } - $self->{DEBUG} && print "loading a raw file\n"; + if ( $input{'type'} eq 'tga' ) { + $self->{IMG}=i_readtga_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed + if ( !defined($self->{IMG}) ) { + $self->{ERRSTR}=$self->_error_as_msg(); + return undef; } + $self->{DEBUG} && print "loading a tga file\n"; + } - } else { + if ( $input{'type'} eq 'rgb' ) { + $self->{IMG}=i_readrgb_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed + if ( !defined($self->{IMG}) ) { + $self->{ERRSTR}=$self->_error_as_msg(); + return undef; + } + $self->{DEBUG} && print "loading a tga file\n"; + } - # Old code for reference while changing the new stuff - if (!$input{type} and $input{file}) { - $input{type}=$FORMATGUESS->($input{file}); - } + if ( $input{'type'} eq 'raw' ) { + my %params=(datachannels=>3,storechannels=>3,interleave=>1,%input); - if (!$input{type}) { - $self->{ERRSTR}='type parameter missing and not possible to guess from extension'; return undef; + if ( !($params{xsize} && $params{ysize}) ) { + $self->{ERRSTR}='missing xsize or ysize parameter for raw'; + return undef; } - if (!$formats{$input{type}}) { - $self->{ERRSTR}='format not supported'; + $self->{IMG} = i_readraw_wiol( $IO, + $params{xsize}, + $params{ysize}, + $params{datachannels}, + $params{storechannels}, + $params{interleave}); + if ( !defined($self->{IMG}) ) { + $self->{ERRSTR}='unable to read raw image'; return undef; } + $self->{DEBUG} && print "loading a raw file\n"; + } - if ($input{file}) { - $fh = new IO::File($input{file},"r"); - if (!defined $fh) { - $self->{ERRSTR}='Could not open file'; - return undef; - } - binmode($fh); - $fd = $fh->fileno(); - } + return $self; +} - if ($input{fd}) { - $fd=$input{fd}; - } +sub _fix_gif_positions { + my ($opts, $opt, $msg, @imgs) = @_; - if ( $input{type} eq 'gif' ) { - my $colors; - if ($input{colors} && !ref($input{colors})) { - # must be a reference to a scalar that accepts the colour map - $self->{ERRSTR} = "option 'colors' must be a scalar reference"; - return undef; + my $positions = $opts->{'gif_positions'}; + my $index = 0; + for my $pos (@$positions) { + my ($x, $y) = @$pos; + my $img = $imgs[$index++]; + $img->settag(name=>'gif_left', value=>$x); + $img->settag(name=>'gif_top', value=>$y) if defined $y; + } + $$msg .= "replaced with the gif_left and gif_top tags"; +} + +my %obsolete_opts = + ( + gif_each_palette=>'gif_local_map', + interlace => 'gif_interlace', + gif_delays => 'gif_delay', + gif_positions => \&_fix_gif_positions, + gif_loop_count => 'gif_loop', + ); + +sub _set_opts { + my ($self, $opts, $prefix, @imgs) = @_; + + for my $opt (keys %$opts) { + my $tagname = $opt; + if ($obsolete_opts{$opt}) { + my $new = $obsolete_opts{$opt}; + my $msg = "Obsolete option $opt "; + if (ref $new) { + $new->($opts, $opt, \$msg, @imgs); } - if (exists $input{data}) { - if ($input{colors}) { - ($self->{IMG}, $colors) = i_readgif_scalar($input{data}); - } else { - $self->{IMG}=i_readgif_scalar($input{data}); - } - } else { - if ($input{colors}) { - ($self->{IMG}, $colors) = i_readgif( $fd ); - } else { - $self->{IMG} = i_readgif( $fd ) - } + else { + $msg .= "replaced with the $new tag "; + $tagname = $new; } - if ($colors) { - # we may or may not change i_readgif to return blessed objects... - ${ $input{colors} } = [ map { NC(@$_) } @$colors ]; + $msg .= "line ".(caller(2))[2]." of file ".(caller(2))[1]; + warn $msg if $warn_obsolete && $^W; + } + next unless $tagname =~ /^\Q$prefix/; + my $value = $opts->{$opt}; + if (ref $value) { + if (UNIVERSAL::isa($value, "Imager::Color")) { + my $tag = sprintf("color(%d,%d,%d,%d)", $value->rgba); + for my $img (@imgs) { + $img->settag(name=>$tagname, value=>$tag); + } } - if ( !defined($self->{IMG}) ) { - $self->{ERRSTR}= 'reading GIF:'._error_as_msg(); - return undef; + elsif (ref($value) eq 'ARRAY') { + for my $i (0..$#$value) { + my $val = $value->[$i]; + if (ref $val) { + if (UNIVERSAL::isa($val, "Imager::Color")) { + my $tag = sprintf("color(%d,%d,%d,%d)", $value->rgba); + $i < @imgs and + $imgs[$i]->settag(name=>$tagname, value=>$tag); + } + else { + $self->_set_error("Unknown reference type " . ref($value) . + " supplied in array for $opt"); + return; + } + } + else { + $i < @imgs + and $imgs[$i]->settag(name=>$tagname, value=>$val); + } + } + } + else { + $self->_set_error("Unknown reference type " . ref($value) . + " supplied for $opt"); + return; + } + } + else { + # set it as a tag for every image + for my $img (@imgs) { + $img->settag(name=>$tagname, value=>$value); } - $self->{DEBUG} && print "loading a gif file\n"; } } - return $self; + + return 1; } # Write an image to file sub write { my $self = shift; - my %input=(jpegquality=>75, gifquant=>'mc', lmdither=>6.0, lmfixed=>[], + my %input=(jpegquality=>75, + gifquant=>'mc', + lmdither=>6.0, + lmfixed=>[], + idstring=>"", + compress=>1, + wierdpack=>0, fax_fine=>1, @_); - my ($fh, $rc, $fd, $IO); + my $rc; - my %iolready=( tiff=>1, raw=>1, png=>1, pnm=>1, bmp=>1, jpeg=>1 ); # this will be SO MUCH BETTER once they are all in there + $self->_set_opts(\%input, "i_", $self) + or return undef; unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; } - if (!$input{file} and !$input{'fd'} and !$input{'data'}) { $self->{ERRSTR}='file/fd/data parameter missing'; return undef; } - if (!$input{type} and $input{file}) { $input{type}=$FORMATGUESS->($input{file}); } - if (!$input{type}) { $self->{ERRSTR}='type parameter missing and not possible to guess from extension'; return undef; } + if (!$input{'type'} and $input{file}) { + $input{'type'}=$FORMATGUESS->($input{file}); + } + if (!$input{'type'}) { + $self->{ERRSTR}='type parameter missing and not possible to guess from extension'; + return undef; + } - if (!$formats{$input{type}}) { $self->{ERRSTR}='format not supported'; return undef; } + if (!$formats{$input{'type'}}) { $self->{ERRSTR}='format not supported'; return undef; } - if (exists $input{'fd'}) { - $fd=$input{'fd'}; - } elsif (exists $input{'data'}) { - $IO = Imager::io_new_bufchain(); - } else { - $fh = new IO::File($input{file},"w+"); - if (!defined $fh) { $self->{ERRSTR}='Could not open file'; return undef; } - binmode($fh) or die; - $fd = $fh->fileno(); - } + my ($IO, $fh) = $self->_get_writer_io(\%input, $input{'type'}) + or return undef; - if ($iolready{$input{type}}) { - if (defined $fd) { - $IO = io_new_fd($fd); - } + if ($input{'type'} eq 'tiff') { + $self->_set_opts(\%input, "tiff_", $self) + or return undef; + $self->_set_opts(\%input, "exif_", $self) + or return undef; - if ($input{type} eq 'tiff') { - if (defined $input{class} && $input{class} eq 'fax') { - if (!i_writetiff_wiol_faxable($self->{IMG}, $IO, $input{fax_fine})) { - $self->{ERRSTR}='Could not write to buffer'; - return undef; - } - } else { - if (!i_writetiff_wiol($self->{IMG}, $IO)) { - $self->{ERRSTR}='Could not write to buffer'; - return undef; - } - } - } elsif ( $input{type} eq 'pnm' ) { - if ( ! i_writeppm_wiol($self->{IMG},$IO) ) { - $self->{ERRSTR}='unable to write pnm image'; - return undef; - } - $self->{DEBUG} && print "writing a pnm file\n"; - } elsif ( $input{type} eq 'raw' ) { - if ( !i_writeraw_wiol($self->{IMG},$IO) ) { - $self->{ERRSTR}='unable to write raw image'; + if (defined $input{class} && $input{class} eq 'fax') { + if (!i_writetiff_wiol_faxable($self->{IMG}, $IO, $input{fax_fine})) { + $self->{ERRSTR}='Could not write to buffer'; return undef; } - $self->{DEBUG} && print "writing a raw file\n"; - } elsif ( $input{type} eq 'png' ) { - if ( !i_writepng_wiol($self->{IMG}, $IO) ) { - $self->{ERRSTR}='unable to write png image'; + } else { + if (!i_writetiff_wiol($self->{IMG}, $IO)) { + $self->{ERRSTR}='Could not write to buffer'; return undef; } - $self->{DEBUG} && print "writing a png file\n"; - } elsif ( $input{type} eq 'jpeg' ) { - if ( !i_writejpeg_wiol($self->{IMG}, $IO, $input{jpegquality})) { - $self->{ERRSTR}='unable to write jpeg image'; - return undef; - } - $self->{DEBUG} && print "writing a jpeg file\n"; - } elsif ( $input{type} eq 'bmp' ) { - if ( !i_writebmp_wiol($self->{IMG}, $IO) ) { - $self->{ERRSTR}='unable to write bmp image'; - return undef; - } - $self->{DEBUG} && print "writing a bmp file\n"; } - - if (exists $input{'data'}) { - my $data = io_slurp($IO); - if (!$data) { - $self->{ERRSTR}='Could not slurp from buffer'; - return undef; - } - ${$input{data}} = $data; + } elsif ( $input{'type'} eq 'pnm' ) { + $self->_set_opts(\%input, "pnm_", $self) + or return undef; + if ( ! i_writeppm_wiol($self->{IMG},$IO) ) { + $self->{ERRSTR}='unable to write pnm image'; + return undef; } - return $self; - } else { - if ( $input{type} eq 'gif' ) { - if (not $input{gifplanes}) { - my $gp; - my $count=i_count_colors($self->{IMG}, 256); - $gp=8 if $count == -1; - $gp=1 if not $gp and $count <= 2; - $gp=2 if not $gp and $count <= 4; - $gp=3 if not $gp and $count <= 8; - $gp=4 if not $gp and $count <= 16; - $gp=5 if not $gp and $count <= 32; - $gp=6 if not $gp and $count <= 64; - $gp=7 if not $gp and $count <= 128; - $input{gifplanes} = $gp || 8; - } - - if ($input{gifplanes}>8) { - $input{gifplanes}=8; - } - if ($input{gifquant} eq 'gen' || $input{callback}) { - - - if ($input{gifquant} eq 'lm') { - - $input{make_colors} = 'addi'; - $input{translate} = 'perturb'; - $input{perturb} = $input{lmdither}; - } elsif ($input{gifquant} eq 'gen') { - # just pass options through - } else { - $input{make_colors} = 'webmap'; # ignored - $input{translate} = 'giflib'; - } - - if ($input{callback}) { - defined $input{maxbuffer} or $input{maxbuffer} = -1; - $rc = i_writegif_callback($input{callback}, $input{maxbuffer}, - \%input, $self->{IMG}); - } else { - $rc = i_writegif_gen($fd, \%input, $self->{IMG}); - } + $self->{DEBUG} && print "writing a pnm file\n"; + } elsif ( $input{'type'} eq 'raw' ) { + $self->_set_opts(\%input, "raw_", $self) + or return undef; + if ( !i_writeraw_wiol($self->{IMG},$IO) ) { + $self->{ERRSTR}='unable to write raw image'; + return undef; + } + $self->{DEBUG} && print "writing a raw file\n"; + } elsif ( $input{'type'} eq 'png' ) { + $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' ) { + $self->_set_opts(\%input, "bmp_", $self) + or return undef; + if ( !i_writebmp_wiol($self->{IMG}, $IO) ) { + $self->{ERRSTR}='unable to write bmp image'; + return undef; + } + $self->{DEBUG} && print "writing a bmp file\n"; + } elsif ( $input{'type'} eq 'tga' ) { + $self->_set_opts(\%input, "tga_", $self) + or return undef; - } elsif ($input{gifquant} eq 'lm') { - $rc=i_writegif($self->{IMG},$fd,$input{gifplanes},$input{lmdither},$input{lmfixed}); - } else { - $rc=i_writegifmc($self->{IMG},$fd,$input{gifplanes}); - } - if ( !defined($rc) ) { - $self->{ERRSTR} = "Writing GIF file: "._error_as_msg(); return undef; - } - $self->{DEBUG} && print "writing a gif file\n"; + if ( !i_writetga_wiol($self->{IMG}, $IO, $input{wierdpack}, $input{compress}, $input{idstring}) ) { + $self->{ERRSTR}=$self->_error_as_msg(); + return undef; + } + $self->{DEBUG} && print "writing a tga file\n"; + } elsif ( $input{'type'} eq 'gif' ) { + $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; + } + } + if (exists $input{'data'}) { + my $data = io_slurp($IO); + if (!$data) { + $self->{ERRSTR}='Could not slurp from buffer'; + return undef; } + ${$input{data}} = $data; } return $self; } @@ -1092,41 +1471,54 @@ sub write { sub write_multi { my ($class, $opts, @images) = @_; - if ($opts->{type} eq 'gif') { + if (!$opts->{'type'} && $opts->{'file'}) { + $opts->{'type'} = $FORMATGUESS->($opts->{'file'}); + } + unless ($opts->{'type'}) { + $class->_set_error('type parameter missing and not possible to guess from extension'); + return; + } + # translate to ImgRaw + if (grep !UNIVERSAL::isa($_, 'Imager') || !$_->{IMG}, @images) { + $class->_set_error('Usage: Imager->write_multi({ options }, @images)'); + return 0; + } + $class->_set_opts($opts, "i_", @images) + or return; + my @work = map $_->{IMG}, @images; + my ($IO, $file) = $class->_get_writer_io($opts, $opts->{'type'}) + or return undef; + if ($opts->{'type'} eq 'gif') { + $class->_set_opts($opts, "gif_", @images) + or return; my $gif_delays = $opts->{gif_delays}; local $opts->{gif_delays} = $gif_delays; - unless (ref $opts->{gif_delays}) { + if ($opts->{gif_delays} && !ref $opts->{gif_delays}) { # assume the caller wants the same delay for each frame $opts->{gif_delays} = [ ($gif_delays) x @images ]; } - # translate to ImgRaw - if (grep !UNIVERSAL::isa($_, 'Imager') || !$_->{IMG}, @images) { - $ERRSTR = "Usage: Imager->write_multi({ options }, @images)"; - return 0; - } - my @work = map $_->{IMG}, @images; - if ($opts->{callback}) { - # Note: you may need to fix giflib for this one to work - my $maxbuffer = $opts->{maxbuffer}; - defined $maxbuffer or $maxbuffer = -1; # max by default - return i_writegif_callback($opts->{callback}, $maxbuffer, - $opts, @work); - } - if ($opts->{fd}) { - return i_writegif_gen($opts->{fd}, $opts, @work); + my $res = i_writegif_wiol($IO, $opts, @work); + $res or $class->_set_error($class->_error_as_msg()); + return $res; + } + elsif ($opts->{'type'} eq 'tiff') { + $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 { - my $fh = IO::File->new($opts->{file}, "w+"); - unless ($fh) { - $ERRSTR = "Error creating $opts->{file}: $!"; - return 0; - } - binmode($fh); - return i_writegif_gen(fileno($fh), $opts, @work); + $res = i_writetiff_multi_wiol($IO, @work); } + $res or $class->_set_error($class->_error_as_msg()); + return $res; } else { - $ERRSTR = "Sorry, write_multi doesn't support $opts->{type} yet"; + $ERRSTR = "Sorry, write_multi doesn't support $opts->{'type'} yet"; return 0; } } @@ -1135,61 +1527,33 @@ sub write_multi { sub read_multi { my ($class, %opts) = @_; - if ($opts{file} && !exists $opts{type}) { + if ($opts{file} && !exists $opts{'type'}) { # guess the type my $type = $FORMATGUESS->($opts{file}); - $opts{type} = $type; + $opts{'type'} = $type; } - unless ($opts{type}) { + unless ($opts{'type'}) { $ERRSTR = "No type parameter supplied and it couldn't be guessed"; return; } - my $fd; - my $file; - if ($opts{file}) { - $file = IO::File->new($opts{file}, "r"); - unless ($file) { - $ERRSTR = "Could not open file $opts{file}: $!"; - return; - } - binmode $file; - $fd = fileno($file); - } - elsif ($opts{fh}) { - $fd = fileno($opts{fh}); - unless ($fd) { - $ERRSTR = "File handle specified with fh option not open"; - return; - } - } - elsif ($opts{fd}) { - $fd = $opts{fd}; - } - elsif ($opts{callback} || $opts{data}) { - # don't fail here - } - else { - $ERRSTR = "You need to specify one of file, fd, fh, callback or data"; - return; - } - if ($opts{type} eq 'gif') { + my ($IO, $file) = $class->_get_reader_io(\%opts, $opts{'type'}) + or return; + if ($opts{'type'} eq 'gif') { my @imgs; - if ($fd) { - @imgs = i_readgif_multi($fd); + @imgs = i_readgif_multi_wiol($IO); + if (@imgs) { + return map { + bless { IMG=>$_, DEBUG=>$DEBUG, ERRSTR=>undef }, 'Imager' + } @imgs; } else { - if (Imager::i_giflib_version() < 4.0) { - $ERRSTR = "giflib3.x does not support callbacks"; - return; - } - if ($opts{callback}) { - @imgs = i_readgif_multi_callback($opts{callback}) - } - else { - @imgs = i_readgif_multi_scalar($opts{data}); - } + $ERRSTR = _error_as_msg(); + return; } + } + elsif ($opts{'type'} eq 'tiff') { + my @imgs = i_readtiff_multi_wiol($IO, -1); if (@imgs) { return map { bless { IMG=>$_, DEBUG=>$DEBUG, ERRSTR=>undef }, 'Imager' @@ -1201,7 +1565,7 @@ sub read_multi { } } - $ERRSTR = "Cannot read multiple images from $opts{type} files"; + $ERRSTR = "Cannot read multiple images from $opts{'type'} files"; return; } @@ -1231,35 +1595,42 @@ sub filter { my %hsh; unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; } - if (!$input{type}) { $self->{ERRSTR}='type parameter missing'; return undef; } + if (!$input{'type'}) { $self->{ERRSTR}='type parameter missing'; return undef; } - if ( (grep { $_ eq $input{type} } keys %filters) != 1) { + if ( (grep { $_ eq $input{'type'} } keys %filters) != 1) { $self->{ERRSTR}='type parameter not matching any filter'; return undef; } - if ($filters{$input{type}}{names}) { - my $names = $filters{$input{type}}{names}; + if ($filters{$input{'type'}}{names}) { + my $names = $filters{$input{'type'}}{names}; for my $name (keys %$names) { if (defined $input{$name} && exists $names->{$name}{$input{$name}}) { $input{$name} = $names->{$name}{$input{$name}}; } } } - if (defined($filters{$input{type}}{defaults})) { - %hsh=('image',$self->{IMG},%{$filters{$input{type}}{defaults}},%input); + if (defined($filters{$input{'type'}}{defaults})) { + %hsh=('image',$self->{IMG},%{$filters{$input{'type'}}{defaults}},%input); } else { %hsh=('image',$self->{IMG},%input); } - my @cs=@{$filters{$input{type}}{callseq}}; + my @cs=@{$filters{$input{'type'}}{callseq}}; for(@cs) { if (!defined($hsh{$_})) { - $self->{ERRSTR}="missing parameter '$_' for filter ".$input{type}; return undef; + $self->{ERRSTR}="missing parameter '$_' for filter ".$input{'type'}; return undef; } } - &{$filters{$input{type}}{callsub}}(%hsh); + eval { + local $SIG{__DIE__}; # we don't want this processed by confess, etc + &{$filters{$input{'type'}}{callsub}}(%hsh); + }; + if ($@) { + chomp($self->{ERRSTR} = $@); + return; + } my @b=keys %hsh; @@ -1273,16 +1644,22 @@ sub filter { sub scale { my $self=shift; - my %opts=(scalefactor=>0.5,type=>'max',qtype=>'normal',@_); + my %opts=(scalefactor=>0.5,'type'=>'max',qtype=>'normal',@_); my $img = Imager->new(); my $tmp = Imager->new(); + unless (defined wantarray) { + my @caller = caller; + warn "scale() called in void context - scale() returns the scaled image at $caller[1] line $caller[2]\n"; + return; + } + unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; } - if ($opts{xpixels} and $opts{ypixels} and $opts{type}) { + if ($opts{xpixels} and $opts{ypixels} and $opts{'type'}) { my ($xpix,$ypix)=( $opts{xpixels}/$self->getwidth() , $opts{ypixels}/$self->getheight() ); - if ($opts{type} eq 'min') { $opts{scalefactor}=min($xpix,$ypix); } - if ($opts{type} eq 'max') { $opts{scalefactor}=max($xpix,$ypix); } + if ($opts{'type'} eq 'min') { $opts{scalefactor}=min($xpix,$ypix); } + if ($opts{'type'} eq 'max') { $opts{scalefactor}=max($xpix,$ypix); } } elsif ($opts{xpixels}) { $opts{scalefactor}=$opts{xpixels}/$self->getwidth(); } elsif ($opts{ypixels}) { $opts{scalefactor}=$opts{ypixels}/$self->getheight(); } @@ -1307,6 +1684,12 @@ sub scaleX { my $self=shift; my %opts=(scalefactor=>0.5,@_); + unless (defined wantarray) { + my @caller = caller; + warn "scaleX() called in void context - scaleX() returns the scaled image at $caller[1] line $caller[2]\n"; + return; + } + unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; } my $img = Imager->new(); @@ -1326,6 +1709,12 @@ sub scaleY { my $self=shift; my %opts=(scalefactor=>0.5,@_); + unless (defined wantarray) { + my @caller = caller; + warn "scaleY() called in void context - scaleY() returns the scaled image at $caller[1] line $caller[2]\n"; + return; + } + unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; } my $img = Imager->new(); @@ -1366,9 +1755,9 @@ sub transform { {op=>'-',trans=>'Sub'}, {op=>'*',trans=>'Mult'}, {op=>'/',trans=>'Div'}, - {op=>'-',type=>'unary',trans=>'u-'}, + {op=>'-','type'=>'unary',trans=>'u-'}, {op=>'**'}, - {op=>'func',type=>'unary'}], + {op=>'func','type'=>'unary'}], 'grouping'=>[qw( \( \) )], 'func'=>[qw( sin cos )], 'vars'=>[qw( x y )] @@ -1437,75 +1826,79 @@ sub transform { } -{ - my $got_expr; - sub transform2 { - my ($opts, @imgs) = @_; - - if (!$got_expr) { - # this is fairly big, delay loading it - eval "use Imager::Expr"; - die $@ if $@; - ++$got_expr; - } - - $opts->{variables} = [ qw(x y) ]; - my ($width, $height) = @{$opts}{qw(width height)}; - if (@imgs) { - $width ||= $imgs[0]->getwidth(); - $height ||= $imgs[0]->getheight(); - my $img_num = 1; - for my $img (@imgs) { - $opts->{constants}{"w$img_num"} = $img->getwidth(); - $opts->{constants}{"h$img_num"} = $img->getheight(); - $opts->{constants}{"cx$img_num"} = $img->getwidth()/2; - $opts->{constants}{"cy$img_num"} = $img->getheight()/2; - ++$img_num; - } - } - if ($width) { - $opts->{constants}{w} = $width; - $opts->{constants}{cx} = $width/2; - } - else { - $Imager::ERRSTR = "No width supplied"; - return; - } - if ($height) { - $opts->{constants}{h} = $height; - $opts->{constants}{cy} = $height/2; - } - else { - $Imager::ERRSTR = "No height supplied"; - return; - } - my $code = Imager::Expr->new($opts); - if (!$code) { - $Imager::ERRSTR = Imager::Expr::error(); - return; - } - - my $img = Imager->new(); - $img->{IMG} = i_transform2($opts->{width}, $opts->{height}, $code->code(), - $code->nregs(), $code->cregs(), - [ map { $_->{IMG} } @imgs ]); - if (!defined $img->{IMG}) { - $Imager::ERRSTR = "transform2 failed"; - return; - } +sub transform2 { + my ($opts, @imgs) = @_; + + require "Imager/Expr.pm"; + + $opts->{variables} = [ qw(x y) ]; + my ($width, $height) = @{$opts}{qw(width height)}; + if (@imgs) { + $width ||= $imgs[0]->getwidth(); + $height ||= $imgs[0]->getheight(); + my $img_num = 1; + for my $img (@imgs) { + $opts->{constants}{"w$img_num"} = $img->getwidth(); + $opts->{constants}{"h$img_num"} = $img->getheight(); + $opts->{constants}{"cx$img_num"} = $img->getwidth()/2; + $opts->{constants}{"cy$img_num"} = $img->getheight()/2; + ++$img_num; + } + } + if ($width) { + $opts->{constants}{w} = $width; + $opts->{constants}{cx} = $width/2; + } + else { + $Imager::ERRSTR = "No width supplied"; + return; + } + if ($height) { + $opts->{constants}{h} = $height; + $opts->{constants}{cy} = $height/2; + } + else { + $Imager::ERRSTR = "No height supplied"; + return; + } + my $code = Imager::Expr->new($opts); + if (!$code) { + $Imager::ERRSTR = Imager::Expr::error(); + return; + } + my $channels = $opts->{channels} || 3; + unless ($channels >= 1 && $channels <= 4) { + return Imager->_set_error("channels must be an integer between 1 and 4"); + } - return $img; + my $img = Imager->new(); + $img->{IMG} = i_transform2($opts->{width}, $opts->{height}, + $channels, $code->code(), + $code->nregs(), $code->cregs(), + [ map { $_->{IMG} } @imgs ]); + if (!defined $img->{IMG}) { + $Imager::ERRSTR = Imager->_error_as_msg(); + return; } + + return $img; } sub rubthrough { my $self=shift; - my %opts=(tx=>0,ty=>0,@_); + my %opts=(tx => 0,ty => 0, @_); unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; } unless ($opts{src} && $opts{src}->{IMG}) { $self->{ERRSTR}='empty input image for source'; return undef; } - unless (i_rubthru($self->{IMG}, $opts{src}->{IMG}, $opts{tx},$opts{ty})) { + %opts = (src_minx => 0, + src_miny => 0, + src_maxx => $opts{src}->getwidth(), + src_maxy => $opts{src}->getheight(), + %opts); + + unless (i_rubthru($self->{IMG}, $opts{src}->{IMG}, $opts{tx}, $opts{ty}, + $opts{src_minx}, $opts{src_miny}, $opts{src_maxx}, $opts{src_maxy})) { $self->{ERRSTR} = $self->_error_as_msg(); return undef; } @@ -1527,6 +1920,13 @@ sub flip { sub rotate { my $self = shift; my %opts = @_; + + unless (defined wantarray) { + my @caller = caller; + warn "rotate() called in void context - rotate() returns the rotated image at $caller[1] line $caller[2]\n"; + return; + } + if (defined $opts{right}) { my $degrees = $opts{right}; if ($degrees < 0) { @@ -1555,7 +1955,13 @@ sub rotate { my $amount = $opts{radians} || $opts{degrees} * 3.1415926535 / 180; my $result = Imager->new; - if ($result->{IMG} = i_rotate_exact($self->{IMG}, $amount)) { + if ($opts{back}) { + $result->{IMG} = i_rotate_exact($self->{IMG}, $amount, $opts{back}); + } + else { + $result->{IMG} = i_rotate_exact($self->{IMG}, $amount); + } + if ($result->{IMG}) { return $result; } else { @@ -1564,7 +1970,7 @@ sub rotate { } } else { - $self->{ERRSTR} = "Only the 'right' parameter is available"; + $self->{ERRSTR} = "Only the 'right', 'radians' and 'degrees' parameters are available"; return undef; } } @@ -1573,14 +1979,27 @@ sub matrix_transform { my $self = shift; my %opts = @_; + unless (defined wantarray) { + my @caller = caller; + warn "copy() called in void context - copy() returns the copied image at $caller[1] line $caller[2]\n"; + return; + } + if ($opts{matrix}) { my $xsize = $opts{xsize} || $self->getwidth; my $ysize = $opts{ysize} || $self->getheight; my $result = Imager->new; - $result->{IMG} = i_matrix_transform($self->{IMG}, $xsize, $ysize, - $opts{matrix}) - or return undef; + if ($opts{back}) { + $result->{IMG} = i_matrix_transform($self->{IMG}, $xsize, $ysize, + $opts{matrix}, $opts{back}) + or return undef; + } + else { + $result->{IMG} = i_matrix_transform($self->{IMG}, $xsize, $ysize, + $opts{matrix}) + or return undef; + } return $result; } @@ -1618,20 +2037,34 @@ sub box { } if ($opts{filled}) { + my $color = _color($opts{'color'}); + unless ($color) { + $self->{ERRSTR} = $Imager::ERRSTR; + return; + } i_box_filled($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax}, - $opts{ymax},$opts{color}); + $opts{ymax}, $color); } elsif ($opts{fill}) { unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) { # assume it's a hash ref require 'Imager/Fill.pm'; - $opts{fill} = Imager::Fill->new(%{$opts{fill}}); + unless ($opts{fill} = Imager::Fill->new(%{$opts{fill}})) { + $self->{ERRSTR} = $Imager::ERRSTR; + return undef; + } } i_box_cfill($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax}, $opts{ymax},$opts{fill}{fill}); } - else { - i_box($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},$opts{ymax},$opts{color}); + else { + my $color = _color($opts{'color'}); + unless ($color) { + $self->{ERRSTR} = $Imager::ERRSTR; + return; + } + i_box($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},$opts{ymax}, + $color); } return $self; } @@ -1651,34 +2084,69 @@ sub arc { unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) { # assume it's a hash ref require 'Imager/Fill.pm'; - $opts{fill} = Imager::Fill->new(%{$opts{fill}}); + unless ($opts{fill} = Imager::Fill->new(%{$opts{fill}})) { + $self->{ERRSTR} = $Imager::ERRSTR; + return; + } } i_arc_cfill($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},$opts{'d1'}, $opts{'d2'}, $opts{fill}{fill}); } else { - i_arc($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},$opts{'d1'}, - $opts{'d2'},$opts{'color'}); + my $color = _color($opts{'color'}); + unless ($color) { + $self->{ERRSTR} = $Imager::ERRSTR; + return; + } + if ($opts{d1} == 0 && $opts{d2} == 361 && $opts{aa}) { + i_circle_aa($self->{IMG}, $opts{'x'}, $opts{'y'}, $opts{'r'}, + $color); + } + else { + if ($opts{'d1'} <= $opts{'d2'}) { + i_arc($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'}, + $opts{'d1'}, $opts{'d2'}, $color); + } + else { + i_arc($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'}, + $opts{'d1'}, 361, $color); + i_arc($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'}, + 0, $opts{'d2'}, $color); + } + } } return $self; } -# Draws a line from one point to (but not including) the destination point +# Draws a line from one point to the other +# the endpoint is set if the endp parameter is set which it is by default. +# to turn of the endpoint being set use endp=>0 when calling line. sub line { my $self=shift; my $dflcl=i_color_new(0,0,0,0); - my %opts=(color=>$dflcl,@_); + my %opts=(color=>$dflcl, + endp => 1, + @_); unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; } unless (exists $opts{x1} and exists $opts{y1}) { $self->{ERRSTR}='missing begining coord'; return undef; } unless (exists $opts{x2} and exists $opts{y2}) { $self->{ERRSTR}='missing ending coord'; return undef; } + my $color = _color($opts{'color'}); + unless ($color) { + $self->{ERRSTR} = $Imager::ERRSTR; + return; + } + + $opts{antialias} = $opts{aa} if defined $opts{aa}; if ($opts{antialias}) { - i_line_aa($self->{IMG},$opts{x1}, $opts{y1}, $opts{x2}, $opts{y2}, $opts{color}); + i_line_aa($self->{IMG},$opts{x1}, $opts{y1}, $opts{x2}, $opts{y2}, + $color, $opts{endp}); } else { - i_draw($self->{IMG},$opts{x1}, $opts{y1}, $opts{x2}, $opts{y2}, $opts{color}); + i_line($self->{IMG},$opts{x1}, $opts{y1}, $opts{x2}, $opts{y2}, + $color, $opts{endp}); } return $self; } @@ -1701,21 +2169,73 @@ sub polyline { # print Dumper(\@points); + my $color = _color($opts{'color'}); + unless ($color) { + $self->{ERRSTR} = $Imager::ERRSTR; + return; + } + $opts{antialias} = $opts{aa} if defined $opts{aa}; if ($opts{antialias}) { for $pt(@points) { - if (defined($ls)) { i_line_aa($self->{IMG},$ls->[0],$ls->[1],$pt->[0],$pt->[1],$opts{color}); } + if (defined($ls)) { + i_line_aa($self->{IMG},$ls->[0],$ls->[1],$pt->[0],$pt->[1],$color, 1); + } $ls=$pt; } } else { for $pt(@points) { - if (defined($ls)) { i_draw($self->{IMG},$ls->[0],$ls->[1],$pt->[0],$pt->[1],$opts{color}); } + if (defined($ls)) { + i_line($self->{IMG},$ls->[0],$ls->[1],$pt->[0],$pt->[1],$color,1); + } $ls=$pt; } } return $self; } -# this the multipoint bezier curve +sub polygon { + my $self = shift; + my ($pt,$ls,@points); + my $dflcl = i_color_new(0,0,0,0); + my %opts = (color=>$dflcl, @_); + + unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; } + + if (exists($opts{points})) { + $opts{'x'} = [ map { $_->[0] } @{$opts{points}} ]; + $opts{'y'} = [ map { $_->[1] } @{$opts{points}} ]; + } + + if (!exists $opts{'x'} or !exists $opts{'y'}) { + $self->{ERRSTR} = 'no points array, or x and y arrays.'; return undef; + } + + if ($opts{'fill'}) { + unless (UNIVERSAL::isa($opts{'fill'}, 'Imager::Fill')) { + # assume it's a hash ref + require 'Imager/Fill.pm'; + unless ($opts{'fill'} = Imager::Fill->new(%{$opts{'fill'}})) { + $self->{ERRSTR} = $Imager::ERRSTR; + return undef; + } + } + i_poly_aa_cfill($self->{IMG}, $opts{'x'}, $opts{'y'}, + $opts{'fill'}{'fill'}); + } + else { + my $color = _color($opts{'color'}); + unless ($color) { + $self->{ERRSTR} = $Imager::ERRSTR; + return; + } + i_poly_aa($self->{IMG}, $opts{'x'}, $opts{'y'}, $color); + } + + return $self; +} + + +# this the multipoint bezier curve # this is here more for testing that actual usage since # this is not a good algorithm. Usually the curve would be # broken into smaller segments and each done individually. @@ -1738,29 +2258,126 @@ sub polybezier { return; } - i_bezier_multi($self->{IMG},$opts{'x'},$opts{'y'},$opts{'color'}); + my $color = _color($opts{'color'}); + unless ($color) { + $self->{ERRSTR} = $Imager::ERRSTR; + return; + } + i_bezier_multi($self->{IMG},$opts{'x'},$opts{'y'},$color); return $self; } sub flood_fill { my $self = shift; my %opts = ( color=>Imager::Color->new(255, 255, 255), @_ ); + my $rc; - unless (exists $opts{x} && exists $opts{'y'}) { + unless (exists $opts{'x'} && exists $opts{'y'}) { $self->{ERRSTR} = "missing seed x and y parameters"; return undef; } - + if ($opts{fill}) { unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) { # assume it's a hash ref require 'Imager/Fill.pm'; - $opts{fill} = Imager::Fill->new(%{$opts{fill}}); + unless ($opts{fill} = Imager::Fill->new(%{$opts{fill}})) { + $self->{ERRSTR} = $Imager::ERRSTR; + return; + } + } + $rc = i_flood_cfill($self->{IMG}, $opts{'x'}, $opts{'y'}, $opts{fill}{fill}); + } + else { + my $color = _color($opts{'color'}); + unless ($color) { + $self->{ERRSTR} = $Imager::ERRSTR; + return; + } + $rc = i_flood_fill($self->{IMG}, $opts{'x'}, $opts{'y'}, $color); + } + if ($rc) { $self; } else { $self->{ERRSTR} = $self->_error_as_msg(); return (); } +} + +sub setpixel { + my $self = shift; + + my %opts = ( color=>$self->{fg} || NC(255, 255, 255), @_); + + unless (exists $opts{'x'} && exists $opts{'y'}) { + $self->{ERRSTR} = 'missing x and y parameters'; + return undef; + } + + 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'; + return undef; + } + if ($color->isa('Imager::Color')) { + for my $i (0..$#{$opts{'x'}}) { + i_ppix($self->{IMG}, $x->[$i], $y->[$i], $color); + } + } + else { + for my $i (0..$#{$opts{'x'}}) { + i_ppixf($self->{IMG}, $x->[$i], $y->[$i], $color); + } + } + } + else { + if ($color->isa('Imager::Color')) { + i_ppix($self->{IMG}, $x, $y, $color); + } + else { + i_ppixf($self->{IMG}, $x, $y, $color); + } + } + + $self; +} + +sub getpixel { + my $self = shift; + + my %opts = ( "type"=>'8bit', @_); + + unless (exists $opts{'x'} && exists $opts{'y'}) { + $self->{ERRSTR} = 'missing x and y parameters'; + return undef; + } + + 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 @result; + if ($opts{"type"} eq '8bit') { + for my $i (0..$#{$opts{'x'}}) { + push(@result, i_get_pixel($self->{IMG}, $x->[$i], $y->[$i])); + } } - i_flood_cfill($self->{IMG}, $opts{x}, $opts{'y'}, $opts{fill}{fill}); + else { + for my $i (0..$#{$opts{'x'}}) { + push(@result, i_gpixf($self->{IMG}, $x->[$i], $y->[$i])); + } + } + return wantarray ? @result : \@result; } else { - i_flood_fill($self->{IMG}, $opts{x}, $opts{'y'}, $opts{color}); + if ($opts{"type"} eq '8bit') { + return i_get_pixel($self->{IMG}, $x, $y); + } + else { + return i_gpixf($self->{IMG}, $x, $y); + } } $self; @@ -1782,6 +2399,12 @@ sub convert { my ($self, %opts) = @_; my $matrix; + unless (defined wantarray) { + my @caller = caller; + warn "convert() called in void context - convert() returns the converted image at $caller[1] line $caller[2]\n"; + return; + } + # the user can either specify a matrix or preset # the matrix overrides the preset if (!exists($opts{matrix})) { @@ -1901,6 +2524,27 @@ sub map { return $self; } +sub difference { + my ($self, %opts) = @_; + + defined $opts{mindist} or $opts{mindist} = 0; + + defined $opts{other} + or return $self->_set_error("No 'other' parameter supplied"); + defined $opts{other}{IMG} + or return $self->_set_error("No image data in 'other' image"); + + $self->{IMG} + or return $self->_set_error("No image data"); + + my $result = Imager->new; + $result->{IMG} = i_diff_image($self->{IMG}, $opts{other}{IMG}, + $opts{mindist}) + or return $self->_set_error($self->_error_as_msg()); + + return $result; +} + # destructive border - image is shrunk by one pixel all around sub border { @@ -1955,7 +2599,7 @@ sub setmask { sub getcolorcount { my $self=shift; - my %opts=(maxcolors=>2**30,@_); + my %opts=('maxcolors'=>2**30,@_); if (!defined($self->{IMG})) { $self->{ERRSTR}='image is empty'; return undef; } my $rc=i_count_colors($self->{IMG},$opts{'maxcolors'}); return ($rc==-1? undef : $rc); @@ -2006,18 +2650,33 @@ sub errstr { ref $_[0] ? $_[0]->{ERRSTR} : $ERRSTR } -# Default guess for the type of an image from extension +sub _set_error { + my ($self, $msg) = @_; -sub def_guess_type { - my $name=lc(shift); - my $ext; - $ext=($name =~ m/\.([^\.]+)$/)[0]; + if (ref $self) { + $self->{ERRSTR} = $msg; + } + else { + $ERRSTR = $msg; + } + return; +} + +# Default guess for the type of an image from extension + +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 'rgb' if ($ext eq "rgb"); return 'gif' if ($ext eq "gif"); + return 'raw' if ($ext eq "raw"); return (); } @@ -2067,19 +2726,19 @@ sub parseiptc { if (/^\004\004/) { @sar=split(/\034\002/); foreach $item (@sar) { - if ($item =~ m/^x/) { + if ($item =~ m/^x/) { $caption=&clean($item); $i++; } - if ($item =~ m/^P/) { + if ($item =~ m/^P/) { $photogr=&clean($item); $i++; } - if ($item =~ m/^i/) { + if ($item =~ m/^i/) { $headln=&clean($item); $i++; } - if ($item =~ m/^n/) { + if ($item =~ m/^n/) { $credit=&clean($item); $i++; } @@ -2101,1765 +2760,444 @@ Imager - Perl extension for Generating 24 bit Images =head1 SYNOPSIS - use Imager qw(init); - - init(); - $img = Imager->new(); - $img->open(file=>'image.ppm',type=>'pnm') - || print "failed: ",$img->{ERRSTR},"\n"; - $scaled=$img->scale(xpixels=>400,ypixels=>400); - $scaled->write(file=>'sc_image.ppm',type=>'pnm') - || print "failed: ",$scaled->{ERRSTR},"\n"; - -=head1 DESCRIPTION - -Imager is a module for creating and altering images - It is not meant -as a replacement or a competitor to ImageMagick or GD. Both are -excellent packages and well supported. - -=head2 API - -Almost all functions take the parameters in the hash fashion. -Example: - - $img->open(file=>'lena.png',type=>'png'); - -or just: - - $img->open(file=>'lena.png'); - -=head2 Basic concept - -An Image object is created with C<$img = Imager-Enew()> Should -this fail for some reason an explanation can be found in -C<$Imager::ERRSTR> usually error messages are stored in -C<$img-E{ERRSTR}>, but since no object is created this is the only -way to give back errors. C<$Imager::ERRSTR> is also used to report -all errors not directly associated with an image object. Examples: - - $img=Imager->new(); # This is an empty image (size is 0 by 0) - $img->open(file=>'lena.png',type=>'png'); # initializes from file - -or if you want to create an empty image: - - $img=Imager->new(xsize=>400,ysize=>300,channels=>4); - -This example creates a completely black image of width 400 and -height 300 and 4 channels. - -If you have an existing image, use img_set() to change it's dimensions -- this will destroy any existing image data: - - $img->img_set(xsize=>500, ysize=>500, channels=>4); - -To create paletted images, set the 'type' parameter to 'paletted': - - $img = Imager->new(xsize=>200, ysize=>200, channels=>3, type=>'paletted'); - -which creates an image with a maxiumum of 256 colors, which you can -change by supplying the C parameter. - -You can create a new paletted image from an existing image using the -to_paletted() method: - - $palimg = $img->to_paletted(\%opts) - -where %opts contains the options specified under L. - -You can convert a paletted image (or any image) to an 8-bit/channel -RGB image with: - - $rgbimg = $img->to_rgb8; - -Warning: if you draw on a paletted image with colors that aren't in -the palette, the image will be internally converted to a normal image. - -For improved color precision you can use the bits parameter to specify -16 bites per channel: - - $img = Imager->new(xsize=>200, ysize=>200, channels=>3, bits=>16); - -Note that as of this writing all functions should work on 16-bit -images, but at only 8-bit/channel precision. - -Currently only 8 and 16/bit per channel image types are available, -this may change later. - -Color objects are created by calling the Imager::Color->new() -method: - - $color = Imager::Color->new($red, $green, $blue); - $color = Imager::Color->new($red, $green, $blue, $alpha); - $color = Imager::Color->new("#C0C0FF"); # html color specification - -This object can then be passed to functions that require a color parameter. - -Coordinates in Imager have the origin in the upper left corner. The -horizontal coordinate increases to the right and the vertical -downwards. - -=head2 Reading and writing images - -C<$img-Eread()> generally takes two parameters, 'file' and 'type'. -If the type of the file can be determined from the suffix of the file -it can be omitted. Format dependant parameters are: For images of -type 'raw' two extra parameters are needed 'xsize' and 'ysize', if the -'channel' parameter is omitted for type 'raw' it is assumed to be 3. -gif and png images might have a palette are converted to truecolor bit -when read. Alpha channel is preserved for png images irregardless of -them being in RGB or gray colorspace. Similarly grayscale jpegs are -one channel images after reading them. For jpeg images the iptc -header information (stored in the APP13 header) is avaliable to some -degree. You can get the raw header with C<$img-E{IPTCRAW}>, but -you can also retrieve the most basic information with -C<%hsh=$img-Eparseiptc()> as always patches are welcome. pnm has no -extra options. Examples: - - $img = Imager->new(); - $img->read(file=>"cover.jpg") or die $img->errstr; # gets type from name - - $img = Imager->new(); - { local(*FH,$/); open(FH,"file.gif") or die $!; $a=; } - $img->read(data=>$a,type=>'gif') or die $img->errstr; - -The second example shows how to read an image from a scalar, this is -usefull if your data originates from somewhere else than a filesystem -such as a database over a DBI connection. - -When writing to a tiff image file you can also specify the 'class' -parameter, which can currently take a single value, "fax". If class -is set to fax then a tiff image which should be suitable for faxing -will be written. For the best results start with a grayscale image. -By default the image is written at fine resolution you can override -this by setting the "fax_fine" parameter to 0. - -If you are reading from a gif image file, you can supply a 'colors' -parameter which must be a reference to a scalar. The referenced -scalar will receive an array reference which contains the colors, each -represented as an Imager::Color object. - -If you already have an open file handle, for example a socket or a -pipe, you can specify the 'fd' parameter instead of supplying a -filename. Please be aware that you need to use fileno() to retrieve -the file descriptor for the file: - - $img->read(fd=>fileno(FILE), type=>'gif') or die $img->errstr; - -For writing using the 'fd' option you will probably want to set $| for -that descriptor, since the writes to the file descriptor bypass Perl's -(or the C libraries) buffering. Setting $| should avoid out of order -output. - -*Note that load() is now an alias for read but will be removed later* - -C<$img-Ewrite> has the same interface as C. The earlier -comments on C for autodetecting filetypes apply. For jpegs -quality can be adjusted via the 'jpegquality' parameter (0-100). The -number of colorplanes in gifs are set with 'gifplanes' and should be -between 1 (2 color) and 8 (256 colors). It is also possible to choose -between two quantizing methods with the parameter 'gifquant'. If set -to mc it uses the mediancut algorithm from either giflibrary. If set -to lm it uses a local means algorithm. It is then possible to give -some extra settings. lmdither is the dither deviation amount in pixels -(manhattan distance). lmfixed can be an array ref who holds an array -of Imager::Color objects. Note that the local means algorithm needs -much more cpu time but also gives considerable better results than the -median cut algorithm. - -Currently just for gif files, you can specify various options for the -conversion from Imager's internal RGB format to the target's indexed -file format. If you set the gifquant option to 'gen', you can use the -options specified under L. - -To see what Imager is compiled to support the following code snippet -is sufficient: + # Thumbnail example + #!/usr/bin/perl -w + use strict; use Imager; - print "@{[keys %Imager::formats]}"; - -When reading raw images you need to supply the width and height of the -image in the xsize and ysize options: - - $img->read(file=>'foo.raw', xsize=>100, ysize=>100) - or die "Cannot read raw image\n"; - -If your input file has more channels than you want, or (as is common), -junk in the fourth channel, you can use the datachannels and -storechannels options to control the number of channels in your input -file and the resulting channels in your image. For example, if your -input image uses 32-bits per pixel with red, green, blue and junk -values for each pixel you could do: - - $img->read(file=>'foo.raw', xsize=>100, ysize=>100, datachannels=>4, - storechannels=>3) - or die "Cannot read raw image\n"; -Normally the raw image is expected to have the value for channel 1 -immediately following channel 0 and channel 2 immediately following -channel 1 for each pixel. If your input image has all the channel 0 -values for the first line of the image, followed by all the channel 1 -values for the first line and so on, you can use the interleave option: + die "Usage: thumbmake.pl filename\n" if !-f $ARGV[0]; + my $file = shift; - $img->read(file=>'foo.raw', xsize=100, ysize=>100, interleave=>1) - or die "Cannot read raw image\n"; + my $format; -=head2 Multi-image files - -Currently just for gif files, you can create files that contain more -than one image. - -To do this: - - Imager->write_multi(\%opts, @images) - -Where %opts describes 4 possible types of outputs: - -=over 5 - -=item type - -This is C for gif animations. - -=item callback - -A code reference which is called with a single parameter, the data to -be written. You can also specify $opts{maxbuffer} which is the -maximum amount of data buffered. Note that there can be larger writes -than this if the file library writes larger blocks. A smaller value -maybe useful for writing to a socket for incremental display. - -=item fd - -The file descriptor to save the images to. - -=item file - -The name of the file to write to. - -%opts may also include the keys from L and L. + my $img = Imager->new(); + # see Imager::Files for information on the read() method + $img->read(file=>$file) or die $img->errstr(); -=back + $file =~ s/\.[^.]*$//; -You must also specify the file format using the 'type' option. + # Create smaller version + # documented in Imager::Transformations + my $thumb = $img->scale(scalefactor=>.3); -The current aim is to support other multiple image formats in the -future, such as TIFF, and to support reading multiple images from a -single file. + # Autostretch individual channels + $thumb->filter(type=>'autolevels'); -A simple example: + # try to save in one of these formats + SAVE: - my @images; - # ... code to put images in @images - Imager->write_multi({type=>'gif', - file=>'anim.gif', - gif_delays=>[ (10) x @images ] }, - @images) - or die "Oh dear!"; + for $format ( qw( png gif jpg tiff ppm ) ) { + # Check if given format is supported + if ($Imager::formats{$format}) { + $file.="_low.$format"; + print "Storing image as: $file\n"; + # documented in Imager::Files + $thumb->write(file=>$file) or + die $thumb->errstr; + last SAVE; + } + } -You can read multi-image files (currently only GIF files) using the -read_multi() method: +=head1 DESCRIPTION - my @imgs = Imager->read_multi(file=>'foo.gif') - or die "Cannot read images: ",Imager->errstr; +Imager is a module for creating and altering images. It can read and +write various image formats, draw primitive shapes like lines,and +polygons, blend multiple images together in various ways, scale, crop, +render text and more. -The possible parameters for read_multi() are: +=head2 Overview of documentation =over -=item file - -The name of the file to read in. - -=item fh - -A filehandle to read in. This can be the name of a filehandle, but it -will need the package name, no attempt is currently made to adjust -this to the caller's package. - -=item fd - -The numeric file descriptor of an open file (or socket). - -=item callback - -A function to be called to read in data, eg. reading a blob from a -database incrementally. - -=item data - -The data of the input file in memory. - -=item type - -The type of file. If the file is parameter is given and provides -enough information to guess the type, then this parameter is optional. - -=back - -Note: you cannot use the callback or data parameter with giflib -versions before 4.0. - -When reading from a GIF file with read_multi() the images are returned -as paletted images. - -=head2 Gif options - -These options can be specified when calling write_multi() for gif -files, when writing a single image with the gifquant option set to -'gen', or for direct calls to i_writegif_gen and i_writegif_callback. - -Note that some viewers will ignore some of these options -(gif_user_input in particular). - -=over 4 - -=item gif_each_palette - -Each image in the gif file has it's own palette if this is non-zero. -All but the first image has a local colour table (the first uses the -global colour table. - -=item interlace - -The images are written interlaced if this is non-zero. - -=item gif_delays - -A reference to an array containing the delays between images, in 1/100 -seconds. - -If you want the same delay for every frame you can simply set this to -the delay in 1/100 seconds. - -=item gif_user_input - -A reference to an array contains user input flags. If the given flag -is non-zero the image viewer should wait for input before displaying -the next image. - -=item gif_disposal - -A reference to an array of image disposal methods. These define what -should be done to the image before displaying the next one. These are -integers, where 0 means unspecified, 1 means the image should be left -in place, 2 means restore to background colour and 3 means restore to -the previous value. - -=item gif_tran_color - -A reference to an Imager::Color object, which is the colour to use for -the palette entry used to represent transparency in the palette. You -need to set the transp option (see L) for this -value to be used. - -=item gif_positions - -A reference to an array of references to arrays which represent screen -positions for each image. - -=item gif_loop_count - -If this is non-zero the Netscape loop extension block is generated, -which makes the animation of the images repeat. - -This is currently unimplemented due to some limitations in giflib. - -=back - -=head2 Quantization options - -These options can be specified when calling write_multi() for gif -files, when writing a single image with the gifquant option set to -'gen', or for direct calls to i_writegif_gen and i_writegif_callback. - -=over 4 - -=item colors - -A arrayref of colors that are fixed. Note that some color generators -will ignore this. - -=item transp - -The type of transparency processing to perform for images with an -alpha channel where the output format does not have a proper alpha -channel (eg. gif). This can be any of: - -=over 4 - -=item none - -No transparency processing is done. (default) - -=item threshold - -Pixels more transparent that tr_threshold are rendered as transparent. - -=item errdiff - -An error diffusion dither is done on the alpha channel. Note that -this is independent of the translation performed on the colour -channels, so some combinations may cause undesired artifacts. - -=item ordered - -The ordered dither specified by tr_orddith is performed on the alpha -channel. - -=back - -This will only be used if the image has an alpha channel, and if there -is space in the palette for a transparency colour. - -=item tr_threshold - -The highest alpha value at which a pixel will be made transparent when -transp is 'threshold'. (0-255, default 127) - -=item tr_errdiff - -The type of error diffusion to perform on the alpha channel when -transp is 'errdiff'. This can be any defined error diffusion type -except for custom (see errdiff below). - -=item tr_orddith - -The type of ordered dither to perform on the alpha channel when transp -is 'ordered'. Possible values are: - -=over 4 - -=item random - -A semi-random map is used. The map is the same each time. - -=item dot8 - -8x8 dot dither. - -=item dot4 - -4x4 dot dither - -=item hline - -horizontal line dither. - -=item vline - -vertical line dither. - -=item "/line" - -=item slashline - -diagonal line dither - -=item '\line' - -=item backline - -diagonal line dither - -=item tiny - -dot matrix dither (currently the default). This is probably the best -for displays (like web pages). - -=item custom - -A custom dither matrix is used - see tr_map - -=back - -=item tr_map - -When tr_orddith is custom this defines an 8 x 8 matrix of integers -representing the transparency threshold for pixels corresponding to -each position. This should be a 64 element array where the first 8 -entries correspond to the first row of the matrix. Values should be -betweern 0 and 255. - -=item make_colors - -Defines how the quantization engine will build the palette(s). -Currently this is ignored if 'translate' is 'giflib', but that may -change. Possible values are: - -=over 4 - -=item none - -Only colors supplied in 'colors' are used. - -=item webmap - -The web color map is used (need url here.) - -=item addi - -The original code for generating the color map (Addi's code) is used. - -=back - -Other methods may be added in the future. - -=item colors - -A arrayref containing Imager::Color objects, which represents the -starting set of colors to use in translating the images. webmap will -ignore this. The final colors used are copied back into this array -(which is expanded if necessary.) - -=item max_colors - -The maximum number of colors to use in the image. - -=item translate - -The method used to translate the RGB values in the source image into -the colors selected by make_colors. Note that make_colors is ignored -whene translate is 'giflib'. - -Possible values are: - -=over 4 - -=item giflib - -The giflib native quantization function is used. +=item * -=item closest +Imager - This document - Synopsis Example, Table of Contents and +Overview. -The closest color available is used. +=item * -=item perturb +L - how to do various things with Imager. -The pixel color is modified by perturb, and the closest color is chosen. +=item * -=item errdiff +L - Basics of constructing image objects with +C: Direct type/virtual images, RGB(A)/paletted images, +8/16/double bits/channel, color maps, channel masks, image tags, color +quantization. Also discusses basic image information methods. -An error diffusion dither is performed. +=item * -=back +L - IO interaction, reading/writing images, format +specific tags. -It's possible other transate values will be added. +=item * -=item errdiff +L - Drawing Primitives, lines, boxes, circles, arcs, +flood fill. -The type of error diffusion dither to perform. These values (except -for custom) can also be used in tr_errdif. +=item * -=over 4 +L - Color specification. -=item floyd +=item * -Floyd-Steinberg dither +L - Fill pattern specification. -=item jarvis +=item * -Jarvis, Judice and Ninke dither +L - General font rendering, bounding boxes and font +metrics. -=item stucki +=item * -Stucki dither +L - Copying, scaling, cropping, flipping, +blending, pasting, convert and map. -=item custom +=item * -Custom. If you use this you must also set errdiff_width, -errdiff_height and errdiff_map. +L - Programmable transformations through +C, C and C. -=back +=item * -=item errdiff_width +L - Filters, sharpen, blur, noise, convolve etc. and +filter plugins. -=item errdiff_height +=item * -=item errdiff_orig +L - Expressions for evaluation engine used by +transform2(). -=item errdiff_map +=item * -When translate is 'errdiff' and errdiff is 'custom' these define a -custom error diffusion map. errdiff_width and errdiff_height define -the size of the map in the arrayref in errdiff_map. errdiff_orig is -an integer which indicates the current pixel position in the top row -of the map. +L - Helper class for affine transformations. -=item perturb +=item * -When translate is 'perturb' this is the magnitude of the random bias -applied to each channel of the pixel before it is looked up in the -color table. +L - Helper for making gradient profiles. =back -=head2 Obtaining/setting attributes of images - -To get the size of an image in pixels the C<$img-Egetwidth()> and -C<$img-Egetheight()> are used. - -To get the number of channels in -an image C<$img-Egetchannels()> is used. $img-Egetmask() and -$img-Esetmask() are used to get/set the channel mask of the image. - - $mask=$img->getmask(); - $img->setmask(mask=>1+2); # modify red and green only - $img->setmask(mask=>8); # modify alpha only - $img->setmask(mask=>$mask); # restore previous mask - -The mask of an image describes which channels are updated when some -operation is performed on an image. Naturally it is not possible to -apply masks to operations like scaling that alter the dimensions of -images. - -It is possible to have Imager find the number of colors in an image -by using C<$img-Egetcolorcount()>. It requires memory proportionally -to the number of colors in the image so it is possible to have it -stop sooner if you only need to know if there are more than a certain number -of colors in the image. If there are more colors than asked for -the function return undef. Examples: - - if (!defined($img->getcolorcount(maxcolors=>512)) { - print "Less than 512 colors in image\n"; - } - -The bits() method retrieves the number of bits used to represent each -channel in a pixel, typically 8. The type() method returns either -'direct' for truecolor images or 'paletted' for paletted images. The -virtual() method returns non-zero if the image contains no actual -pixels, for example masked images. - -=head2 Paletted Images - -In general you can work with paletted images in the same way as RGB -images, except that if you attempt to draw to a paletted image with a -color that is not in the image's palette, the image will be converted -to an RGB image. This means that drawing on a paletted image with -anti-aliasing enabled will almost certainly convert the image to RGB. - -You can add colors to a paletted image with the addcolors() method: - - my @colors = ( Imager::Color->new(255, 0, 0), - Imager::Color->new(0, 255, 0) ); - my $index = $img->addcolors(colors=>\@colors); - -The return value is the index of the first color added, or undef if -adding the colors would overflow the palette. - -Once you have colors in the palette you can overwrite them with the -setcolors() method: +=head2 Basic Overview - $img->setcolors(start=>$start, colors=>\@colors); +An Image object is created with C<$img = Imager-Enew()>. +Examples: -Returns true on success. + $img=Imager->new(); # create empty image + $img->read(file=>'lena.png',type=>'png') or # read image from file + die $img->errstr(); # give an explanation + # if something failed -To retrieve existing colors from the palette use the getcolors() method: - - # get the whole palette - my @colors = $img->getcolors(); - # get a single color - my $color = $img->getcolors(start=>$index); - # get a range of colors - my @colors = $img->getcolors(start=>$index, count=>$count); - -To quickly find a color in the palette use findcolor(): - - my $index = $img->findcolor(color=>$color); - -which returns undef on failure, or the index of the color. - -You can get the current palette size with $img->colorcount, and the -maximum size of the palette with $img->maxcolors. - -=head2 Drawing Methods - -IMPLEMENTATION MORE OR LESS DONE CHECK THE TESTS -DOCUMENTATION OF THIS SECTION OUT OF SYNC - -It is possible to draw with graphics primitives onto images. Such -primitives include boxes, arcs, circles and lines. A reference -oriented list follows. - -Box: - $img->box(color=>$blue,xmin=>10,ymin=>30,xmax=>200,ymax=>300,filled=>1); - -The above example calls the C method for the image and the box -covers the pixels with in the rectangle specified. If C is -ommited it is drawn as an outline. If any of the edges of the box are -ommited it will snap to the outer edge of the image in that direction. -Also if a color is omitted a color with (255,255,255,255) is used -instead. - -Arc: - $img->arc(color=>$red, r=20, x=>200, y=>100, d1=>10, d2=>20 ); - -This creates a filled red arc with a 'center' at (200, 100) and spans -10 degrees and the slice has a radius of 20. SEE section on BUGS. - -Both the arc() and box() methods can take a C parameter which -can either be an Imager::Fill object, or a reference to a hash -containing the parameters used to create the fill: - - $img->box(xmin=>10, ymin=>30, xmax=>150, ymax=>60, - fill => { hatch=>'cross2' }); - use Imager::Fill; - my $fill = Imager::Fill->new(hatch=>'stipple'); - $img->box(fill=>$fill); - -See L for the type of fills you can use. - -Circle: - $img->circle(color=>$green, r=50, x=>200, y=>100); - -This creates a green circle with its center at (200, 100) and has a -radius of 20. - -Line: - $img->line(color=>$green, x1=10, x2=>100, - y1=>20, y2=>50, antialias=>1 ); +or if you want to create an empty image: -That draws an antialiased line from (10,100) to (20,50). + $img=Imager->new(xsize=>400,ysize=>300,channels=>4); -Polyline: - $img->polyline(points=>[[$x0,$y0],[$x1,$y1],[$x2,$y2]],color=>$red); - $img->polyline(x=>[$x0,$x1,$x2], y=>[$y0,$y1,$y2], antialias=>1); +This example creates a completely black image of width 400 and height +300 and 4 channels. -Polyline is used to draw multilple lines between a series of points. -The point set can either be specified as an arrayref to an array of -array references (where each such array represents a point). The -other way is to specify two array references. +When an operation fails which can be directly associated with an image +the error message is stored can be retrieved with +C<$img-Eerrstr()>. -You can fill a region that all has the same color using the -flood_fill() method, for example: +In cases where no image object is associated with an operation +C<$Imager::ERRSTR> is used to report errors not directly associated +with an image object. You can also call Cerrstr> to get this +value. - $img->flood_fill(x=>50, y=>50, color=>$color); +The Cnew> method is described in detail in +L. -will fill all regions the same color connected to the point (50, 50). +=head1 METHOD INDEX -You can also use a general fill, so you could fill the same region -with a check pattern using: +Where to find information on methods for Imager class objects. - $img->flood_fill(x=>50, y=>50, fill=>{ hatch=>'check2x2' }); +addcolors() - L -See L for more information on general fills. +addtag() - L - add image tags -=head2 Text rendering +arc() - L -Text rendering is described in the Imager::Font manpage. +bits() - L - number of bits per sample for the +image -=head2 Image resizing +box() - L -To scale an image so porportions are maintained use the -C<$img-Escale()> method. if you give either a xpixels or ypixels -parameter they will determine the width or height respectively. If -both are given the one resulting in a larger image is used. example: -C<$img> is 700 pixels wide and 500 pixels tall. +circle() - L - $img->scale(xpixels=>400); # 400x285 - $img->scale(ypixels=>400); # 560x400 +colorcount() - L - $img->scale(xpixels=>400,ypixels=>400); # 560x400 - $img->scale(xpixels=>400,ypixels=>400,type=>min); # 400x285 +convert() - L - +transform the color space - $img->scale(scalefactor=>0.25); 175x125 $img->scale(); # 350x250 +copy() - L -if you want to create low quality previews of images you can pass -C'preview'> to scale and it will use nearest neighbor -sampling instead of filtering. It is much faster but also generates -worse looking images - especially if the original has a lot of sharp -variations and the scaled image is by more than 3-5 times smaller than -the original. +crop() - L - extract part of an image -If you need to scale images per axis it is best to do it simply by -calling scaleX and scaleY. You can pass either 'scalefactor' or -'pixels' to both functions. +deltag() - L - delete image tags -Another way to resize an image size is to crop it. The parameters -to crop are the edges of the area that you want in the returned image. -If a parameter is omited a default is used instead. +difference() - L - $newimg = $img->crop(left=>50, right=>100, top=>10, bottom=>100); - $newimg = $img->crop(left=>50, top=>10, width=>50, height=>90); - $newimg = $img->crop(left=>50, right=>100); # top +errstr() - L -You can also specify width and height parameters which will produce a -new image cropped from the center of the input image, with the given -width and height. +filter() - L - $newimg = $img->crop(width=>50, height=>50); +findcolor() - L - search the image palette, if it +has one -The width and height parameters take precedence over the left/right -and top/bottom parameters respectively. +flip() - L -=head2 Copying images +flood_fill() - L -To create a copy of an image use the C method. This is usefull -if you want to keep an original after doing something that changes the image -inplace like writing text. +getchannels() - L - $img=$orig->copy(); +getcolorcount() - L -To copy an image to onto another image use the C method. +getcolors() - L - get colors from the image +palette, if it has one - $dest->paste(left=>40,top=>20,img=>$logo); +getheight() - L -That copies the entire C<$logo> image onto the C<$dest> image so that the -upper left corner of the C<$logo> image is at (40,20). +getpixel() - L +getwidth() - L -=head2 Flipping images +img_set() - L -An inplace horizontal or vertical flip is possible by calling the -C method. If the original is to be preserved it's possible to -make a copy first. The only parameter it takes is the C -parameter which can take the values C, C, C and C. +line() - L - $img->flip(dir=>"h"); # horizontal flip - $img->flip(dir=>"vh"); # vertical and horizontal flip - $nimg = $img->copy->flip(dir=>"v"); # make a copy and flip it vertically +map() - L - remap color +channel values -=head2 Rotating images +masked() - L - make a masked image -Use the rotate() method to rotate an image. +matrix_transform() - L -To rotate by an exact amount in degrees or radians, use the 'degrees' -or 'radians' parameter: +maxcolors() - L - my $rot20 = $img->rotate(degrees=>20); - my $rotpi4 = $img->rotate(radians=>3.14159265/4); +new() - L -To rotate in steps of 90 degrees, use the 'right' parameter: +open() - L - an alias for read() - my $rotated = $img->rotate(right=>270); +paste() - L - draw an image onto an image -Rotations are clockwise for positive values. +polygon() - L -=head2 Blending Images +polyline() - L -To put an image or a part of an image directly -into another it is best to call the C method on the image you -want to add to. +read() - L - read a single image from an image file - $img->paste(img=>$srcimage,left=>30,top=>50); +read_multi() - L - read multiple images from an image +file -That will take paste C<$srcimage> into C<$img> with the upper -left corner at (30,50). If no values are given for C -or C they will default to 0. +rotate() - L -A more complicated way of blending images is where one image is -put 'over' the other with a certain amount of opaqueness. The -method that does this is rubthrough. +rubthrough() - L - draw an image onto an +image and use the alpha channel - $img->rubthrough(src=>$srcimage,tx=>30,ty=>50); +scale() - L -That will take the image C<$srcimage> and overlay it with the upper -left corner at (30,50). You can rub 2 or 4 channel images onto a 3 -channel image, or a 2 channel image onto a 1 channel image. The last -channel is used as an alpha channel. +scaleX() - L +scaleY() - L -=head2 Filters +setcolors() - L - set palette colors in a paletted image -A special image method is the filter method. An example is: +setpixel() - L - $img->filter(type=>'autolevels'); +string() - L - draw text on an image -This will call the autolevels filter. Here is a list of the filters -that are always avaliable in Imager. This list can be obtained by -running the C script that comes with the module -source. +tags() - L - fetch image tags - Filter Arguments - autolevels lsat(0.1) usat(0.1) skew(0) - bumpmap bump elevation(0) lightx lighty st(2) - contrast intensity - conv coef - fountain xa ya xb yb ftype(linear) repeat(none) combine(none) - super_sample(none) ssample_param(4) segments(see below) - gaussian stddev - gradgen xo yo colors dist - hardinvert - mosaic size(20) - noise amount(3) subtype(0) - postlevels levels(10) - radnoise xo(100) yo(100) ascale(17.0) rscale(0.02) - turbnoise xo(0.0) yo(0.0) scale(10.0) - watermark wmark pixdiff(10) tx(0) ty(0) +to_paletted() - L -The default values are in parenthesis. All parameters must have some -value but if a parameter has a default value it may be omitted when -calling the filter function. +to_rgb8() - L -The filters are: +transform() - L -=over +transform2() - L -=item autolevels +type() - L - type of image (direct vs paletted) -scales the value of each channel so that the values in the image will -cover the whole possible range for the channel. I and I -truncate the range by the specified fraction at the top and bottom of -the range respectivly.. +virtual() - L - whether the image has it's own +data -=item bumpmap +write() - L - write an image to a file -uses the channel I image I as a bumpmap on your -image, with the light at (I, I), with a shadow length -of I. +write_multi() - L - write multiple image to an image +file. -=item contrast +=head1 CONCEPT INDEX -scales each channel by I. Values of I < 1.0 -will reduce the contrast. +animated GIF - L -=item conv +aspect ratio - L, +L, L -performs 2 1-dimensional convolutions on the image using the values -from I. I should be have an odd length. +blur - L, L -=item fountain +boxes, drawing - L -renders a fountain fill, similar to the gradient tool in most paint -software. The default fill is a linear fill from opaque black to -opaque white. The points A(xa, ya) and B(xb, yb) control the way the -fill is performed, depending on the ftype parameter: +color - L -=over +color names - L, L -=item linear +combine modes - L -the fill ramps from A through to B. +contrast - L, L -=item bilinear +convolution - L -the fill ramps in both directions from A, where AB defines the length -of the gradient. +cropping - L -=item radial +dpi - L -A is the center of a circle, and B is a point on it's circumference. -The fill ramps from the center out to the circumference. +drawing boxes - L -=item radial_square +drawing lines - L -A is the center of a square and B is the center of one of it's sides. -This can be used to rotate the square. The fill ramps out to the -edges of the square. +drawing text - L -=item revolution +error message - L -A is the centre of a circle and B is a point on it's circumference. B -marks the 0 and 360 point on the circle, with the fill ramping -clockwise. +files, font - L -=item conical +files, image - L -A is the center of a circle and B is a point on it's circumference. B -marks the 0 and point on the circle, with the fill ramping in both -directions to meet opposite. +filling, types of fill - L -=back +filling, boxes - L -The I option controls how the fill is repeated for some -Is after it leaves the AB range: +filling, flood fill - L -=over +flood fill - L -=item none +fonts - L -no repeats, points outside of each range are treated as if they were -on the extreme end of that range. +fonts, drawing with - L, L, +L -=item sawtooth +fonts, metrics - L, L -the fill simply repeats in the positive direction +fonts, multiple master - L -=item triangle +fountain fill - L, +L, L, +L -the fill repeats in reverse and then forward and so on, in the -positive direction +GIF files - L -=item saw_both +GIF files, animated - L -the fill repeats in both the positive and negative directions (only -meaningful for a linear fill). +gradient fill - L, +L, L, +L -=item tri_both +guassian blur - L -as for triangle, but in the negative direction too (only meaningful -for a linear fill). +hatch fills - L -=back +invert image - L -By default the fill simply overwrites the whole image (unless you have -parts of the range 0 through 1 that aren't covered by a segment), if -any segments of your fill have any transparency, you can set the -I option to 'normal' to have the fill combined with the -existing pixels. See the description of I in L. +JPEG - L -If your fill has sharp edges, for example between steps if you use -repeat set to 'triangle', you may see some aliased or ragged edges. -You can enable super-sampling which will take extra samples within the -pixel in an attempt anti-alias the fill. +lines, drawing - L -The possible values for the super_sample option are: +matrix - L, +L, +L -=over +metadata, image - L -=item none +mosaic - L -no super-sampling is done +noise, filter - L -=item grid +noise, rendered - L, +L -a square grid of points are sampled. The number of points sampled is -the square of ceil(0.5 + sqrt(ssample_param)). +posterize - L -=item random +png files - L, L -a random set of points within the pixel are sampled. This looks -pretty bad for low ssample_param values. +pnm - L -=item circle +rectangles, drawing - L -the points on the radius of a circle within the pixel are sampled. -This seems to produce the best results, but is fairly slow (for now). +resizing an image - L, +L -=back +saving an image - L -You can control the level of sampling by setting the ssample_param -option. This is roughly the number of points sampled, but depends on -the type of sampling. +scaling - L -The segments option is an arrayref of segments. You really should use -the Imager::Fountain class to build your fountain fill. Each segment -is an array ref containing: +sharpen - L, L -=over +size, image - L, +L -=item start +size, text - L -a floating point number between 0 and 1, the start of the range of fill parameters covered by this segment. +text, drawing - L, L, +L -=item middle +text, wrapping text in an area - L -a floating point number between start and end which can be used to -push the color range towards one end of the segment. +text, measuring - L, L -=item end +tiles, color - L -a floating point number between 0 and 1, the end of the range of fill -parameters covered by this segment. This should be greater than -start. +unsharp mask - L -=item c0 +watermark - L -=item c1 +writing an image - L -The colors at each end of the segment. These can be either -Imager::Color or Imager::Color::Float objects. +=head1 SUPPORT -=item segment type +You can ask for help, report bugs or express your undying love for +Imager on the Imager-devel mailing list. -The type of segment, this controls the way the fill parameter varies -over the segment. 0 for linear, 1 for curved (unimplemented), 2 for -sine, 3 for sphere increasing, 4 for sphere decreasing. +To subscribe send a message with C in the body to: -=item color type + imager-devel+request@molar.is -The way the color varies within the segment, 0 for simple RGB, 1 for -hue increasing and 2 for hue decreasing. +or use the form at: -=back + http://www.molar.is/en/lists/imager-devel/ + (annonymous is temporarily off due to spam) -Don't forgot to use Imager::Fountain instead of building your own. -Really. It even loads GIMP gradient files. +where you can also find the mailing list archive. -=item gaussian +If you're into IRC, you can typically find the developers in #Imager +on irc.perl.org. As with any IRC channel, the participants could be +occupied or asleep, so please be patient. -performs a gaussian blur of the image, using I as the standard -deviation of the curve used to combine pixels, larger values give -bigger blurs. For a definition of Gaussian Blur, see: +You can report bugs by pointing your browser at: - http://www.maths.abdn.ac.uk/~igc/tch/mx4002/notes/node99.html + https://rt.cpan.org/NoAuth/ReportBug.html?Queue=Imager -=item gradgen +Please remember to include the versions of Imager, perl, supporting +libraries, and any relevant code. If you have specific images that +cause the problems, please include those too. -renders a gradient, with the given I at the corresponding -points (x,y) in I and I. You can specify the way distance is -measured for color blendeing by setting I to 0 for Euclidean, 1 -for Euclidean squared, and 2 for Manhattan distance. +=head1 BUGS -=item hardinvert +Bugs are listed individually for relevant pod pages. -inverts the image, black to white, white to black. All channels are -inverted, including the alpha channel if any. +=head1 AUTHOR -=item mosaic +Arnar M. Hrafnkelsson (addi@imager.perl.org) and Tony Cook +(tony@imager.perl.org) See the README for a complete list. -produces averaged tiles of the given I. +=head1 SEE ALSO -=item noise - -adds noise of the given I to the image. If I is -zero, the noise is even to each channel, otherwise noise is added to -each channel independently. - -=item radnoise - -renders radiant Perlin turbulent noise. The centre of the noise is at -(I, I), I controls the angular scale of the noise , -and I the radial scale, higher numbers give more detail. - -=item postlevels - -alters the image to have only I distinct level in each -channel. - -=item turbnoise - -renders Perlin turbulent noise. (I, I) controls the origin of -the noise, and I the scale of the noise, with lower numbers -giving more detail. - -=item watermark - -applies I as a watermark on the image with strength I, -with an origin at (I, I) - -=back - -A demonstration of most of the filters can be found at: - - http://www.develop-help.com/imager/filters.html - -(This is a slow link.) - -=head2 Color transformations - -You can use the convert method to transform the color space of an -image using a matrix. For ease of use some presets are provided. - -The convert method can be used to: - -=over 4 - -=item * - -convert an RGB or RGBA image to grayscale. - -=item * - -convert a grayscale image to RGB. - -=item * - -extract a single channel from an image. - -=item * - -set a given channel to a particular value (or from another channel) - -=back - -The currently defined presets are: - -=over - -=item gray - -=item grey - -converts an RGBA image into a grayscale image with alpha channel, or -an RGB image into a grayscale image without an alpha channel. - -This weights the RGB channels at 22.2%, 70.7% and 7.1% respectively. - -=item noalpha - -removes the alpha channel from a 2 or 4 channel image. An identity -for other images. - -=item red - -=item channel0 - -extracts the first channel of the image into a single channel image - -=item green - -=item channel1 - -extracts the second channel of the image into a single channel image - -=item blue - -=item channel2 - -extracts the third channel of the image into a single channel image - -=item alpha - -extracts the alpha channel of the image into a single channel image. - -If the image has 1 or 3 channels (assumed to be grayscale of RGB) then -the resulting image will be all white. - -=item rgb - -converts a grayscale image to RGB, preserving the alpha channel if any - -=item addalpha - -adds an alpha channel to a grayscale or RGB image. Preserves an -existing alpha channel for a 2 or 4 channel image. - -=back - -For example, to convert an RGB image into a greyscale image: - - $new = $img->convert(preset=>'grey'); # or gray - -or to convert a grayscale image to an RGB image: - - $new = $img->convert(preset=>'rgb'); - -The presets aren't necessary simple constants in the code, some are -generated based on the number of channels in the input image. - -If you want to perform some other colour transformation, you can use -the 'matrix' parameter. - -For each output pixel the following matrix multiplication is done: - - channel[0] [ [ $c00, $c01, ... ] inchannel[0] - [ ... ] = ... x [ ... ] - channel[n-1] [ $cn0, ..., $cnn ] ] inchannel[max] - 1 - -So if you want to swap the red and green channels on a 3 channel image: - - $new = $img->convert(matrix=>[ [ 0, 1, 0 ], - [ 1, 0, 0 ], - [ 0, 0, 1 ] ]); - -or to convert a 3 channel image to greyscale using equal weightings: - - $new = $img->convert(matrix=>[ [ 0.333, 0.333, 0.334 ] ]) - -=head2 Color Mappings - -You can use the map method to map the values of each channel of an -image independently using a list of lookup tables. It's important to -realize that the modification is made inplace. The function simply -returns the input image again or undef on failure. - -Each channel is mapped independently through a lookup table with 256 -entries. The elements in the table should not be less than 0 and not -greater than 255. If they are out of the 0..255 range they are -clamped to the range. If a table does not contain 256 entries it is -silently ignored. - -Single channels can mapped by specifying their name and the mapping -table. The channel names are C, C, C, C. - - @map = map { int( $_/2 } 0..255; - $img->map( red=>\@map ); - -It is also possible to specify a single map that is applied to all -channels, alpha channel included. For example this applies a gamma -correction with a gamma of 1.4 to the input image. - - $gamma = 1.4; - @map = map { int( 0.5 + 255*($_/255)**$gamma ) } 0..255; - $img->map(all=> \@map); - -The C map is used as a default channel, if no other map is -specified for a channel then the C map is used instead. If we -had not wanted to apply gamma to the alpha channel we would have used: - - $img->map(all=> \@map, alpha=>[]); - -Since C<[]> contains fewer than 256 element the gamma channel is -unaffected. - -It is also possible to simply specify an array of maps that are -applied to the images in the rgba order. For example to apply -maps to the C and C channels one would use: - - $img->map(maps=>[\@redmap, [], \@bluemap]); - - - -=head2 Transformations - -Another special image method is transform. It can be used to generate -warps and rotations and such features. It can be given the operations -in postfix notation or the module Affix::Infix2Postfix can be used. -Look in the test case t/t55trans.t for an example. - -transform() needs expressions (or opcodes) that determine the source -pixel for each target pixel. Source expressions are infix expressions -using any of the +, -, *, / or ** binary operators, the - unary -operator, ( and ) for grouping and the sin() and cos() functions. The -target pixel is input as the variables x and y. - -You specify the x and y expressions as xexpr and yexpr respectively. -You can also specify opcodes directly, but that's magic deep enough -that you can look at the source code. - -You can still use the transform() function, but the transform2() -function is just as fast and is more likely to be enhanced and -maintained. - -Later versions of Imager also support a transform2() class method -which allows you perform a more general set of operations, rather than -just specifying a spatial transformation as with the transform() -method, you can also perform colour transformations, image synthesis -and image combinations. - -transform2() takes an reference to an options hash, and a list of -images to operate one (this list may be empty): - - my %opts; - my @imgs; - ... - my $img = Imager::transform2(\%opts, @imgs) - or die "transform2 failed: $Imager::ERRSTR"; - -The options hash may define a transformation function, and optionally: - -=over 4 - -=item * - -width - the width of the image in pixels. If this isn't supplied the -width of the first input image is used. If there are no input images -an error occurs. - -=item * - -height - the height of the image in pixels. If this isn't supplied -the height of the first input image is used. If there are no input -images an error occurs. - -=item * - -constants - a reference to hash of constants to define for the -expression engine. Some extra constants are defined by Imager - -=back - -The tranformation function is specified using either the expr or -rpnexpr member of the options. - -=over 4 - -=item Infix expressions - -You can supply infix expressions to transform 2 with the expr keyword. - -$opts{expr} = 'return getp1(w-x, h-y)' - -The 'expression' supplied follows this general grammar: - - ( identifier '=' expr ';' )* 'return' expr - -This allows you to simplify your expressions using variables. - -A more complex example might be: - -$opts{expr} = 'pix = getp1(x,y); return if(value(pix)>0.8,pix*0.8,pix)' - -Currently to use infix expressions you must have the Parse::RecDescent -module installed (available from CPAN). There is also what might be a -significant delay the first time you run the infix expression parser -due to the compilation of the expression grammar. - -=item Postfix expressions - -You can supply postfix or reverse-polish notation expressions to -transform2() through the rpnexpr keyword. - -The parser for rpnexpr emulates a stack machine, so operators will -expect to see their parameters on top of the stack. A stack machine -isn't actually used during the image transformation itself. - -You can store the value at the top of the stack in a variable called -foo using !foo and retrieve that value again using @foo. The !foo -notation will pop the value from the stack. - -An example equivalent to the infix expression above: - - $opts{rpnexpr} = 'x y getp1 !pix @pix value 0.8 gt @pix 0.8 * @pix ifp' - -=back - -transform2() has a fairly rich range of operators. - -=over 4 - -=item +, *, -, /, %, ** - -multiplication, addition, subtraction, division, remainder and -exponentiation. Multiplication, addition and subtraction can be used -on colour values too - though you need to be careful - adding 2 white -values together and multiplying by 0.5 will give you grey, not white. - -Division by zero (or a small number) just results in a large number. -Modulo zero (or a small number) results in zero. - -=item sin(N), cos(N), atan2(y,x) - -Some basic trig functions. They work in radians, so you can't just -use the hue values. - -=item distance(x1, y1, x2, y2) - -Find the distance between two points. This is handy (along with -atan2()) for producing circular effects. - -=item sqrt(n) - -Find the square root. I haven't had much use for this since adding -the distance() function. - -=item abs(n) - -Find the absolute value. - -=item getp1(x,y), getp2(x,y), getp3(x, y) - -Get the pixel at position (x,y) from the first, second or third image -respectively. I may add a getpn() function at some point, but this -prevents static checking of the instructions against the number of -images actually passed in. - -=item value(c), hue(c), sat(c), hsv(h,s,v) - -Separates a colour value into it's value (brightness), hue (colour) -and saturation elements. Use hsv() to put them back together (after -suitable manipulation). - -=item red(c), green(c), blue(c), rgb(r,g,b) - -Separates a colour value into it's red, green and blue colours. Use -rgb(r,g,b) to put it back together. - -=item int(n) - -Convert a value to an integer. Uses a C int cast, so it may break on -large values. - -=item if(cond,ntrue,nfalse), if(cond,ctrue,cfalse) - -A simple (and inefficient) if function. - -=item <=,<,==,>=,>,!= - -Relational operators (typically used with if()). Since we're working -with floating point values the equalities are 'near equalities' - an -epsilon value is used. - -=item &&, ||, not(n) - -Basic logical operators. - -=back - -A few examples: - -=over 4 - -=item rpnexpr=>'x 25 % 15 * y 35 % 10 * getp1 !pat x y getp1 !pix @pix sat 0.7 gt @pat @pix ifp' - -tiles a smaller version of the input image over itself where the -colour has a saturation over 0.7. - -=item rpnexpr=>'x 25 % 15 * y 35 % 10 * getp1 !pat y 360 / !rat x y getp1 1 @rat - pmult @pat @rat pmult padd' - -tiles the input image over itself so that at the top of the image the -full-size image is at full strength and at the bottom the tiling is -most visible. - -=item rpnexpr=>'x y getp1 !pix @pix value 0.96 gt @pix sat 0.1 lt and 128 128 255 rgb @pix ifp' - -replace pixels that are white or almost white with a palish blue - -=item rpnexpr=>'x 35 % 10 * y 45 % 8 * getp1 !pat x y getp1 !pix @pix sat 0.2 lt @pix value 0.9 gt and @pix @pat @pix value 2 / 0.5 + pmult ifp' - -Tiles the input image overitself where the image isn't white or almost -white. - -=item rpnexpr=>'x y 160 180 distance !d y 180 - x 160 - atan2 !a @d 10 / @a + 3.1416 2 * % !a2 @a2 180 * 3.1416 / 1 @a2 sin 1 + 2 / hsv' - -Produces a spiral. - -=item rpnexpr=>'x y 160 180 distance !d y 180 - x 160 - atan2 !a @d 10 / @a + 3.1416 2 * % !a2 @a 180 * 3.1416 / 1 @a2 sin 1 + 2 / hsv' - -A spiral built on top of a colour wheel. - -=back - -For details on expression parsing see L. For details on -the virtual machine used to transform the images, see -L. - -=head2 Matrix Transformations - -Rather than having to write code in a little language, you can use a -matrix to perform transformations, using the matrix_transform() -method: - - my $im2 = $im->matrix_transform(matrix=>[ -1, 0, $im->getwidth-1, - 0, 1, 0, - 0, 0, 1 ]); - -By default the output image will be the same size as the input image, -but you can supply the xsize and ysize parameters to change the size. - -Rather than building matrices by hand you can use the Imager::Matrix2d -module to build the matrices. This class has methods to allow you to -scale, shear, rotate, translate and reflect, and you can combine these -with an overloaded multiplication operator. - -WARNING: the matrix you provide in the matrix operator transforms the -co-ordinates within the B image to the co-ordinates -within the I image. This can be confusing. - -Since Imager has 3 different fairly general ways of transforming an -image spatially, this method also has a yatf() alias. Yet Another -Transformation Function. - -=head2 Masked Images - -Masked images let you control which pixels are modified in an -underlying image. Where the first channel is completely black in the -mask image, writes to the underlying image are ignored. - -For example, given a base image called $img: - - my $mask = Imager->new(xsize=>$img->getwidth, ysize=>getheight, - channels=>1); - # ... draw something on the mask - my $maskedimg = $img->masked(mask=>$mask); - -You can specifiy the region of the underlying image that is masked -using the left, top, right and bottom options. - -If you just want a subset of the image, without masking, just specify -the region without specifying a mask. - -=head2 Plugins - -It is possible to add filters to the module without recompiling the -module itself. This is done by using DSOs (Dynamic shared object) -avaliable on most systems. This way you can maintain our own filters -and not have to get me to add it, or worse patch every new version of -the Module. Modules can be loaded AND UNLOADED at runtime. This -means that you can have a server/daemon thingy that can do something -like: - - load_plugin("dynfilt/dyntest.so") || die "unable to load plugin\n"; - %hsh=(a=>35,b=>200,type=>lin_stretch); - $img->filter(%hsh); - unload_plugin("dynfilt/dyntest.so") || die "unable to load plugin\n"; - $img->write(type=>'pnm',file=>'testout/t60.jpg') - || die "error in write()\n"; - -Someone decides that the filter is not working as it should - -dyntest.c modified and recompiled. - - load_plugin("dynfilt/dyntest.so") || die "unable to load plugin\n"; - $img->filter(%hsh); - -An example plugin comes with the module - Please send feedback to -addi@umich.edu if you test this. - -Note: This seems to test ok on the following systems: -Linux, Solaris, HPUX, OpenBSD, FreeBSD, TRU64/OSF1, AIX. -If you test this on other systems please let me know. - -=head2 Tags - -Image tags contain meta-data about the image, ie. information not -stored as pixels of the image. - -At the perl level each tag has a name or code and a value, which is an -integer or an arbitrary string. An image can contain more than one -tag with the same name or code. - -You can retrieve tags from an image using the tags() method, you can -get all of the tags in an image, as a list of array references, with -the code or name of the tag followed by the value of the tag: - - my @alltags = $img->tags; - -or you can get all tags that have a given name: - - my @namedtags = $img->tags(name=>$name); - -or a given code: - - my @tags = $img->tags(code=>$code); - -You can add tags using the addtag() method, either by name: - - my $index = $img->addtag(name=>$name, value=>$value); - -or by code: - - my $index = $img->addtag(code=>$code, value=>$value); - -You can remove tags with the deltag() method, either by index: - - $img->deltag(index=>$index); - -or by name: - - $img->deltag(name=>$name); - -or by code: - - $img->deltag(code=>$code); - -In each case deltag() returns the number of tags deleted. - -When you read a GIF image using read_multi(), each image can include -the following tags: - -=over - -=item gif_left - -the offset of the image from the left of the "screen" ("Image Left -Position") - -=item gif_top - -the offset of the image from the top of the "screen" ("Image Top Position") - -=item gif_interlace - -non-zero if the image was interlaced ("Interlace Flag") - -=item gif_screen_width - -=item gif_screen_height - -the size of the logical screen ("Logical Screen Width", -"Logical Screen Height") - -=item gif_local_map - -Non-zero if this image had a local color map. - -=item gif_background - -The index in the global colormap of the logical screen's background -color. This is only set if the current image uses the global -colormap. - -=item gif_trans_index - -The index of the color in the colormap used for transparency. If the -image has a transparency then it is returned as a 4 channel image with -the alpha set to zero in this palette entry. ("Transparent Color Index") - -=item gif_delay - -The delay until the next frame is displayed, in 1/100 of a second. -("Delay Time"). - -=item gif_user_input - -whether or not a user input is expected before continuing (view dependent) -("User Input Flag"). - -=item gif_disposal - -how the next frame is displayed ("Disposal Method") - -=item gif_loop - -the number of loops from the Netscape Loop extension. This may be zero. - -=item gif_comment - -the first block of the first gif comment before each image. - -=back - -Where applicable, the ("name") is the name of that field from the GIF89 -standard. - -The following tags are set in a TIFF image when read, and can be set -to control output: - -=over - -=item tiff_resolutionunit - -The value of the ResolutionUnit tag. This is ignored on writing if -the i_aspect_only tag is non-zero. - -=back - -The following tags are set when reading a Windows BMP file is read: - -=over - -=item bmp_compression - -The type of compression, if any. - -=item bmp_important_colors - -The number of important colors as defined by the writer of the image. - -=back - -Some standard tags will be implemented as time goes by: - -=over - -=item i_xres - -=item i_yres - -The spatial resolution of the image in pixels per inch. If the image -format uses a different scale, eg. pixels per meter, then this value -is converted. A floating point number stored as a string. - -=item i_aspect_only - -If this is non-zero then the values in i_xres and i_yres are treated -as a ratio only. If the image format does not support aspect ratios -then this is scaled so the smaller value is 72dpi. - -=back - -=head1 BUGS - -box, arc, circle do not support antialiasing yet. arc, is only filled -as of yet. Some routines do not return $self where they should. This -affects code like this, C<$img-Ebox()-Earc()> where an object -is expected. - -When saving Gif images the program does NOT try to shave of extra -colors if it is possible. If you specify 128 colors and there are -only 2 colors used - it will have a 128 colortable anyway. - -=head1 AUTHOR - -Arnar M. Hrafnkelsson, addi@umich.edu, and recently lots of assistance -from Tony Cook. See the README for a complete list. - -=head1 SEE ALSO +perl(1), Imager::ImageTypes(3), Imager::Files(3), Imager::Draw(3), +Imager::Color(3), Imager::Fill(3), Imager::Font(3), +Imager::Transformations(3), Imager::Engines(3), Imager::Filters(3), +Imager::Expr(3), Imager::Matrix2d(3), Imager::Fountain(3) -perl(1), Imager::Color(3), Imager::Font(3), Imager::Matrix2d(3), -Affix::Infix2Postfix(3), Parse::RecDescent(3) -http://www.eecs.umich.edu/~addi/perl/Imager/ +Affix::Infix2Postfix(3), Parse::RecDescent(3) +http://imager.perl.org/ =cut