]> git.imager.perl.org - imager.git/blobdiff - Imager.pm
Counter correction.
[imager.git] / Imager.pm
index 9469fa81f2fbf01ccdfe00d5e410da1338820140..90507be1815f2401244067011ad35c38ffb44fca 100644 (file)
--- a/Imager.pm
+++ b/Imager.pm
@@ -245,12 +245,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) ],
@@ -324,6 +349,16 @@ BEGIN {
                   $hsh{ssample_param}, $hsh{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;
 }
@@ -527,6 +562,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});
   }
@@ -648,7 +686,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 {
@@ -809,7 +851,7 @@ sub read {
     $self->{ERRSTR}='format not supported'; return undef;
   }
 
-  my %iolready=(jpeg=>1, png=>1, tiff=>1, pnm=>1, raw=>1, bmp=>1);
+  my %iolready=(jpeg=>1, png=>1, tiff=>1, pnm=>1, raw=>1, bmp=>1, tga=>1);
 
   if ($iolready{$input{type}}) {
     # Setup data source
@@ -860,6 +902,16 @@ sub read {
       $self->{DEBUG} && print "loading a bmp 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();
+#      $self->{ERRSTR}='unable to read tga image';
+       return undef;
+      }
+      $self->{DEBUG} && print "loading a tga file\n";
+    }
+
     if ( $input{type} eq 'raw' ) {
       my %params=(datachannels=>3,storechannels=>3,interleave=>1,%input);
 
@@ -949,11 +1001,17 @@ sub read {
 # 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 %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
+  my %iolready=( tiff=>1, raw=>1, png=>1, pnm=>1, bmp=>1, jpeg=>1, tga=>1 ); # this will be SO MUCH BETTER once they are all in there
 
   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
 
@@ -1011,7 +1069,7 @@ sub write {
       $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'; 
+        $self->{ERRSTR} = $self->_error_as_msg();
        return undef;
       }
       $self->{DEBUG} && print "writing a jpeg file\n";
@@ -1021,6 +1079,13 @@ sub write {
        return undef;
       }
       $self->{DEBUG} && print "writing a bmp file\n";
+    } elsif ( $input{type} eq 'tga' ) {
+
+      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";
     }
 
     if (exists $input{'data'}) {
@@ -1437,65 +1502,57 @@ 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;
-    }
-
-    return $img;
+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 $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 = Imager->_error_as_msg();
+    return;
+  }
+  
+  return $img;
 }
 
 sub rubthrough {
@@ -1625,7 +1682,10 @@ sub box {
     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});
@@ -1657,8 +1717,16 @@ sub arc {
                 $opts{'d2'}, $opts{fill}{fill});
   }
   else {
-    i_arc($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},$opts{'d1'},
-          $opts{'d2'},$opts{'color'}); 
+    if ($opts{d1} == 0 && $opts{d2} == 361 && $opts{aa}) {
+      i_circle_aa($self->{IMG}, $opts{'x'}, $opts{'y'}, $opts{'r'}, 
+                  $opts{'color'});
+    }
+    else {
+      #      i_arc($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},$opts{'d1'}, $opts{'d2'},$opts{'color'});
+      if ($opts{'d1'} <= $opts{'d2'}) { i_arc($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},$opts{'d1'},$opts{'d2'},$opts{'color'}); }
+      else                            { i_arc($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},$opts{'d1'},        361,$opts{'color'});
+                                       i_arc($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},          0,$opts{'d2'},$opts{'color'}); }
+    }
   }
 
   return $self;
@@ -2017,6 +2085,7 @@ sub def_guess_type {
   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 'gif'  if ($ext eq "gif");
   return ();
 }
@@ -2175,15 +2244,22 @@ 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:
+16 bit 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.
+or for even more precision:
+
+  $img = Imager->new(xsize=>200, ysize=>200, channels=>3, bits=>'double');
+
+to get an image that uses a double for each channel.
 
-Currently only 8 and 16/bit per channel image types are available,
-this may change later.
+Note that as of this writing all functions should work on images with
+more than 8-bits/channel, but many will only work at only
+8-bit/channel precision.
+
+Currently only 8-bit, 16-bit, and double per channel image types are
+available, this may change later.
 
 Color objects are created by calling the Imager::Color->new()
 method:
@@ -2248,7 +2324,12 @@ the file descriptor for the file:
 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.
+output.  For example a common idiom when writing a CGI script is:
+
+  # the $| _must_ come before you send the content-type
+  $| = 1;
+  print "Content-Type: image/jpeg\n\n";
+  $img->write(fd=>fileno(STDOUT), type=>'jpeg') or die $img->errstr;
 
 *Note that load() is now an alias for read but will be removed later*
 
