package Imager;
use strict;
-use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS %formats $DEBUG %filters %DSOs $ERRSTR $fontstate %OPCODES $I2P $FORMATGUESS $warn_obsolete);
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS %formats $DEBUG %filters %DSOs $ERRSTR %OPCODES $I2P $FORMATGUESS $warn_obsolete);
use IO::File;
use Imager::Color;
i_tt_text
i_tt_bbox
- i_readjpeg_wiol
- i_writejpeg_wiol
-
- i_readtiff_wiol
- i_writetiff_wiol
- i_writetiff_wiol_faxable
-
- i_readpng_wiol
- i_writepng_wiol
-
- i_readgif
- i_readgif_wiol
- i_readgif_callback
- i_writegif
- i_writegifmc
- i_writegif_gen
- i_writegif_callback
-
i_readpnm_wiol
i_writeppm_wiol
BEGIN {
require Exporter;
@ISA = qw(Exporter);
- $VERSION = '0.73';
+ $VERSION = '0.77_01';
eval {
require XSLoader;
XSLoader::load(Imager => $VERSION);
}
}
-BEGIN {
- Imager::Font::__init();
- for(i_list_formats()) { $formats{$_}++; }
+my %formats_low;
+my %format_classes =
+ (
+ png => "Imager::File::PNG",
+ gif => "Imager::File::GIF",
+ tiff => "Imager::File::TIFF",
+ jpeg => "Imager::File::JPEG",
+ w32 => "Imager::Font::W32",
+ ft2 => "Imager::Font::FT2",
+ );
- if (!$formats{'t1'} and !$formats{'tt'}
- && !$formats{'ft2'} && !$formats{'w32'}) {
- $fontstate='no font support';
- }
+tie %formats, "Imager::FORMATS", \%formats_low, \%format_classes;
+
+BEGIN {
+ for(i_list_formats()) { $formats_low{$_}++; }
%OPCODES=(Add=>[0],Sub=>[1],Mult=>[2],Div=>[3],Parm=>[4],'sin'=>[5],'cos'=>[6],'x'=>[4,0],'y'=>[4,1]);
callsub => sub { my %hsh=@_; i_hardinvert($hsh{image}); }
};
+ $filters{hardinvertall} =
+ {
+ callseq => ['image'],
+ defaults => { },
+ callsub => sub { my %hsh=@_; i_hardinvertall($hsh{image}); }
+ };
+
$filters{autolevels} ={
callseq => ['image','lsat','usat','skew'],
defaults => { lsat=>0.1,usat=>0.1,skew=>0.0 },
defined $hsh{fh} ||
defined $hsh{fd} ||
defined $hsh{callback} ||
- defined $hsh{readcb}) {
+ defined $hsh{readcb} ||
+ defined $hsh{data}) {
# allow $img = Imager->new(file => $filename)
my %extras;
return $readers{$input{type}}{single}->($self, $IO, %input);
}
- unless ($formats{$input{'type'}}) {
+ unless ($formats_low{$input{'type'}}) {
my $read_types = join ', ', sort Imager->read_types();
$self->_set_error("format '$input{'type'}' not supported - formats $read_types available for reading");
return;
}
- # Setup data source
- if ( $input{'type'} eq 'jpeg' ) {
- ($self->{IMG},$self->{IPTCRAW}) = i_readjpeg_wiol( $IO );
- if ( !defined($self->{IMG}) ) {
- $self->{ERRSTR}=$self->_error_as_msg(); return undef;
- }
- $self->{DEBUG} && print "loading a jpeg file\n";
- return $self;
- }
-
my $allow_incomplete = $input{allow_incomplete};
defined $allow_incomplete or $allow_incomplete = 0;
- if ( $input{'type'} eq 'tiff' ) {
- my $page = $input{'page'};
- defined $page or $page = 0;
- $self->{IMG}=i_readtiff_wiol( $IO, $allow_incomplete, $page );
- if ( !defined($self->{IMG}) ) {
- $self->{ERRSTR}=$self->_error_as_msg(); return undef;
- }
- $self->{DEBUG} && print "loading a tiff file\n";
- return $self;
- }
-
if ( $input{'type'} eq 'pnm' ) {
$self->{IMG}=i_readpnm_wiol( $IO, $allow_incomplete );
if ( !defined($self->{IMG}) ) {
return $self;
}
- if ( $input{'type'} eq 'png' ) {
- $self->{IMG}=i_readpng_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed
- if ( !defined($self->{IMG}) ) {
- $self->{ERRSTR} = $self->_error_as_msg();
- return undef;
- }
- $self->{DEBUG} && print "loading a png file\n";
- }
-
if ( $input{'type'} eq 'bmp' ) {
$self->{IMG}=i_readbmp_wiol( $IO, $allow_incomplete );
if ( !defined($self->{IMG}) ) {
sub _reader_autoload {
my $type = shift;
- return if $formats{$type} || $readers{$type};
+ return if $formats_low{$type} || $readers{$type};
return unless $type =~ /^\w+$/;
sub _writer_autoload {
my $type = shift;
- return if $formats{$type} || $readers{$type};
+ return if $formats_low{$type} || $readers{$type};
return unless $type =~ /^\w+$/;
or return undef;
}
else {
- if (!$formats{$input{'type'}}) {
+ if (!$formats_low{$input{'type'}}) {
my $write_types = join ', ', sort Imager->write_types();
$self->_set_error("format '$input{'type'}' not supported - formats $write_types available for writing");
return undef;
($IO, $fh) = $self->_get_writer_io(\%input, $input{'type'})
or return undef;
- if ($input{'type'} eq 'tiff') {
- $self->_set_opts(\%input, "tiff_", $self)
- or return undef;
- $self->_set_opts(\%input, "exif_", $self)
- or return undef;
-
- if (defined $input{class} && $input{class} eq 'fax') {
- if (!i_writetiff_wiol_faxable($self->{IMG}, $IO, $input{fax_fine})) {
- $self->{ERRSTR} = $self->_error_as_msg();
- return undef;
- }
- } else {
- if (!i_writetiff_wiol($self->{IMG}, $IO)) {
- $self->{ERRSTR} = $self->_error_as_msg();
- return undef;
- }
- }
- } elsif ( $input{'type'} eq 'pnm' ) {
+ if ( $input{'type'} eq 'pnm' ) {
$self->_set_opts(\%input, "pnm_", $self)
or return undef;
if ( ! i_writeppm_wiol($self->{IMG},$IO) ) {
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;
($IO, $file) = $class->_get_writer_io($opts, $type)
or return undef;
- if ($type eq 'gif') {
- $class->_set_opts($opts, "gif_", @images)
- or return;
- my $gif_delays = $opts->{gif_delays};
- local $opts->{gif_delays} = $gif_delays;
- if ($opts->{gif_delays} && !ref $opts->{gif_delays}) {
- # assume the caller wants the same delay for each frame
- $opts->{gif_delays} = [ ($gif_delays) x @images ];
- }
- unless (i_writegif_wiol($IO, $opts, @work)) {
- $class->_set_error($class->_error_as_msg());
- return undef;
- }
- }
- elsif ($type eq 'tiff') {
- $class->_set_opts($opts, "tiff_", @images)
- or return;
- $class->_set_opts($opts, "exif_", @images)
- or return;
- my $res;
- $opts->{fax_fine} = 1 unless exists $opts->{fax_fine};
- if ($opts->{'class'} && $opts->{'class'} eq 'fax') {
- $res = i_writetiff_multi_wiol_faxable($IO, $opts->{fax_fine}, @work);
- }
- else {
- $res = i_writetiff_multi_wiol($IO, @work);
- }
- unless ($res) {
- $class->_set_error($class->_error_as_msg());
- return undef;
- }
+ if (0) { # eventually PNM in here, now that TIFF/GIF are elsewhere
}
else {
if (@images == 1) {
return;
}
- if ($type eq 'gif') {
- my @imgs;
- @imgs = i_readgif_multi_wiol($IO);
- if (@imgs) {
- return map {
- bless { IMG=>$_, DEBUG=>$DEBUG, ERRSTR=>undef }, 'Imager'
- } @imgs;
- }
- else {
- $ERRSTR = _error_as_msg();
- return;
- }
- }
- elsif ($type eq 'tiff') {
- my @imgs = i_readtiff_multi_wiol($IO, -1);
- if (@imgs) {
- return map {
- bless { IMG=>$_, DEBUG=>$DEBUG, ERRSTR=>undef }, 'Imager'
- } @imgs;
- }
- else {
- $ERRSTR = _error_as_msg();
- return;
- }
+ my @imgs;
+ if ($type eq 'pnm') {
+ @imgs = i_readpnm_multi_wiol($IO, $opts{allow_incomplete}||0);
}
else {
my $img = Imager->new;
return ( $img );
}
Imager->_set_error($img->errstr);
+ return;
}
+ if (!@imgs) {
+ $ERRSTR = _error_as_msg();
return;
+ }
+ return map {
+ bless { IMG=>$_, DEBUG=>$DEBUG, ERRSTR=>undef }, 'Imager'
+ } @imgs;
}
# Destroy an Imager object
# Draws a box between the specified corner points.
sub box {
my $self=shift;
- unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
- my $dflcl=i_color_new(255,255,255,255);
- my %opts=(color=>$dflcl,xmin=>0,ymin=>0,xmax=>$self->getwidth()-1,ymax=>$self->getheight()-1,@_);
+ my $raw = $self->{IMG};
+
+ unless ($raw) {
+ $self->{ERRSTR}='empty input image';
+ return undef;
+ }
+
+ my %opts = @_;
+ my ($xmin, $ymin, $xmax, $ymax);
if (exists $opts{'box'}) {
- $opts{'xmin'} = _min($opts{'box'}->[0],$opts{'box'}->[2]);
- $opts{'xmax'} = _max($opts{'box'}->[0],$opts{'box'}->[2]);
- $opts{'ymin'} = _min($opts{'box'}->[1],$opts{'box'}->[3]);
- $opts{'ymax'} = _max($opts{'box'}->[1],$opts{'box'}->[3]);
+ $xmin = _min($opts{'box'}->[0],$opts{'box'}->[2]);
+ $xmax = _max($opts{'box'}->[0],$opts{'box'}->[2]);
+ $ymin = _min($opts{'box'}->[1],$opts{'box'}->[3]);
+ $ymax = _max($opts{'box'}->[1],$opts{'box'}->[3]);
+ }
+ else {
+ defined($xmin = $opts{xmin}) or $xmin = 0;
+ defined($xmax = $opts{xmax}) or $xmax = $self->getwidth()-1;
+ defined($ymin = $opts{ymin}) or $ymin = 0;
+ defined($ymax = $opts{ymax}) or $ymax = $self->getheight()-1;
}
if ($opts{filled}) {
- my $color = _color($opts{'color'});
- unless ($color) {
- $self->{ERRSTR} = $Imager::ERRSTR;
- return;
+ my $color = $opts{'color'};
+
+ if (defined $color) {
+ unless (_is_color_object($color)) {
+ $color = _color($color);
+ unless ($color) {
+ $self->{ERRSTR} = $Imager::ERRSTR;
+ return;
+ }
+ }
+ }
+ else {
+ $color = i_color_new(255,255,255,255);
}
- i_box_filled($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},
- $opts{ymax}, $color);
+
+ i_box_filled($raw, $xmin, $ymin,$xmax, $ymax, $color);
}
elsif ($opts{fill}) {
unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
return undef;
}
}
- i_box_cfill($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},
- $opts{ymax},$opts{fill}{fill});
+ i_box_cfill($raw, $xmin, $ymin, $xmax, $ymax, $opts{fill}{fill});
}
else {
- my $color = _color($opts{'color'});
+ my $color = $opts{'color'};
+ if (defined $color) {
+ unless (_is_color_object($color)) {
+ $color = _color($color);
+ unless ($color) {
+ $self->{ERRSTR} = $Imager::ERRSTR;
+ return;
+ }
+ }
+ }
+ else {
+ $color = i_color_new(255, 255, 255, 255);
+ }
unless ($color) {
$self->{ERRSTR} = $Imager::ERRSTR;
return;
}
- i_box($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},$opts{ymax},
- $color);
+ i_box($raw, $xmin, $ymin, $xmax, $ymax, $color);
}
+
return $self;
}
}
sub setpixel {
- my $self = shift;
+ my ($self, %opts) = @_;
- my %opts = ( color=>$self->{fg} || NC(255, 255, 255), @_);
+ my $color = $opts{color};
+ unless (defined $color) {
+ $color = $self->{fg};
+ defined $color or $color = NC(255, 255, 255);
+ }
+
+ unless (ref $color && UNIVERSAL::isa($color, "Imager::Color")) {
+ $color = _color($color)
+ or return undef;
+ }
unless (exists $opts{'x'} && exists $opts{'y'}) {
$self->{ERRSTR} = 'missing x and y parameters';
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';
sub getwidth {
my $self = shift;
- if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
- return (i_img_info($self->{IMG}))[0];
+
+ if (my $raw = $self->{IMG}) {
+ return i_img_get_width($raw);
+ }
+ else {
+ $self->{ERRSTR} = 'image is empty'; return undef;
+ }
}
# Get the height of an image
sub getheight {
my $self = shift;
- if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
- return (i_img_info($self->{IMG}))[1];
+
+ if (my $raw = $self->{IMG}) {
+ return i_img_get_height($raw);
+ }
+ else {
+ $self->{ERRSTR} = 'image is empty'; return undef;
+ }
}
# Get number of channels in an image
}
my %input=('x'=>0, 'y'=>0, @_);
- $input{string}||=$input{text};
+ defined $input{string}
+ or $input{string} = $input{text};
unless(exists $input{string}) {
$self->_set_error("missing required parameter 'string'");
# threads shouldn't try to close raw Imager objects
sub Imager::ImgRaw::CLONE_SKIP { 1 }
+# backward compatibility for %formats
+package Imager::FORMATS;
+use strict;
+use constant IX_FORMATS => 0;
+use constant IX_LIST => 1;
+use constant IX_INDEX => 2;
+use constant IX_CLASSES => 3;
+
+sub TIEHASH {
+ my ($class, $formats, $classes) = @_;
+
+ return bless [ $formats, [ ], 0, $classes ], $class;
+}
+
+sub _check {
+ my ($self, $key) = @_;
+
+ (my $file = $self->[IX_CLASSES]{$key} . ".pm") =~ s(::)(/)g;
+ my $value;
+ if (eval { require $file; 1 }) {
+ $value = 1;
+ }
+ else {
+ $value = undef;
+ }
+ $self->[IX_FORMATS]{$key} = $value;
+
+ return $value;
+}
+
+sub FETCH {
+ my ($self, $key) = @_;
+
+ exists $self->[IX_FORMATS]{$key} and return $self->[IX_FORMATS]{$key};
+
+ $self->[IX_CLASSES]{$key} or return undef;
+
+ return $self->_check($key);
+}
+
+sub STORE {
+ die "%Imager::formats is not user monifiable";
+}
+
+sub DELETE {
+ die "%Imager::formats is not user monifiable";
+}
+
+sub CLEAR {
+ die "%Imager::formats is not user monifiable";
+}
+
+sub EXISTS {
+ my ($self, $key) = @_;
+
+ if (exists $self->[IX_FORMATS]{$key}) {
+ my $value = $self->[IX_FORMATS]{$key}
+ or return;
+ return 1;
+ }
+
+ $self->_check($key) or return 1==0;
+
+ return 1==1;
+}
+
+sub FIRSTKEY {
+ my ($self) = @_;
+
+ unless (@{$self->[IX_LIST]}) {
+ # full populate it
+ @{$self->[IX_LIST]} = grep $self->[IX_FORMATS]{$_},
+ keys %{$self->[IX_FORMATS]};
+
+ for my $key (keys %{$self->[IX_CLASSES]}) {
+ $self->[IX_FORMATS]{$key} and next;
+ $self->_check($key)
+ and push @{$self->[IX_LIST]}, $key;
+ }
+ }
+
+ @{$self->[IX_LIST]} or return;
+ $self->[IX_INDEX] = 1;
+ return $self->[IX_LIST][0];
+}
+
+sub NEXTKEY {
+ my ($self) = @_;
+
+ $self->[IX_INDEX] < @{$self->[IX_LIST]}
+ or return;
+
+ return $self->[IX_LIST][$self->[IX_INDEX]++];
+}
+
+sub SCALAR {
+ my ($self) = @_;
+
+ return scalar @{$self->[IX_LIST]};
+}
+
1;
__END__
# Below is the stub of documentation for your module. You better edit it!
ICO files - L<Imager::Files/"ICO (Microsoft Windows Icon) and CUR (Microsoft Windows Cursor)">
-invert image - L<Imager::Filters/hardinvert>
+invert image - L<Imager::Filters/hardinvert>,
+L<Imager::Filters/hardinvertall>
JPEG - L<Imager::Files/"JPEG">
projects / imager.git / blobdiff