Counter correction.

[imager.git] / Imager.pm

diff --git a/Imager.pm b/Imager.pm
index ccdb4679be07a131e6ae543187fb7fa625dd7cec..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 },
     {
      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});
      },
     };
        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) ],
   $filters{postlevels} =
     {
      callseq  => [ qw(image levels) ],


@@ -324,6 +349,16 @@ BEGIN {
                   $hsh{ssample_param}, $hsh{segments});
      },
     };
                   $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;
 }
 
   $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);
   }
     $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});
   }
   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;
 
 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 {
 }
 
 sub type {


@@ -959,7 +1001,13 @@ sub read {
 # Write an image to file
 sub write {
   my $self = shift;
 # 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);
 
             fax_fine=>1, @_);
   my ($fh, $rc, $fd, $IO);
 


@@ -1032,9 +1080,9 @@ sub write {
       }
       $self->{DEBUG} && print "writing a bmp file\n";
     } elsif ( $input{type} eq 'tga' ) {
       }
       $self->{DEBUG} && print "writing a bmp file\n";
     } elsif ( $input{type} eq 'tga' ) {

-      if ( !i_writetga_wiol($self->{IMG}, $IO) ) {
+
+      if ( !i_writetga_wiol($self->{IMG}, $IO, $input{wierdpack}, $input{compress}, $input{idstring}) ) {

        $self->{ERRSTR}=$self->_error_as_msg();
        $self->{ERRSTR}=$self->_error_as_msg();

-#      $self->{ERRSTR}='unable to write tga image';

        return undef;
       }
       $self->{DEBUG} && print "writing a tga file\n";
        return undef;
       }
       $self->{DEBUG} && print "writing a tga file\n";


@@ -1454,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 {
 }
 
 sub rubthrough {


@@ -1682,8 +1722,10 @@ sub arc {
                   $opts{'color'});
     }
     else {
                   $opts{'color'});
     }
     else {

-      i_arc($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},$opts{'d1'},
-            $opts{'d2'},$opts{'color'}); 
+      #      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'}); }

     }
   }
 
     }
   }
 


@@ -2202,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
 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);
 
 
   $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');

 
 

-Currently only 8 and 16/bit per channel image types are available,
-this may change later.
+to get an image that uses a double for each channel.
+
+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:
 
 Color objects are created by calling the Imager::Color->new()
 method:


@@ -2762,7 +2811,8 @@ the function return undef.  Examples:
   }
 
 The bits() method retrieves the number of bits used to represent each
   }
 
 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.
 '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.


@@ -2958,7 +3008,8 @@ parameter which can take the values C<h>, C<v>, C<vh> and C<hv>.
 
 =head2 Rotating images
 
 
 =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:
 
 To rotate by an exact amount in degrees or radians, use the 'degrees'
 or 'radians' parameter:


@@ -2966,6 +3017,9 @@ or 'radians' parameter:
   my $rot20 = $img->rotate(degrees=>20);
   my $rotpi4 = $img->rotate(radians=>3.14159265/4);
 
   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);
 To rotate in steps of 90 degrees, use the 'right' parameter:
 
   my $rotated = $img->rotate(right=>270);


@@ -2984,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.
 
 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.
 
 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
 
 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


@@ -3010,6 +3064,9 @@ source.
   Filter          Arguments
   autolevels      lsat(0.1) usat(0.1) skew(0)
   bumpmap         bump elevation(0) lightx lighty st(2)
   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)
   contrast        intensity
   conv            coef
   fountain        xa ya xb yb ftype(linear) repeat(none) combine(none)


@@ -3022,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)
   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
   watermark       wmark pixdiff(10) tx(0) ty(0)
 
 The default values are in parenthesis.  All parameters must have some


@@ -3045,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>.
 
 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
 =item contrast
 
 scales each channel by I<intensity>.  Values of I<intensity> < 1.0


@@ -3260,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.
 
 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>,
 =item watermark
 
 applies I<wmark> as a watermark on the image with strength I<pixdiff>,