@@ -2465,6 +2546,11 @@ which makes the animation of the images repeat.
 
 This is currently unimplemented due to some limitations in giflib.
 
+=item gif_eliminate_unused
+
+If this is true, when you write a paletted image any unused colors
+will be eliminated from its palette.  This is set by default.
+
 =back
 
 =head2 Quantization options
@@ -2725,7 +2811,8 @@ the function return undef.  Examples:
   }
 
 The bits() method retrieves the number of bits used to represent each
-channel in a pixel, typically 8.  The type() method returns either
+channel in a pixel, 8 for a normal image, 16 for 16-bit image and
+'double' for a double/channel image.  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.
@@ -2921,7 +3008,8 @@ parameter which can take the values C<h>, C<v>, C<vh> and C<hv>.
 
 =head2 Rotating images
 
-Use the rotate() method to rotate an image.
+Use the rotate() method to rotate an image.  This method will return a
+new, rotated image.
 
 To rotate by an exact amount in degrees or radians, use the 'degrees'
 or 'radians' parameter:
@@ -2929,6 +3017,9 @@ or 'radians' parameter:
   my $rot20 = $img->rotate(degrees=>20);
   my $rotpi4 = $img->rotate(radians=>3.14159265/4);
 
+Exact image rotation uses the same underlying transformation engine as
+the matrix_transform() method.
+
 To rotate in steps of 90 degrees, use the 'right' parameter:
 
   my $rotated = $img->rotate(right=>270);
@@ -2947,11 +3038,11 @@ That will take paste C<$srcimage> into C<$img> with the upper
 left corner at (30,50).  If no values are given for C<left>
 or C<top> they will default to 0.
 
-A more complicated way of blending images is where one image is 
+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.
 
-  $img->rubthrough(src=>$srcimage,tx=>30,ty=>50); 
+  $img->rubthrough(src=>$srcimage,tx=>30,ty=>50);
 
 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
@@ -2973,6 +3064,9 @@ source.
   Filter          Arguments
   autolevels      lsat(0.1) usat(0.1) skew(0)
   bumpmap         bump elevation(0) lightx lighty st(2)
+  bumpmap_complex bump channel(0) tx(0) ty(0) Lx(0.2) Ly(0.4)
+                  Lz(-1) cd(1.0) cs(40.0) n(1.3) Ia(0 0 0) Il(255 255 255)
+                  Is(255 255 255)
   contrast        intensity
   conv            coef
   fountain        xa ya xb yb ftype(linear) repeat(none) combine(none)
@@ -2985,6 +3079,7 @@ source.
   postlevels      levels(10)
   radnoise        xo(100) yo(100) ascale(17.0) rscale(0.02)
   turbnoise       xo(0.0) yo(0.0) scale(10.0)
+  unsharpmask     stddev(2.0) scale(1.0)
   watermark       wmark pixdiff(10) tx(0) ty(0)
 
 The default values are in parenthesis.  All parameters must have some
@@ -3008,6 +3103,16 @@ uses the channel I<elevation> image I<bump> as a bumpmap on your
 image, with the light at (I<lightx>, I<lightty>), with a shadow length
 of I<st>.
 
+=item bumpmap_complex
+
+uses the channel I<channel> image I<bump> as a bumpmap on your image.
+If Lz<0 the three L parameters are considered to be the direction of
+the light.  If Lz>0 the L parameters are considered to be the light
+position.  I<Ia> is the ambient colour, I<Il> is the light colour,
+I<Is> is the color of specular highlights.  I<cd> is the diffuse
+coefficient and I<cs> is the specular coefficient.  I<n> is the
+shininess of the surface.
+
 =item contrast
 
 scales each channel by I<intensity>.  Values of I<intensity> < 1.0
@@ -3223,6 +3328,13 @@ renders Perlin turbulent noise.  (I<xo>, I<yo>) controls the origin of
 the noise, and I<scale> the scale of the noise, with lower numbers
 giving more detail.
 
+=item unsharpmask
+
+performs an unsharp mask on the image.  This is the result of
+subtracting a gaussian blurred version of the image from the original.
+I<stddev> controls the stddev parameter of the gaussian blur.  Each
+output pixel is: in + I<scale> * (in - blurred).
+
 =item watermark
 
 applies I<wmark> as a watermark on the image with strength I<pixdiff>,
@@ -3806,7 +3918,7 @@ the i_aspect_only tag is non-zero.
 
 =back
 
-The following tags are set when reading a Windows BMP file is read:
+The following tags are set when a Windows BMP file is read:
 
 =over