]> git.imager.perl.org - imager.git/blobdiff - Imager.pm
F<> the filename to prevent a spell check error
[imager.git] / Imager.pm
index 88297eca07387dea3a2dae9c612a8cf77ee2fbb8..bde1f2a31ec754efabd1d1a0961d414f5462663b 100644 (file)
--- a/Imager.pm
+++ b/Imager.pm
@@ -1,7 +1,7 @@
 package Imager;
 
 use strict;
-use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS %formats $DEBUG %filters %DSOs $ERRSTR $fontstate %OPCODES $I2P $FORMATGUESS $warn_obsolete);
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS %formats $DEBUG %filters %DSOs $ERRSTR %OPCODES $I2P $FORMATGUESS $warn_obsolete);
 use IO::File;
 
 use Imager::Color;
@@ -155,7 +155,7 @@ my %defaults;
 BEGIN {
   require Exporter;
   @ISA = qw(Exporter);
-  $VERSION = '0.77';
+  $VERSION = '0.78';
   eval {
     require XSLoader;
     XSLoader::load(Imager => $VERSION);
@@ -174,18 +174,15 @@ my %format_classes =
    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;
@@ -2651,25 +2648,46 @@ sub i_color_set {
 # Draws a box between the specified corner points.
 sub box {
   my $self=shift;
-  unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
-  my $dflcl=i_color_new(255,255,255,255);
-  my %opts=(color=>$dflcl,xmin=>0,ymin=>0,xmax=>$self->getwidth()-1,ymax=>$self->getheight()-1,@_);
+  my $raw = $self->{IMG};
+
+  unless ($raw) {
+    $self->{ERRSTR}='empty input image';
+    return undef;
+  }
 
+  my %opts = @_;
+
+  my ($xmin, $ymin, $xmax, $ymax);
   if (exists $opts{'box'}) { 
-    $opts{'xmin'} = _min($opts{'box'}->[0],$opts{'box'}->[2]);
-    $opts{'xmax'} = _max($opts{'box'}->[0],$opts{'box'}->[2]);
-    $opts{'ymin'} = _min($opts{'box'}->[1],$opts{'box'}->[3]);
-    $opts{'ymax'} = _max($opts{'box'}->[1],$opts{'box'}->[3]);
+    $xmin = _min($opts{'box'}->[0],$opts{'box'}->[2]);
+    $xmax = _max($opts{'box'}->[0],$opts{'box'}->[2]);
+    $ymin = _min($opts{'box'}->[1],$opts{'box'}->[3]);
+    $ymax = _max($opts{'box'}->[1],$opts{'box'}->[3]);
+  }
+  else {
+    defined($xmin = $opts{xmin}) or $xmin = 0;
+    defined($xmax = $opts{xmax}) or $xmax = $self->getwidth()-1;
+    defined($ymin = $opts{ymin}) or $ymin = 0;
+    defined($ymax = $opts{ymax}) or $ymax = $self->getheight()-1;
   }
 
   if ($opts{filled}) { 
-    my $color = _color($opts{'color'});
-    unless ($color) { 
-      $self->{ERRSTR} = $Imager::ERRSTR; 
-      return; 
+    my $color = $opts{'color'};
+
+    if (defined $color) {
+      unless (_is_color_object($color)) {
+       $color = _color($color);
+       unless ($color) { 
+         $self->{ERRSTR} = $Imager::ERRSTR; 
+         return;
+       }
+      }
     }
-    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')) {
@@ -2680,18 +2698,29 @@ sub box {
         return undef;
       }
     }
-    i_box_cfill($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},
-                $opts{ymax},$opts{fill}{fill});
+    i_box_cfill($raw, $xmin, $ymin, $xmax, $ymax, $opts{fill}{fill});
   }
   else {
-    my $color = _color($opts{'color'});
+    my $color = $opts{'color'};
+    if (defined $color) {
+      unless (_is_color_object($color)) {
+       $color = _color($color);
+       unless ($color) { 
+         $self->{ERRSTR} = $Imager::ERRSTR;
+         return;
+       }
+      }
+    }
+    else {
+      $color = i_color_new(255, 255, 255, 255);
+    }
     unless ($color) { 
       $self->{ERRSTR} = $Imager::ERRSTR;
       return;
     }
-    i_box($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},$opts{ymax},
-          $color);
+    i_box($raw, $xmin, $ymin, $xmax, $ymax, $color);
   }
+
   return $self;
 }
 
@@ -3437,6 +3466,46 @@ sub convert {
   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
 
@@ -3495,16 +3564,26 @@ sub border {
 
 sub getwidth {
   my $self = shift;
-  if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
-  return (i_img_info($self->{IMG}))[0];
+
+  if (my $raw = $self->{IMG}) {
+    return i_img_get_width($raw);
+  }
+  else {
+    $self->{ERRSTR} = 'image is empty'; return undef;
+  }
 }
 
 # Get the height of an image
 
 sub getheight {
   my $self = shift;
-  if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
-  return (i_img_info($self->{IMG}))[1];
+
+  if (my $raw = $self->{IMG}) {
+    return i_img_get_height($raw);
+  }
+  else {
+    $self->{ERRSTR} = 'image is empty'; return undef;
+  }
 }
 
 # Get number of channels in an image
@@ -3699,7 +3778,10 @@ sub get_file_limits {
 
 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;
@@ -4153,6 +4235,9 @@ circle() - L<Imager::Draw/circle> - draw a filled circle
 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
 
@@ -4357,6 +4442,8 @@ boxes, drawing - L<Imager::Draw/box>
 
 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>
@@ -4594,6 +4681,17 @@ Arnar M. Hrafnkelsson is the original author of Imager.
 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),