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;
BEGIN {
require Exporter;
@ISA = qw(Exporter);
- $VERSION = '0.77';
+ $VERSION = '0.78';
eval {
require XSLoader;
XSLoader::load(Imager => $VERSION);
gif => "Imager::File::GIF",
tiff => "Imager::File::TIFF",
jpeg => "Imager::File::JPEG",
+ w32 => "Imager::Font::W32",
+ ft2 => "Imager::Font::FT2",
);
tie %formats, "Imager::FORMATS", \%formats_low, \%format_classes;
BEGIN {
- Imager::Font::__init();
for(i_list_formats()) { $formats_low{$_}++; }
- if (!$formats_low{'t1'} and !$formats_low{'tt'}
- && !$formats_low{'ft2'} && !$formats_low{'w32'}) {
- $fontstate='no font support';
- }
%OPCODES=(Add=>[0],Sub=>[1],Mult=>[2],Div=>[3],Parm=>[4],'sin'=>[5],'cos'=>[6],'x'=>[4,0],'y'=>[4,1]);
$DEBUG=0;
# 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;
+ }
+ }
}
- i_box_filled($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},
- $opts{ymax}, $color);
+ else {
+ $color = i_color_new(255,255,255,255);
+ }
+
+ 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;
}
return $new;
}
+# combine channels from multiple input images, a class method
+sub combine {
+ my ($class, %opts) = @_;
+
+ my $src = delete $opts{src};
+ unless ($src) {
+ $class->_set_error("src parameter missing");
+ return;
+ }
+ my @imgs;
+ my $index = 0;
+ for my $img (@$src) {
+ unless (eval { $img->isa("Imager") }) {
+ $class->_set_error("src must contain image objects");
+ return;
+ }
+ unless ($img->{IMG}) {
+ $class->_set_error("empty input image");
+ return;
+ }
+ push @imgs, $img->{IMG};
+ }
+ my $result;
+ if (my $channels = delete $opts{channels}) {
+ $result = i_combine(\@imgs, $channels);
+ }
+ else {
+ $result = i_combine(\@imgs);
+ }
+ unless ($result) {
+ $class->_set_error($class->_error_as_msg);
+ return;
+ }
+
+ my $img = $class->new;
+ $img->{IMG} = $result;
+
+ return $img;
+}
+
# general function to map an image through lookup tables
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
sub newcolor { Imager::Color->new(@_); }
sub newfont { Imager::Font->new(@_); }
-sub NCF { Imager::Color::Float->new(@_) }
+sub NCF {
+ require Imager::Color::Float;
+ return Imager::Color::Float->new(@_);
+}
*NC=*newcolour=*newcolor;
*NF=*newfont;
colorcount() - L<Imager::Draw/colorcount> - the number of colors in an
image's palette (paletted images only)
+combine() - L<Imager::Transformations/combine> - combine channels from one or
+more images.
+
combines() - L<Imager::Draw/combines> - return a list of the different
combine type keywords
changes between image - L<Imager::Filters/"Image Difference">
+channels, combine into one image - L<Imager::Transformations/combine>
+
color - L<Imager::Color>
color names - L<Imager::Color>, L<Imager::Color::Table>
Many others have contributed to Imager, please see the C<README> for a
complete list.
+=head1 LICENSE
+
+Imager is licensed under the same terms as perl itself.
+
+=for stopwords
+makeblendedfont Fontforge
+
+A test font, FT2/fontfiles/MMOne.pfb, contains a Postscript operator
+definition copyrighted by Adobe. See F<adobe.txt> in the source for
+license information.
+
=head1 SEE ALSO
L<perl>(1), L<Imager::ImageTypes>(3), L<Imager::Files>(3),