Imager.pm

   1 package Imager;
   2
   3
   4
   5 use strict;
   6 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS %formats $DEBUG %filters %DSOs $ERRSTR $fontstate %OPCODES $I2P $FORMATGUESS);
   7 use IO::File;
   8
   9 use Imager::Color;
  10 use Imager::Font;
  11
  12 @EXPORT_OK = qw(
  13                 init
  14                 init_log
  15                 DSO_open
  16                 DSO_close
  17                 DSO_funclist
  18                 DSO_call
  19
  20                 load_plugin
  21                 unload_plugin
  22
  23                 i_list_formats
  24                 i_has_format
  25
  26                 i_color_new
  27                 i_color_set
  28                 i_color_info
  29
  30                 i_img_empty
  31                 i_img_empty_ch
  32                 i_img_exorcise
  33                 i_img_destroy
  34
  35                 i_img_info
  36
  37                 i_img_setmask
  38                 i_img_getmask
  39
  40                 i_draw
  41                 i_line_aa
  42                 i_box
  43                 i_box_filled
  44                 i_arc
  45
  46                 i_bezier_multi
  47                 i_poly_aa
  48
  49                 i_copyto
  50                 i_rubthru
  51                 i_scaleaxis
  52                 i_scale_nn
  53                 i_haar
  54                 i_count_colors
  55
  56
  57                 i_gaussian
  58                 i_conv
  59
  60                 i_img_diff
  61
  62                 i_init_fonts
  63                 i_t1_new
  64                 i_t1_destroy
  65                 i_t1_set_aa
  66                 i_t1_cp
  67                 i_t1_text
  68                 i_t1_bbox
  69
  70
  71                 i_tt_set_aa
  72                 i_tt_cp
  73                 i_tt_text
  74                 i_tt_bbox
  75
  76                 i_readjpeg
  77                 i_writejpeg
  78
  79                 i_readjpeg_wiol
  80                 i_writejpeg_wiol
  81
  82                 i_readtiff_wiol
  83                 i_writetiff_wiol
  84
  85                 i_readpng
  86                 i_writepng
  87
  88                 i_readgif
  89                 i_readgif_callback
  90                 i_writegif
  91                 i_writegifmc
  92                 i_writegif_gen
  93                 i_writegif_callback
  94
  95                 i_readpnm_wiol
  96                 i_writeppm
  97
  98                 i_readraw
  99                 i_writeraw
 100
 101                 i_contrast
 102                 i_hardinvert
 103                 i_noise
 104                 i_bumpmap
 105                 i_postlevels
 106                 i_mosaic
 107                 i_watermark
 108
 109                 malloc_state
 110
 111                 list_formats
 112
 113                 i_gifquant
 114
 115                 newfont
 116                 newcolor
 117                 newcolour
 118                 NC
 119                 NF
 120
 121 );
 122
 123
 124
 125 @EXPORT=qw(
 126            init_log
 127            i_list_formats
 128            i_has_format
 129            malloc_state
 130            i_color_new
 131
 132            i_img_empty
 133            i_img_empty_ch
 134           );
 135
 136 %EXPORT_TAGS=
 137   (handy => [qw(
 138                 newfont
 139                 newcolor
 140                 NF
 141                 NC
 142                )],
 143    all => [@EXPORT_OK],
 144    default => [qw(
 145                   load_plugin
 146                   unload_plugin
 147                  )]);
 148
 149
 150 BEGIN {
 151   require Exporter;
 152   require DynaLoader;
 153
 154   $VERSION = '0.38pre9';
 155   @ISA = qw(Exporter DynaLoader);
 156   bootstrap Imager $VERSION;
 157 }
 158
 159 BEGIN {
 160   i_init_fonts(); # Initialize font engines
 161   for(i_list_formats()) { $formats{$_}++; }
 162
 163   if ($formats{'t1'}) {
 164     i_t1_set_aa(1);
 165   }
 166
 167   if (!$formats{'t1'} and !$formats{'tt'}) {
 168     $fontstate='no font support';
 169   }
 170
 171   %OPCODES=(Add=>[0],Sub=>[1],Mult=>[2],Div=>[3],Parm=>[4],'sin'=>[5],'cos'=>[6],'x'=>[4,0],'y'=>[4,1]);
 172
 173   $DEBUG=0;
 174
 175   $filters{contrast}={
 176                       callseq => ['image','intensity'],
 177                       callsub => sub { my %hsh=@_; i_contrast($hsh{image},$hsh{intensity}); }
 178                      };
 179
 180   $filters{noise} ={
 181                     callseq => ['image', 'amount', 'subtype'],
 182                     defaults => { amount=>3,subtype=>0 },
 183                     callsub => sub { my %hsh=@_; i_noise($hsh{image},$hsh{amount},$hsh{subtype}); }
 184                    };
 185
 186   $filters{hardinvert} ={
 187                          callseq => ['image'],
 188                          defaults => { },
 189                          callsub => sub { my %hsh=@_; i_hardinvert($hsh{image}); }
 190                         };
 191
 192   $filters{autolevels} ={
 193                          callseq => ['image','lsat','usat','skew'],
 194                          defaults => { lsat=>0.1,usat=>0.1,skew=>0.0 },
 195                          callsub => sub { my %hsh=@_; i_autolevels($hsh{image},$hsh{lsat},$hsh{usat},$hsh{skew}); }
 196                         };
 197
 198   $filters{turbnoise} ={
 199                         callseq => ['image'],
 200                         defaults => { xo=>0.0,yo=>0.0,scale=>10.0 },
 201                         callsub => sub { my %hsh=@_; i_turbnoise($hsh{image},$hsh{xo},$hsh{yo},$hsh{scale}); }
 202                        };
 203
 204   $filters{radnoise} ={
 205                        callseq => ['image'],
 206                        defaults => { xo=>100,yo=>100,ascale=>17.0,rscale=>0.02 },
 207                        callsub => sub { my %hsh=@_; i_radnoise($hsh{image},$hsh{xo},$hsh{yo},$hsh{rscale},$hsh{ascale}); }
 208                       };
 209
 210   $filters{conv} ={
 211                        callseq => ['image', 'coef'],
 212                        defaults => { },
 213                        callsub => sub { my %hsh=@_; i_conv($hsh{image},$hsh{coef}); }
 214                       };
 215
 216   $filters{gradgen} ={
 217                        callseq => ['image', 'xo', 'yo', 'colors', 'dist'],
 218                        defaults => { },
 219                        callsub => sub { my %hsh=@_; i_gradgen($hsh{image}, $hsh{xo}, $hsh{yo}, $hsh{colors}, $hsh{dist}); }
 220                       };
 221
 222   $filters{nearest_color} ={
 223                             callseq => ['image', 'xo', 'yo', 'colors', 'dist'],
 224                             defaults => { },
 225                             callsub => sub { my %hsh=@_; i_nearest_color($hsh{image}, $hsh{xo}, $hsh{yo}, $hsh{colors}, $hsh{dist}); }
 226                            };
 227
 228   $FORMATGUESS=\&def_guess_type;
 229 }
 230
 231 #
 232 # Non methods
 233 #
 234
 235 # initlize Imager
 236 # NOTE: this might be moved to an import override later on
 237
 238 #sub import {
 239 #  my $pack = shift;
 240 #  (look through @_ for special tags, process, and remove them);
 241 #  use Data::Dumper;
 242 #  print Dumper($pack);
 243 #  print Dumper(@_);
 244 #}
 245
 246 sub init {
 247   my %parms=(loglevel=>1,@_);
 248   if ($parms{'log'}) {
 249     init_log($parms{'log'},$parms{'loglevel'});
 250   }
 251
 252 #    if ($parms{T1LIB_CONFIG}) { $ENV{T1LIB_CONFIG}=$parms{T1LIB_CONFIG}; }
 253 #    if ( $ENV{T1LIB_CONFIG} and ( $fontstate eq 'missing conf' )) {
 254 #       i_init_fonts();
 255 #       $fontstate='ok';
 256 #    }
 257 }
 258
 259 END {
 260   if ($DEBUG) {
 261     print "shutdown code\n";
 262     #   for(keys %instances) { $instances{$_}->DESTROY(); }
 263     malloc_state(); # how do decide if this should be used? -- store something from the import
 264     print "Imager exiting\n";
 265   }
 266 }
 267
 268 # Load a filter plugin
 269
 270 sub load_plugin {
 271   my ($filename)=@_;
 272   my $i;
 273   my ($DSO_handle,$str)=DSO_open($filename);
 274   if (!defined($DSO_handle)) { $Imager::ERRSTR="Couldn't load plugin '$filename'\n"; return undef; }
 275   my %funcs=DSO_funclist($DSO_handle);
 276   if ($DEBUG) { print "loading module $filename\n"; $i=0; for(keys %funcs) { printf("  %2d: %s\n",$i++,$_); } }
 277   $i=0;
 278   for(keys %funcs) { if ($filters{$_}) { $ERRSTR="filter '$_' already exists\n"; DSO_close($DSO_handle); return undef; } }
 279
 280   $DSOs{$filename}=[$DSO_handle,\%funcs];
 281
 282   for(keys %funcs) {
 283     my $evstr="\$filters{'".$_."'}={".$funcs{$_}.'};';
 284     $DEBUG && print "eval string:\n",$evstr,"\n";
 285     eval $evstr;
 286     print $@ if $@;
 287   }
 288   return 1;
 289 }
 290
 291 # Unload a plugin
 292
 293 sub unload_plugin {
 294   my ($filename)=@_;
 295
 296   if (!$DSOs{$filename}) { $ERRSTR="plugin '$filename' not loaded."; return undef; }
 297   my ($DSO_handle,$funcref)=@{$DSOs{$filename}};
 298   for(keys %{$funcref}) {
 299     delete $filters{$_};
 300     $DEBUG && print "unloading: $_\n";
 301   }
 302   my $rc=DSO_close($DSO_handle);
 303   if (!defined($rc)) { $ERRSTR="unable to unload plugin '$filename'."; return undef; }
 304   return 1;
 305 }
 306
 307 # take the results of i_error() and make a message out of it
 308 sub _error_as_msg {
 309   return join(": ", map $_->[0], i_errors());
 310 }
 311
 312
 313 #
 314 # Methods to be called on objects.
 315 #
 316
 317 # Create a new Imager object takes very few parameters.
 318 # usually you call this method and then call open from
 319 # the resulting object
 320
 321 sub new {
 322   my $class = shift;
 323   my $self ={};
 324   my %hsh=@_;
 325   bless $self,$class;
 326   $self->{IMG}=undef;    # Just to indicate what exists
 327   $self->{ERRSTR}=undef; #
 328   $self->{DEBUG}=$DEBUG;
 329   $self->{DEBUG} && print "Initialized Imager\n";
 330   if ($hsh{xsize} && $hsh{ysize}) { $self->img_set(%hsh); }
 331   return $self;
 332 }
 333
 334
 335 # Copy an entire image with no changes
 336 # - if an image has magic the copy of it will not be magical
 337
 338 sub copy {
 339   my $self = shift;
 340   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
 341
 342   my $newcopy=Imager->new();
 343   $newcopy->{IMG}=i_img_new();
 344   i_copy($newcopy->{IMG},$self->{IMG});
 345   return $newcopy;
 346 }
 347
 348 # Paste a region
 349
 350 sub paste {
 351   my $self = shift;
 352   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
 353   my %input=(left=>0, top=>0, @_);
 354   unless($input{img}) {
 355     $self->{ERRSTR}="no source image";
 356     return;
 357   }
 358   $input{left}=0 if $input{left} <= 0;
 359   $input{top}=0 if $input{top} <= 0;
 360   my $src=$input{img};
 361   my($r,$b)=i_img_info($src->{IMG});
 362
 363   i_copyto($self->{IMG}, $src->{IMG},
 364            0,0, $r, $b, $input{left}, $input{top});
 365   return $self;  # What should go here??
 366 }
 367
 368 # Crop an image - i.e. return a new image that is smaller
 369
 370 sub crop {
 371   my $self=shift;
 372   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
 373   my %hsh=(left=>0,right=>0,top=>0,bottom=>0,@_);
 374
 375   my ($w,$h,$l,$r,$b,$t)=($self->getwidth(),$self->getheight(),
 376                                 @hsh{qw(left right bottom top)});
 377   $l=0 if not defined $l;
 378   $t=0 if not defined $t;
 379   $r=$self->getwidth if not defined $r;
 380   $b=$self->getheight if not defined $b;
 381
 382   ($l,$r)=($r,$l) if $l>$r;
 383   ($t,$b)=($b,$t) if $t>$b;
 384
 385   if ($hsh{'width'}) {
 386     $l=int(0.5+($w-$hsh{'width'})/2);
 387     $r=$l+$hsh{'width'};
 388   } else {
 389     $hsh{'width'}=$r-$l;
 390   }
 391   if ($hsh{'height'}) {
 392     $b=int(0.5+($h-$hsh{'height'})/2);
 393     $t=$h+$hsh{'height'};
 394   } else {
 395     $hsh{'height'}=$b-$t;
 396   }
 397
 398 #    print "l=$l, r=$r, h=$hsh{'width'}\n";
 399 #    print "t=$t, b=$b, w=$hsh{'height'}\n";
 400
 401   my $dst=Imager->new(xsize=>$hsh{'width'},ysize=>$hsh{'height'},channels=>$self->getchannels());
 402
 403   i_copyto($dst->{IMG},$self->{IMG},$l,$t,$r,$b,0,0);
 404   return $dst;
 405 }
 406
 407 # Sets an image to a certain size and channel number
 408 # if there was previously data in the image it is discarded
 409
 410 sub img_set {
 411   my $self=shift;
 412
 413   my %hsh=(xsize=>100,ysize=>100,channels=>3,@_);
 414
 415   if (defined($self->{IMG})) {
 416     i_img_destroy($self->{IMG});
 417     undef($self->{IMG});
 418   }
 419
 420   $self->{IMG}=Imager::ImgRaw::new($hsh{'xsize'},$hsh{'ysize'},$hsh{'channels'});
 421 }
 422
 423 # Read an image from file
 424
 425 sub read {
 426   my $self = shift;
 427   my %input=@_;
 428   my ($fh, $fd, $IO);
 429
 430   if (defined($self->{IMG})) {
 431     i_img_destroy($self->{IMG});
 432     undef($self->{IMG});
 433   }
 434
 435   if (!$input{fd} and !$input{file} and !$input{data}) { $self->{ERRSTR}='no file, fd or data parameter'; return undef; }
 436   if ($input{file}) {
 437     $fh = new IO::File($input{file},"r");
 438     if (!defined $fh) { $self->{ERRSTR}='Could not open file'; return undef; }
 439     binmode($fh);
 440     $fd = $fh->fileno();
 441   }
 442   if ($input{fd}) { $fd=$input{fd} };
 443
 444   # FIXME: Find the format here if not specified
 445   # yes the code isn't here yet - next week maybe?
 446
 447   if (!$input{type} and $input{file}) { $input{type}=$FORMATGUESS->($input{file}); }
 448   if (!$formats{$input{type}}) { $self->{ERRSTR}='format not supported'; return undef; }
 449
 450   my %iolready=(jpeg=>1, tiff=>1, pnm=>1);
 451
 452   if ($iolready{$input{type}}) {
 453     # Setup data source
 454     $IO = io_new_fd($fd); # sort of simple for now eh?
 455
 456     if ( $input{type} eq 'jpeg' ) {
 457       ($self->{IMG},$self->{IPTCRAW})=i_readjpeg_wiol( $IO );
 458       if ( !defined($self->{IMG}) ) { $self->{ERRSTR}='unable to read jpeg image'; return undef; }
 459       $self->{DEBUG} && print "loading a jpeg file\n";
 460       return $self;
 461     }
 462
 463     if ( $input{type} eq 'tiff' ) {
 464       $self->{IMG}=i_readtiff_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed
 465       if ( !defined($self->{IMG}) ) { $self->{ERRSTR}='unable to read tiff image'; return undef; }
 466       $self->{DEBUG} && print "loading a tiff file\n";
 467       return $self;
 468     }
 469
 470     if ( $input{type} eq 'pnm' ) {
 471       $self->{IMG}=i_readpnm_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed
 472       if ( !defined($self->{IMG}) ) { $self->{ERRSTR}='unable to read pnm image: '._error_as_msg(); return undef; }
 473       $self->{DEBUG} && print "loading a pnm file\n";
 474       return $self;
 475     }
 476
 477   } else {
 478
 479   # Old code for reference while changing the new stuff
 480
 481
 482   if (!$input{type} and $input{file}) { $input{type}=$FORMATGUESS->($input{file}); }
 483   if (!$input{type}) { $self->{ERRSTR}='type parameter missing and not possible to guess from extension'; return undef; }
 484
 485   if (!$formats{$input{type}}) { $self->{ERRSTR}='format not supported'; return undef; }
 486
 487   if ($input{file}) {
 488     $fh = new IO::File($input{file},"r");
 489     if (!defined $fh) { $self->{ERRSTR}='Could not open file'; return undef; }
 490     binmode($fh);
 491     $fd = $fh->fileno();
 492   }
 493   if ($input{fd}) { $fd=$input{fd} };
 494
 495   if ( $input{type} eq 'gif' ) {
 496     if (exists $input{data}) { $self->{IMG}=i_readgif_scalar($input{data}); }
 497     else { $self->{IMG}=i_readgif( $fd ) }
 498     if ( !defined($self->{IMG}) ) { $self->{ERRSTR}= 'reading GIF:'._error_as_msg(); return undef; }
 499     $self->{DEBUG} && print "loading a gif file\n";
 500   } elsif ( $input{type} eq 'jpeg' ) {
 501     if (exists $input{data}) { ($self->{IMG},$self->{IPTCRAW})=i_readjpeg_scalar($input{data}); }
 502     else { ($self->{IMG},$self->{IPTCRAW})=i_readjpeg( $fd ); }
 503     if ( !defined($self->{IMG}) ) { $self->{ERRSTR}='unable to read jpeg image'; return undef; }
 504     $self->{DEBUG} && print "loading a jpeg file\n";
 505   } elsif ( $input{type} eq 'png' ) {
 506     if (exists $input{data}) { $self->{IMG}=i_readpng_scalar($input{data}); }
 507     else { $self->{IMG}=i_readpng( $fd ); }
 508     if ( !defined($self->{IMG}) ) { $self->{ERRSTR}='unable to read png image'; return undef; }
 509     $self->{DEBUG} && print "loading a png file\n";
 510   } elsif ( $input{type} eq 'raw' ) {
 511     my %params=(datachannels=>3,storechannels=>3,interleave=>1);
 512     for(keys(%input)) { $params{$_}=$input{$_}; }
 513
 514     if ( !($params{xsize} && $params{ysize}) ) { $self->{ERRSTR}='missing xsize or ysize parameter for raw'; return undef; }
 515     $self->{IMG}=i_readraw( $fd, $params{xsize}, $params{ysize},
 516                            $params{datachannels}, $params{storechannels}, $params{interleave});
 517     if ( !defined($self->{IMG}) ) { $self->{ERRSTR}='unable to read raw image'; return undef; }
 518     $self->{DEBUG} && print "loading a raw file\n";
 519   }
 520   return $self;
 521   }
 522 }
 523
 524
 525 # Write an image to file
 526
 527 sub write {
 528   my $self = shift;
 529   my %input=(jpegquality=>75, gifquant=>'mc', lmdither=>6.0, lmfixed=>[], @_);
 530   my ($fh, $rc, $fd, $IO);
 531
 532   my %iolready=( tiff=>1 ); # this will be SO MUCH BETTER once they are all in there
 533
 534   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
 535
 536   if (!$input{file} and !$input{'fd'} and !$input{'data'}) { $self->{ERRSTR}='file/fd/data parameter missing'; return undef; }
 537   if (!$input{type}) { $input{type}=$FORMATGUESS->($input{file}); }
 538   if (!$input{type}) { $self->{ERRSTR}='type parameter missing and not possible to guess from extension'; return undef; }
 539
 540   if (!$formats{$input{type}}) { $self->{ERRSTR}='format not supported'; return undef; }
 541
 542   if (exists $input{'fd'}) {
 543     $fd=$input{'fd'};
 544   } elsif (exists $input{'data'}) {
 545     $IO = Imager::io_new_bufchain();
 546   } else {
 547     $fh = new IO::File($input{file},"w+");
 548     if (!defined $fh) { $self->{ERRSTR}='Could not open file'; return undef; }
 549     binmode($fh);
 550     $fd = $fh->fileno();
 551   }
 552
 553
 554
 555   if ($iolready{$input{type}}) {
 556     if ($fd) {
 557       $IO = io_new_fd($fd);
 558     }
 559
 560     if ($input{type} eq 'tiff') {
 561       if (!i_writetiff_wiol($self->{IMG}, $IO)) { $self->{ERRSTR}='Could not write to buffer'; return undef; }
 562     }
 563
 564     my $data = io_slurp($IO);
 565     if (!$data) { $self->{ERRSTR}='Could not slurp from buffer'; return undef; }
 566
 567     ${$input{data}} = $data;
 568     return $self;
 569   } else {
 570
 571     if ( $input{type} eq 'gif' ) {
 572       if (not $input{gifplanes}) {
 573         my $gp;
 574         my $count=i_count_colors($self->{IMG}, 256);
 575         $gp=8 if $count == -1;
 576         $gp=1 if not $gp and $count <= 2;
 577         $gp=2 if not $gp and $count <= 4;
 578         $gp=3 if not $gp and $count <= 8;
 579         $gp=4 if not $gp and $count <= 16;
 580         $gp=5 if not $gp and $count <= 32;
 581         $gp=6 if not $gp and $count <= 64;
 582         $gp=7 if not $gp and $count <= 128;
 583         $input{gifplanes} = $gp || 8;
 584       }
 585
 586       if ($input{gifplanes}>8) {
 587         $input{gifplanes}=8;
 588       }
 589       if ($input{gifquant} eq 'gen' || $input{callback}) {
 590
 591
 592         if ($input{gifquant} eq 'lm') {
 593
 594           $input{make_colors} = 'addi';
 595           $input{translate} = 'perturb';
 596           $input{perturb} = $input{lmdither};
 597         } elsif ($input{gifquant} eq 'gen') {
 598           # just pass options through
 599         } else {
 600           $input{make_colors} = 'webmap'; # ignored
 601           $input{translate} = 'giflib';
 602         }
 603
 604         if ($input{callback}) {
 605           defined $input{maxbuffer} or $input{maxbuffer} = -1;
 606           $rc = i_writegif_callback($input{callback}, $input{maxbuffer},
 607                                     \%input, $self->{IMG});
 608         } else {
 609           $rc = i_writegif_gen($fd, \%input, $self->{IMG});
 610         }
 611
 612
 613
 614       } elsif ($input{gifquant} eq 'lm') {
 615         $rc=i_writegif($self->{IMG},$fd,$input{gifplanes},$input{lmdither},$input{lmfixed});
 616       } else {
 617         $rc=i_writegifmc($self->{IMG},$fd,$input{gifplanes});
 618       }
 619       if ( !defined($rc) ) {
 620         $self->{ERRSTR} = "Writing GIF file: "._error_as_msg(); return undef;
 621       }
 622       $self->{DEBUG} && print "writing a gif file\n";
 623
 624     } elsif ( $input{type} eq 'jpeg' ) {
 625       $rc=i_writejpeg($self->{IMG},$fd,$input{jpegquality});
 626       if ( !defined($rc) ) {
 627         $self->{ERRSTR}='unable to write jpeg image'; return undef;
 628       }
 629       $self->{DEBUG} && print "writing a jpeg file\n";
 630     } elsif ( $input{type} eq 'png' ) {
 631       $rc=i_writepng($self->{IMG},$fd);
 632       if ( !defined($rc) ) {
 633         $self->{ERRSTR}='unable to write png image'; return undef;
 634       }
 635       $self->{DEBUG} && print "writing a png file\n";
 636     } elsif ( $input{type} eq 'pnm' ) {
 637       $rc=i_writeppm($self->{IMG},$fd);
 638       if ( !defined($rc) ) {
 639         $self->{ERRSTR}='unable to write pnm image'; return undef;
 640       }
 641       $self->{DEBUG} && print "writing a pnm file\n";
 642     } elsif ( $input{type} eq 'raw' ) {
 643       $rc=i_writeraw($self->{IMG},$fd);
 644       if ( !defined($rc) ) {
 645         $self->{ERRSTR}='unable to write raw image'; return undef;
 646       }
 647       $self->{DEBUG} && print "writing a raw file\n";
 648     } elsif ( $input{type} eq 'tiff' ) {
 649       $rc=i_writetiff_wiol($self->{IMG},io_new_fd($fd) );
 650       if ( !defined($rc) ) {
 651         $self->{ERRSTR}='unable to write tiff image'; return undef;
 652       }
 653       $self->{DEBUG} && print "writing a tiff file\n";
 654     }
 655
 656   }
 657   return $self;
 658 }
 659
 660 sub write_multi {
 661   my ($class, $opts, @images) = @_;
 662
 663   if ($opts->{type} eq 'gif') {
 664     # translate to ImgRaw
 665     if (grep !UNIVERSAL::isa($_, 'Imager') || !$_->{IMG}, @images) {
 666       $ERRSTR = "Usage: Imager->write_multi({ options }, @images)";
 667       return 0;
 668     }
 669     my @work = map $_->{IMG}, @images;
 670     if ($opts->{callback}) {
 671       # Note: you may need to fix giflib for this one to work
 672       my $maxbuffer = $opts->{maxbuffer};
 673       defined $maxbuffer or $maxbuffer = -1; # max by default
 674       return i_writegif_callback($opts->{callback}, $maxbuffer,
 675                                  $opts, @work);
 676     }
 677     if ($opts->{fd}) {
 678       return i_writegif_gen($opts->{fd}, $opts, @work);
 679     }
 680     else {
 681       my $fh = IO::File->new($opts->{file}, "w+");
 682       unless ($fh) {
 683         $ERRSTR = "Error creating $opts->{file}: $!";
 684         return 0;
 685       }
 686       binmode($fh);
 687       return i_writegif_gen(fileno($fh), $opts, @work);
 688     }
 689   }
 690   else {
 691     $ERRSTR = "Sorry, write_multi doesn't support $opts->{type} yet";
 692     return 0;
 693   }
 694 }
 695
 696 # Destroy an Imager object
 697
 698 sub DESTROY {
 699   my $self=shift;
 700   #    delete $instances{$self};
 701   if (defined($self->{IMG})) {
 702     i_img_destroy($self->{IMG});
 703     undef($self->{IMG});
 704   } else {
 705 #    print "Destroy Called on an empty image!\n"; # why did I put this here??
 706   }
 707 }
 708
 709 # Perform an inplace filter of an image
 710 # that is the image will be overwritten with the data
 711
 712 sub filter {
 713   my $self=shift;
 714   my %input=@_;
 715   my %hsh;
 716   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
 717
 718   if (!$input{type}) { $self->{ERRSTR}='type parameter missing'; return undef; }
 719
 720   if ( (grep { $_ eq $input{type} } keys %filters) != 1) {
 721     $self->{ERRSTR}='type parameter not matching any filter'; return undef;
 722   }
 723
 724   if (defined($filters{$input{type}}{defaults})) {
 725     %hsh=('image',$self->{IMG},%{$filters{$input{type}}{defaults}},%input);
 726   } else {
 727     %hsh=('image',$self->{IMG},%input);
 728   }
 729
 730   my @cs=@{$filters{$input{type}}{callseq}};
 731
 732   for(@cs) {
 733     if (!defined($hsh{$_})) {
 734       $self->{ERRSTR}="missing parameter '$_' for filter ".$input{type}; return undef;
 735     }
 736   }
 737
 738   &{$filters{$input{type}}{callsub}}(%hsh);
 739
 740   my @b=keys %hsh;
 741
 742   $self->{DEBUG} && print "callseq is: @cs\n";
 743   $self->{DEBUG} && print "matching callseq is: @b\n";
 744
 745   return $self;
 746 }
 747
 748 # Scale an image to requested size and return the scaled version
 749
 750 sub scale {
 751   my $self=shift;
 752   my %opts=(scalefactor=>0.5,type=>'max',qtype=>'normal',@_);
 753   my $img = Imager->new();
 754   my $tmp = Imager->new();
 755
 756   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
 757
 758   if ($opts{xpixels} and $opts{ypixels} and $opts{type}) {
 759     my ($xpix,$ypix)=( $opts{xpixels}/$self->getwidth() , $opts{ypixels}/$self->getheight() );
 760     if ($opts{type} eq 'min') { $opts{scalefactor}=min($xpix,$ypix); }
 761     if ($opts{type} eq 'max') { $opts{scalefactor}=max($xpix,$ypix); }
 762   } elsif ($opts{xpixels}) { $opts{scalefactor}=$opts{xpixels}/$self->getwidth(); }
 763   elsif ($opts{ypixels}) { $opts{scalefactor}=$opts{ypixels}/$self->getheight(); }
 764
 765   if ($opts{qtype} eq 'normal') {
 766     $tmp->{IMG}=i_scaleaxis($self->{IMG},$opts{scalefactor},0);
 767     if ( !defined($tmp->{IMG}) ) { $self->{ERRSTR}='unable to scale image'; return undef; }
 768     $img->{IMG}=i_scaleaxis($tmp->{IMG},$opts{scalefactor},1);
 769     if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='unable to scale image'; return undef; }
 770     return $img;
 771   }
 772   if ($opts{'qtype'} eq 'preview') {
 773     $img->{IMG}=i_scale_nn($self->{IMG},$opts{'scalefactor'},$opts{'scalefactor'});
 774     if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='unable to scale image'; return undef; }
 775     return $img;
 776   }
 777   $self->{ERRSTR}='scale: invalid value for qtype'; return undef;
 778 }
 779
 780 # Scales only along the X axis
 781
 782 sub scaleX {
 783   my $self=shift;
 784   my %opts=(scalefactor=>0.5,@_);
 785
 786   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
 787
 788   my $img = Imager->new();
 789
 790   if ($opts{pixels}) { $opts{scalefactor}=$opts{pixels}/$self->getwidth(); }
 791
 792   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
 793   $img->{IMG}=i_scaleaxis($self->{IMG},$opts{scalefactor},0);
 794
 795   if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='unable to scale image'; return undef; }
 796   return $img;
 797 }
 798
 799 # Scales only along the Y axis
 800
 801 sub scaleY {
 802   my $self=shift;
 803   my %opts=(scalefactor=>0.5,@_);
 804
 805   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
 806
 807   my $img = Imager->new();
 808
 809   if ($opts{pixels}) { $opts{scalefactor}=$opts{pixels}/$self->getheight(); }
 810
 811   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
 812   $img->{IMG}=i_scaleaxis($self->{IMG},$opts{scalefactor},1);
 813
 814   if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='unable to scale image'; return undef; }
 815   return $img;
 816 }
 817
 818
 819 # Transform returns a spatial transformation of the input image
 820 # this moves pixels to a new location in the returned image.
 821 # NOTE - should make a utility function to check transforms for
 822 # stack overruns
 823
 824 sub transform {
 825   my $self=shift;
 826   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
 827   my %opts=@_;
 828   my (@op,@ropx,@ropy,$iop,$or,@parm,$expr,@xt,@yt,@pt,$numre);
 829
 830 #  print Dumper(\%opts);
 831 #  xopcopdes
 832
 833   if ( $opts{'xexpr'} and $opts{'yexpr'} ) {
 834     if (!$I2P) {
 835       eval ("use Affix::Infix2Postfix;");
 836       print $@;
 837       if ( $@ ) {
 838         $self->{ERRSTR}='transform: expr given and Affix::Infix2Postfix is not avaliable.';
 839         return undef;
 840       }
 841       $I2P=Affix::Infix2Postfix->new('ops'=>[{op=>'+',trans=>'Add'},
 842                                              {op=>'-',trans=>'Sub'},
 843                                              {op=>'*',trans=>'Mult'},
 844                                              {op=>'/',trans=>'Div'},
 845                                              {op=>'-',type=>'unary',trans=>'u-'},
 846                                              {op=>'**'},
 847                                              {op=>'func',type=>'unary'}],
 848                                      'grouping'=>[qw( \( \) )],
 849                                      'func'=>[qw( sin cos )],
 850                                      'vars'=>[qw( x y )]
 851                                     );
 852     }
 853
 854     @xt=$I2P->translate($opts{'xexpr'});
 855     @yt=$I2P->translate($opts{'yexpr'});
 856
 857     $numre=$I2P->{'numre'};
 858     @pt=(0,0);
 859
 860     for(@xt) { if (/$numre/) { push(@pt,$_); push(@{$opts{'xopcodes'}},'Parm',$#pt); } else { push(@{$opts{'xopcodes'}},$_); } }
 861     for(@yt) { if (/$numre/) { push(@pt,$_); push(@{$opts{'yopcodes'}},'Parm',$#pt); } else { push(@{$opts{'yopcodes'}},$_); } }
 862     @{$opts{'parm'}}=@pt;
 863   }
 864
 865 #  print Dumper(\%opts);
 866
 867   if ( !exists $opts{'xopcodes'} or @{$opts{'xopcodes'}}==0) {
 868     $self->{ERRSTR}='transform: no xopcodes given.';
 869     return undef;
 870   }
 871
 872   @op=@{$opts{'xopcodes'}};
 873   for $iop (@op) {
 874     if (!defined ($OPCODES{$iop}) and ($iop !~ /^\d+$/) ) {
 875       $self->{ERRSTR}="transform: illegal opcode '$_'.";
 876       return undef;
 877     }
 878     push(@ropx,(exists $OPCODES{$iop}) ? @{$OPCODES{$iop}} : $iop );
 879   }
 880
 881
 882 # yopcopdes
 883
 884   if ( !exists $opts{'yopcodes'} or @{$opts{'yopcodes'}}==0) {
 885     $self->{ERRSTR}='transform: no yopcodes given.';
 886     return undef;
 887   }
 888
 889   @op=@{$opts{'yopcodes'}};
 890   for $iop (@op) {
 891     if (!defined ($OPCODES{$iop}) and ($iop !~ /^\d+$/) ) {
 892       $self->{ERRSTR}="transform: illegal opcode '$_'.";
 893       return undef;
 894     }
 895     push(@ropy,(exists $OPCODES{$iop}) ? @{$OPCODES{$iop}} : $iop );
 896   }
 897
 898 #parameters
 899
 900   if ( !exists $opts{'parm'}) {
 901     $self->{ERRSTR}='transform: no parameter arg given.';
 902     return undef;
 903   }
 904
 905 #  print Dumper(\@ropx);
 906 #  print Dumper(\@ropy);
 907 #  print Dumper(\@ropy);
 908
 909   my $img = Imager->new();
 910   $img->{IMG}=i_transform($self->{IMG},\@ropx,\@ropy,$opts{'parm'});
 911   if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='transform: failed'; return undef; }
 912   return $img;
 913 }
 914
 915
 916 {
 917   my $got_expr;
 918   sub transform2 {
 919     my ($opts, @imgs) = @_;
 920
 921     if (!$got_expr) {
 922       # this is fairly big, delay loading it
 923       eval "use Imager::Expr";
 924       die $@ if $@;
 925       ++$got_expr;
 926     }
 927
 928     $opts->{variables} = [ qw(x y) ];
 929     my ($width, $height) = @{$opts}{qw(width height)};
 930     if (@imgs) {
 931         $width ||= $imgs[0]->getwidth();
 932         $height ||= $imgs[0]->getheight();
 933         my $img_num = 1;
 934         for my $img (@imgs) {
 935             $opts->{constants}{"w$img_num"} = $img->getwidth();
 936             $opts->{constants}{"h$img_num"} = $img->getheight();
 937             $opts->{constants}{"cx$img_num"} = $img->getwidth()/2;
 938             $opts->{constants}{"cy$img_num"} = $img->getheight()/2;
 939             ++$img_num;
 940         }
 941     }
 942     if ($width) {
 943       $opts->{constants}{w} = $width;
 944       $opts->{constants}{cx} = $width/2;
 945     }
 946     else {
 947       $Imager::ERRSTR = "No width supplied";
 948       return;
 949     }
 950     if ($height) {
 951       $opts->{constants}{h} = $height;
 952       $opts->{constants}{cy} = $height/2;
 953     }
 954     else {
 955       $Imager::ERRSTR = "No height supplied";
 956       return;
 957     }
 958     my $code = Imager::Expr->new($opts);
 959     if (!$code) {
 960       $Imager::ERRSTR = Imager::Expr::error();
 961       return;
 962     }
 963
 964     my $img = Imager->new();
 965     $img->{IMG} = i_transform2($opts->{width}, $opts->{height}, $code->code(),
 966                                $code->nregs(), $code->cregs(),
 967                                [ map { $_->{IMG} } @imgs ]);
 968     if (!defined $img->{IMG}) {
 969       $Imager::ERRSTR = "transform2 failed";
 970       return;
 971     }
 972
 973     return $img;
 974   }
 975 }
 976
 977
 978
 979
 980
 981
 982
 983
 984 sub rubthrough {
 985   my $self=shift;
 986   my %opts=(tx=>0,ty=>0,@_);
 987
 988   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
 989   unless ($opts{src} && $opts{src}->{IMG}) { $self->{ERRSTR}='empty input image for source'; return undef; }
 990
 991   i_rubthru($self->{IMG}, $opts{src}->{IMG}, $opts{tx},$opts{ty});
 992   return $self;
 993 }
 994
 995
 996
 997 # These two are supported for legacy code only
 998
 999 sub i_color_new {
1000   return Imager::Color->new($_[0], $_[1], $_[2], $_[3]);
1001 }
1002
1003 sub i_color_set {
1004   return Imager::Color::set($_[0], $_[1], $_[2], $_[3], $_[4]);
1005 }
1006
1007
1008
1009 # Draws a box between the specified corner points.
1010
1011 sub box {
1012   my $self=shift;
1013   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1014   my $dflcl=i_color_new(255,255,255,255);
1015   my %opts=(color=>$dflcl,xmin=>0,ymin=>0,xmax=>$self->getwidth()-1,ymax=>$self->getheight()-1,@_);
1016
1017   if (exists $opts{'box'}) {
1018     $opts{'xmin'} = min($opts{'box'}->[0],$opts{'box'}->[2]);
1019     $opts{'xmax'} = max($opts{'box'}->[0],$opts{'box'}->[2]);
1020     $opts{'ymin'} = min($opts{'box'}->[1],$opts{'box'}->[3]);
1021     $opts{'ymax'} = max($opts{'box'}->[1],$opts{'box'}->[3]);
1022   }
1023
1024   if ($opts{filled}) { i_box_filled($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},$opts{ymax},$opts{color}); }
1025   else { i_box($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},$opts{ymax},$opts{color}); }
1026   return $self;
1027 }
1028
1029 # Draws an arc - this routine SUCKS and is buggy - it sometimes doesn't work when the arc is a convex polygon
1030
1031 sub arc {
1032   my $self=shift;
1033   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1034   my $dflcl=i_color_new(255,255,255,255);
1035   my %opts=(color=>$dflcl,
1036             'r'=>min($self->getwidth(),$self->getheight())/3,
1037             'x'=>$self->getwidth()/2,
1038             'y'=>$self->getheight()/2,
1039             'd1'=>0, 'd2'=>361, @_);
1040   i_arc($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},$opts{'d1'},$opts{'d2'},$opts{'color'});
1041   return $self;
1042 }
1043
1044 # Draws a line from one point to (but not including) the destination point
1045
1046 sub line {
1047   my $self=shift;
1048   my $dflcl=i_color_new(0,0,0,0);
1049   my %opts=(color=>$dflcl,@_);
1050   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1051
1052   unless (exists $opts{x1} and exists $opts{y1}) { $self->{ERRSTR}='missing begining coord'; return undef; }
1053   unless (exists $opts{x2} and exists $opts{y2}) { $self->{ERRSTR}='missing ending coord'; return undef; }
1054
1055   if ($opts{antialias}) {
1056     i_line_aa($self->{IMG},$opts{x1}, $opts{y1}, $opts{x2}, $opts{y2}, $opts{color});
1057   } else {
1058     i_draw($self->{IMG},$opts{x1}, $opts{y1}, $opts{x2}, $opts{y2}, $opts{color});
1059   }
1060   return $self;
1061 }
1062
1063 # Draws a line between an ordered set of points - It more or less just transforms this
1064 # into a list of lines.
1065
1066 sub polyline {
1067   my $self=shift;
1068   my ($pt,$ls,@points);
1069   my $dflcl=i_color_new(0,0,0,0);
1070   my %opts=(color=>$dflcl,@_);
1071
1072   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1073
1074   if (exists($opts{points})) { @points=@{$opts{points}}; }
1075   if (!exists($opts{points}) and exists($opts{'x'}) and exists($opts{'y'}) ) {
1076     @points=map { [ $opts{'x'}->[$_],$opts{'y'}->[$_] ] } (0..(scalar @{$opts{'x'}}-1));
1077     }
1078
1079 #  print Dumper(\@points);
1080
1081   if ($opts{antialias}) {
1082     for $pt(@points) {
1083       if (defined($ls)) { i_line_aa($self->{IMG},$ls->[0],$ls->[1],$pt->[0],$pt->[1],$opts{color}); }
1084       $ls=$pt;
1085     }
1086   } else {
1087     for $pt(@points) {
1088       if (defined($ls)) { i_draw($self->{IMG},$ls->[0],$ls->[1],$pt->[0],$pt->[1],$opts{color}); }
1089       $ls=$pt;
1090     }
1091   }
1092   return $self;
1093 }
1094
1095 # this the multipoint bezier curve
1096 # this is here more for testing that actual usage since
1097 # this is not a good algorithm.  Usually the curve would be
1098 # broken into smaller segments and each done individually.
1099
1100 sub polybezier {
1101   my $self=shift;
1102   my ($pt,$ls,@points);
1103   my $dflcl=i_color_new(0,0,0,0);
1104   my %opts=(color=>$dflcl,@_);
1105
1106   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1107
1108   if (exists $opts{points}) {
1109     $opts{'x'}=map { $_->[0]; } @{$opts{'points'}};
1110     $opts{'y'}=map { $_->[1]; } @{$opts{'points'}};
1111   }
1112
1113   unless ( @{$opts{'x'}} and @{$opts{'x'}} == @{$opts{'y'}} ) {
1114     $self->{ERRSTR}='Missing or invalid points.';
1115     return;
1116   }
1117
1118   i_bezier_multi($self->{IMG},$opts{'x'},$opts{'y'},$opts{'color'});
1119   return $self;
1120 }
1121
1122
1123 # destructive border - image is shrunk by one pixel all around
1124
1125 sub border {
1126   my ($self,%opts)=@_;
1127   my($tx,$ty)=($self->getwidth()-1,$self->getheight()-1);
1128   $self->polyline('x'=>[0,$tx,$tx,0,0],'y'=>[0,0,$ty,$ty,0],%opts);
1129 }
1130
1131
1132 # Get the width of an image
1133
1134 sub getwidth {
1135   my $self = shift;
1136   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
1137   return (i_img_info($self->{IMG}))[0];
1138 }
1139
1140 # Get the height of an image
1141
1142 sub getheight {
1143   my $self = shift;
1144   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
1145   return (i_img_info($self->{IMG}))[1];
1146 }
1147
1148 # Get number of channels in an image
1149
1150 sub getchannels {
1151   my $self = shift;
1152   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
1153   return i_img_getchannels($self->{IMG});
1154 }
1155
1156 # Get channel mask
1157
1158 sub getmask {
1159   my $self = shift;
1160   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
1161   return i_img_getmask($self->{IMG});
1162 }
1163
1164 # Set channel mask
1165
1166 sub setmask {
1167   my $self = shift;
1168   my %opts = @_;
1169   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
1170   i_img_setmask( $self->{IMG} , $opts{mask} );
1171 }
1172
1173 # Get number of colors in an image
1174
1175 sub getcolorcount {
1176   my $self=shift;
1177   my %opts=(maxcolors=>2**30,@_);
1178   if (!defined($self->{IMG})) { $self->{ERRSTR}='image is empty'; return undef; }
1179   my $rc=i_count_colors($self->{IMG},$opts{'maxcolors'});
1180   return ($rc==-1? undef : $rc);
1181 }
1182
1183 # draw string to an image
1184
1185 sub string {
1186   my $self = shift;
1187   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1188
1189   my %input=('x'=>0, 'y'=>0, @_);
1190   $input{string}||=$input{text};
1191
1192   unless(exists $input{string}) {
1193     $self->{ERRSTR}="missing required parameter 'string'";
1194     return;
1195   }
1196
1197   unless($input{font}) {
1198     $self->{ERRSTR}="missing required parameter 'font'";
1199     return;
1200   }
1201
1202   my $aa=1;
1203   my $font=$input{'font'};
1204   my $align=$font->{'align'} unless exists $input{'align'};
1205   my $color=$input{'color'} || $font->{'color'};
1206   my $size=$input{'size'}   || $font->{'size'};
1207
1208   if (!defined($size)) { $self->{ERRSTR}='No size parameter and no default in font'; return undef; }
1209
1210   $aa=$font->{'aa'} if exists $font->{'aa'};
1211   $aa=$input{'aa'} if exists $input{'aa'};
1212
1213
1214
1215 #  unless($font->can('text')) {
1216 #    $self->{ERRSTR}="font is unable to do what we need";
1217 #    return;
1218 #  }
1219
1220 #  use Data::Dumper;
1221 #  warn Dumper($font);
1222
1223 #  print "Channel=".$input{'channel'}."\n";
1224
1225   if ( $font->{'type'} eq 't1' ) {
1226     if ( exists $input{'channel'} ) {
1227       Imager::Font::t1_set_aa_level($aa);
1228       i_t1_cp($self->{IMG},$input{'x'},$input{'y'},
1229               $input{'channel'},$font->{'id'},$size,
1230               $input{'string'},length($input{'string'}),1);
1231     } else {
1232       Imager::Font::t1_set_aa_level($aa);
1233       i_t1_text($self->{IMG},$input{'x'},$input{'y'},
1234                 $color,$font->{'id'},$size,
1235                 $input{'string'},length($input{'string'}),1);
1236     }
1237   }
1238
1239   if ( $font->{'type'} eq 'tt' ) {
1240     if ( exists $input{'channel'} ) {
1241       i_tt_cp($font->{'id'},$self->{IMG},$input{'x'},$input{'y'},$input{'channel'},
1242               $size,$input{'string'},length($input{'string'}),$aa);
1243     } else {
1244       i_tt_text($font->{'id'},$self->{IMG},$input{'x'},$input{'y'},$color,$size,
1245                 $input{'string'},length($input{'string'}),$aa);
1246     }
1247   }
1248
1249   return $self;
1250 }
1251
1252
1253
1254
1255
1256 # Shortcuts that can be exported
1257
1258 sub newcolor { Imager::Color->new(@_); }
1259 sub newfont  { Imager::Font->new(@_); }
1260
1261 *NC=*newcolour=*newcolor;
1262 *NF=*newfont;
1263
1264 *open=\&read;
1265 *circle=\&arc;
1266
1267
1268 #### Utility routines
1269
1270 sub errstr { $_[0]->{ERRSTR} }
1271
1272
1273
1274
1275
1276
1277 # Default guess for the type of an image from extension
1278
1279 sub def_guess_type {
1280   my $name=lc(shift);
1281   my $ext;
1282   $ext=($name =~ m/\.([^\.]+)$/)[0];
1283   return 'tiff' if ($ext =~ m/^tiff?$/);
1284   return 'jpeg' if ($ext =~ m/^jpe?g$/);
1285   return 'pnm'  if ($ext =~ m/^p[pgb]m$/);
1286   return 'png'  if ($ext eq "png");
1287   return 'gif'  if ($ext eq "gif");
1288   return ();
1289 }
1290
1291 # get the minimum of a list
1292
1293 sub min {
1294   my $mx=shift;
1295   for(@_) { if ($_<$mx) { $mx=$_; }}
1296   return $mx;
1297 }
1298
1299 # get the maximum of a list
1300
1301 sub max {
1302   my $mx=shift;
1303   for(@_) { if ($_>$mx) { $mx=$_; }}
1304   return $mx;
1305 }
1306
1307 # string stuff for iptc headers
1308
1309 sub clean {
1310   my($str)=$_[0];
1311   $str = substr($str,3);
1312   $str =~ s/[\n\r]//g;
1313   $str =~ s/\s+/ /g;
1314   $str =~ s/^\s//;
1315   $str =~ s/\s$//;
1316   return $str;
1317 }
1318
1319 # A little hack to parse iptc headers.
1320
1321 sub parseiptc {
1322   my $self=shift;
1323   my(@sar,$item,@ar);
1324   my($caption,$photogr,$headln,$credit);
1325
1326   my $str=$self->{IPTCRAW};
1327
1328   #print $str;
1329
1330   @ar=split(/8BIM/,$str);
1331
1332   my $i=0;
1333   foreach (@ar) {
1334     if (/^\004\004/) {
1335       @sar=split(/\034\002/);
1336       foreach $item (@sar) {
1337         if ($item =~ m/^x/) {
1338           $caption=&clean($item);
1339           $i++;
1340         }
1341         if ($item =~ m/^P/) {
1342           $photogr=&clean($item);
1343           $i++;
1344         }
1345         if ($item =~ m/^i/) {
1346           $headln=&clean($item);
1347           $i++;
1348         }
1349         if ($item =~ m/^n/) {
1350           $credit=&clean($item);
1351           $i++;
1352         }
1353       }
1354     }
1355   }
1356   return (caption=>$caption,photogr=>$photogr,headln=>$headln,credit=>$credit);
1357 }
1358
1359
1360
1361
1362
1363
1364 # Autoload methods go after =cut, and are processed by the autosplit program.
1365
1366 1;
1367 __END__
1368 # Below is the stub of documentation for your module. You better edit it!
1369
1370 =head1 NAME
1371
1372 Imager - Perl extension for Generating 24 bit Images
1373
1374 =head1 SYNOPSIS
1375
1376   use Imager qw(init);
1377
1378   init();
1379   $img = Imager->new();
1380   $img->open(file=>'image.ppm',type=>'pnm')
1381     || print "failed: ",$img->{ERRSTR},"\n";
1382   $scaled=$img->scale(xpixels=>400,ypixels=>400);
1383   $scaled->write(file=>'sc_image.ppm',type=>'pnm')
1384     || print "failed: ",$scaled->{ERRSTR},"\n";
1385
1386 =head1 DESCRIPTION
1387
1388 Imager is a module for creating and altering images - It is not meant
1389 as a replacement or a competitor to ImageMagick or GD. Both are
1390 excellent packages and well supported.
1391
1392 =head2 API
1393
1394 Almost all functions take the parameters in the hash fashion.
1395 Example:
1396
1397   $img->open(file=>'lena.png',type=>'png');
1398
1399 or just:
1400
1401   $img->open(file=>'lena.png');
1402
1403 =head2 Basic concept
1404
1405 An Image object is created with C<$img = Imager-E<gt>new()> Should
1406 this fail for some reason an explanation can be found in
1407 C<$Imager::ERRSTR> usually error messages are stored in
1408 C<$img-E<gt>{ERRSTR}>, but since no object is created this is the only
1409 way to give back errors.  C<$Imager::ERRSTR> is also used to report
1410 all errors not directly associated with an image object. Examples:
1411
1412   $img=Imager->new(); # This is an empty image (size is 0 by 0)
1413   $img->open(file=>'lena.png',type=>'png'); # initializes from file
1414
1415 or if you want to create an empty image:
1416
1417   $img=Imager->new(xsize=>400,ysize=>300,channels=>4);
1418
1419 This example creates a completely black image of width 400 and
1420 height 300 and 4 channels.
1421
1422 If you have an existing image, use img_set() to change it's dimensions
1423 - this will destroy any existing image data:
1424
1425   $img->img_set(xsize=>500, ysize=>500, channels=>4);
1426
1427 Color objects are created by calling the Imager::Color->new()
1428 method:
1429
1430   $color = Imager::Color->new($red, $green, $blue);
1431   $color = Imager::Color->new($red, $green, $blue, $alpha);
1432   $color = Imager::Color->new("#C0C0FF"); # html color specification
1433
1434 This object can then be passed to functions that require a color parameter.
1435
1436 Coordinates in Imager have the origin in the upper left corner.  The
1437 horizontal coordinate increases to the right and the vertical
1438 downwards.
1439
1440 =head2 Reading and writing images
1441
1442 C<$img-E<gt>read()> generally takes two parameters, 'file' and 'type'.
1443 If the type of the file can be determined from the suffix of the file
1444 it can be omitted.  Format dependant parameters are: For images of
1445 type 'raw' two extra parameters are needed 'xsize' and 'ysize', if the
1446 'channel' parameter is omitted for type 'raw' it is assumed to be 3.
1447 gif and png images might have a palette are converted to truecolor bit
1448 when read.  Alpha channel is preserved for png images irregardless of
1449 them being in RGB or gray colorspace.  Similarly grayscale jpegs are
1450 one channel images after reading them.  For jpeg images the iptc
1451 header information (stored in the APP13 header) is avaliable to some
1452 degree. You can get the raw header with C<$img-E<gt>{IPTCRAW}>, but
1453 you can also retrieve the most basic information with
1454 C<%hsh=$img-E<gt>parseiptc()> as always patches are welcome.  Neither
1455 pnm nor tiff have extra options. Examples:
1456
1457   $img = Imager->new();
1458   $img->read(file=>"cover.jpg") or die $img->errstr; # gets type from name
1459
1460   $img = Imager->new();
1461   { local(*FH,$/); open(FH,"file.gif") or die $!; $a=<FH>; }
1462   $img->read(data=>$a,type=>'gif') or die $img->errstr;
1463
1464 The second example shows how to read an image from a scalar, this is
1465 usefull if your data originates from somewhere else than a filesystem
1466 such as a database over a DBI connection.
1467
1468 *Note that load() is now an alias for read but will be removed later*
1469
1470 C<$img-E<gt>write> has the same interface as C<read()>.  The earlier
1471 comments on C<read()> for autodetecting filetypes apply.  For jpegs
1472 quality can be adjusted via the 'jpegquality' parameter (0-100).  The
1473 number of colorplanes in gifs are set with 'gifplanes' and should be
1474 between 1 (2 color) and 8 (256 colors).  It is also possible to choose
1475 between two quantizing methods with the parameter 'gifquant'. If set
1476 to mc it uses the mediancut algorithm from either giflibrary. If set
1477 to lm it uses a local means algorithm. It is then possible to give
1478 some extra settings. lmdither is the dither deviation amount in pixels
1479 (manhattan distance).  lmfixed can be an array ref who holds an array
1480 of Imager::Color objects.  Note that the local means algorithm needs
1481 much more cpu time but also gives considerable better results than the
1482 median cut algorithm.
1483
1484 Currently just for gif files, you can specify various options for the
1485 conversion from Imager's internal RGB format to the target's indexed
1486 file format.  If you set the gifquant option to 'gen', you can use the
1487 options specified under L<Quantization options>.
1488
1489 To see what Imager is compiled to support the following code snippet
1490 is sufficient:
1491
1492   use Imager;
1493   print "@{[keys %Imager::formats]}";
1494
1495 When reading raw images you need to supply the width and height of the
1496 image in the xsize and ysize options:
1497
1498   $img->read(file=>'foo.raw', xsize=>100, ysize=>100)
1499     or die "Cannot read raw image\n";
1500
1501 If your input file has more channels than you want, or (as is common),
1502 junk in the fourth channel, you can use the datachannels and
1503 storechannels options to control the number of channels in your input
1504 file and the resulting channels in your image.  For example, if your
1505 input image uses 32-bits per pixel with red, green, blue and junk
1506 values for each pixel you could do:
1507
1508   $img->read(file=>'foo.raw', xsize=>100, ysize=>100, datachannels=>4,
1509              storechannels=>3)
1510     or die "Cannot read raw image\n";
1511
1512 Normally the raw image is expected to have the value for channel 1
1513 immediately following channel 0 and channel 2 immediately following
1514 channel 1 for each pixel.  If your input image has all the channel 0
1515 values for the first line of the image, followed by all the channel 1
1516 values for the first line and so on, you can use the interleave option:
1517
1518   $img->read(file=>'foo.raw', xsize=100, ysize=>100, interleave=>1)
1519     or die "Cannot read raw image\n";
1520
1521 =head2 Multi-image files
1522
1523 Currently just for gif files, you can create files that contain more
1524 than one image.
1525
1526 To do this:
1527
1528   Imager->write_multi(\%opts, @images)
1529
1530 Where %opts describes 3 possible types of outputs:
1531
1532 =over 4
1533
1534 =item callback
1535
1536 A code reference which is called with a single parameter, the data to
1537 be written.  You can also specify $opts{maxbuffer} which is the
1538 maximum amount of data buffered.  Note that there can be larger writes
1539 than this if the file library writes larger blocks.  A smaller value
1540 maybe useful for writing to a socket for incremental display.
1541
1542 =item fd
1543
1544 The file descriptor to save the images to.
1545
1546 =item file
1547
1548 The name of the file to write to.
1549
1550 %opts may also include the keys from L<Gif options> and L<Quantization
1551 options>.
1552
1553 =back
1554
1555 The current aim is to support other multiple image formats in the
1556 future, such as TIFF, and to support reading multiple images from a
1557 single file.
1558
1559 A simple example:
1560
1561     my @images;
1562     # ... code to put images in @images
1563     Imager->write_multi({type=>'gif',
1564                          file=>'anim.gif',
1565                          gif_delays=>[ 10 x @images ] },
1566                         @images)
1567     or die "Oh dear!";
1568
1569 =head2 Gif options
1570
1571 These options can be specified when calling write_multi() for gif
1572 files, when writing a single image with the gifquant option set to
1573 'gen', or for direct calls to i_writegif_gen and i_writegif_callback.
1574
1575 Note that some viewers will ignore some of these options
1576 (gif_user_input in particular).
1577
1578 =over 4
1579
1580 =item gif_each_palette
1581
1582 Each image in the gif file has it's own palette if this is non-zero.
1583 All but the first image has a local colour table (the first uses the
1584 global colour table.
1585
1586 =item interlace
1587
1588 The images are written interlaced if this is non-zero.
1589
1590 =item gif_delays
1591
1592 A reference to an array containing the delays between images, in 1/100
1593 seconds.
1594
1595 =item gif_user_input
1596
1597 A reference to an array contains user input flags.  If the given flag
1598 is non-zero the image viewer should wait for input before displaying
1599 the next image.
1600
1601 =item gif_disposal
1602
1603 A reference to an array of image disposal methods.  These define what
1604 should be done to the image before displaying the next one.  These are
1605 integers, where 0 means unspecified, 1 means the image should be left
1606 in place, 2 means restore to background colour and 3 means restore to
1607 the previous value.
1608
1609 =item gif_tran_color
1610
1611 A reference to an Imager::Color object, which is the colour to use for
1612 the palette entry used to represent transparency in the palette.  You
1613 need to set the transp option (see L<Quantization options>) for this
1614 value to be used.
1615
1616 =item gif_positions
1617
1618 A reference to an array of references to arrays which represent screen
1619 positions for each image.
1620
1621 =item gif_loop_count
1622
1623 If this is non-zero the Netscape loop extension block is generated,
1624 which makes the animation of the images repeat.
1625
1626 This is currently unimplemented due to some limitations in giflib.
1627
1628 =back
1629
1630 =head2 Quantization options
1631
1632 These options can be specified when calling write_multi() for gif
1633 files, when writing a single image with the gifquant option set to
1634 'gen', or for direct calls to i_writegif_gen and i_writegif_callback.
1635
1636 =over 4
1637
1638 =item colors
1639
1640 A arrayref of colors that are fixed.  Note that some color generators
1641 will ignore this.
1642
1643 =item transp
1644
1645 The type of transparency processing to perform for images with an
1646 alpha channel where the output format does not have a proper alpha
1647 channel (eg. gif).  This can be any of:
1648
1649 =over 4
1650
1651 =item none
1652
1653 No transparency processing is done. (default)
1654
1655 =item threshold
1656
1657 Pixels more transparent that tr_threshold are rendered as transparent.
1658
1659 =item errdiff
1660
1661 An error diffusion dither is done on the alpha channel.  Note that
1662 this is independent of the translation performed on the colour
1663 channels, so some combinations may cause undesired artifacts.
1664
1665 =item ordered
1666
1667 The ordered dither specified by tr_orddith is performed on the alpha
1668 channel.
1669
1670 =back
1671
1672 This will only be used if the image has an alpha channel, and if there
1673 is space in the palette for a transparency colour.
1674
1675 =item tr_threshold
1676
1677 The highest alpha value at which a pixel will be made transparent when
1678 transp is 'threshold'. (0-255, default 127)
1679
1680 =item tr_errdiff
1681
1682 The type of error diffusion to perform on the alpha channel when
1683 transp is 'errdiff'.  This can be any defined error diffusion type
1684 except for custom (see errdiff below).
1685
1686 =item tr_orddith
1687
1688 The type of ordered dither to perform on the alpha channel when transp
1689 is 'ordered'.  Possible values are:
1690
1691 =over 4
1692
1693 =item random
1694
1695 A semi-random map is used.  The map is the same each time.  Currently
1696 the default (which may change.)
1697
1698 =item dot8
1699
1700 8x8 dot dither.
1701
1702 =item dot4
1703
1704 4x4 dot dither
1705
1706 =item hline
1707
1708 horizontal line dither.
1709
1710 =item vline
1711
1712 vertical line dither.
1713
1714 =item "/line"
1715
1716 =item slashline
1717
1718 diagonal line dither
1719
1720 =item '\line'
1721
1722 =item backline
1723
1724 diagonal line dither
1725
1726 =item custom
1727
1728 A custom dither matrix is used - see tr_map
1729
1730 =back
1731
1732 =item tr_map
1733
1734 When tr_orddith is custom this defines an 8 x 8 matrix of integers
1735 representing the transparency threshold for pixels corresponding to
1736 each position.  This should be a 64 element array where the first 8
1737 entries correspond to the first row of the matrix.  Values should be
1738 betweern 0 and 255.
1739
1740 =item make_colors
1741
1742 Defines how the quantization engine will build the palette(s).
1743 Currently this is ignored if 'translate' is 'giflib', but that may
1744 change.  Possible values are:
1745
1746 =over 4
1747
1748 =item none
1749
1750 Only colors supplied in 'colors' are used.
1751
1752 =item webmap
1753
1754 The web color map is used (need url here.)
1755
1756 =item addi
1757
1758 The original code for generating the color map (Addi's code) is used.
1759
1760 =back
1761
1762 Other methods may be added in the future.
1763
1764 =item colors
1765
1766 A arrayref containing Imager::Color objects, which represents the
1767 starting set of colors to use in translating the images.  webmap will
1768 ignore this.  The final colors used are copied back into this array
1769 (which is expanded if necessary.)
1770
1771 =item max_colors
1772
1773 The maximum number of colors to use in the image.
1774
1775 =item translate
1776
1777 The method used to translate the RGB values in the source image into
1778 the colors selected by make_colors.  Note that make_colors is ignored
1779 whene translate is 'giflib'.
1780
1781 Possible values are:
1782
1783 =over 4
1784
1785 =item giflib
1786
1787 The giflib native quantization function is used.
1788
1789 =item closest
1790
1791 The closest color available is used.
1792
1793 =item perturb
1794
1795 The pixel color is modified by perturb, and the closest color is chosen.
1796
1797 =item errdiff
1798
1799 An error diffusion dither is performed.
1800
1801 =back
1802
1803 It's possible other transate values will be added.
1804
1805 =item errdiff
1806
1807 The type of error diffusion dither to perform.  These values (except
1808 for custom) can also be used in tr_errdif.
1809
1810 =over 4
1811
1812 =item floyd
1813
1814 Floyd-Steinberg dither
1815
1816 =item jarvis
1817
1818 Jarvis, Judice and Ninke dither
1819
1820 =item stucki
1821
1822 Stucki dither
1823
1824 =item custom
1825
1826 Custom.  If you use this you must also set errdiff_width,
1827 errdiff_height and errdiff_map.
1828
1829 =back
1830
1831 =item errdiff_width
1832
1833 =item errdiff_height
1834
1835 =item errdiff_orig
1836
1837 =item errdiff_map
1838
1839 When translate is 'errdiff' and errdiff is 'custom' these define a
1840 custom error diffusion map.  errdiff_width and errdiff_height define
1841 the size of the map in the arrayref in errdiff_map.  errdiff_orig is
1842 an integer which indicates the current pixel position in the top row
1843 of the map.
1844
1845 =item perturb
1846
1847 When translate is 'perturb' this is the magnitude of the random bias
1848 applied to each channel of the pixel before it is looked up in the
1849 color table.
1850
1851 =back
1852
1853 =head2 Obtaining/setting attributes of images
1854
1855 To get the size of an image in pixels the C<$img-E<gt>getwidth()> and
1856 C<$img-E<gt>getheight()> are used.
1857
1858 To get the number of channels in
1859 an image C<$img-E<gt>getchannels()> is used.  $img-E<gt>getmask() and
1860 $img-E<gt>setmask() are used to get/set the channel mask of the image.
1861
1862   $mask=$img->getmask();
1863   $img->setmask(mask=>1+2); # modify red and green only
1864   $img->setmask(mask=>8); # modify alpha only
1865   $img->setmask(mask=>$mask); # restore previous mask
1866
1867 The mask of an image describes which channels are updated when some
1868 operation is performed on an image.  Naturally it is not possible to
1869 apply masks to operations like scaling that alter the dimensions of
1870 images.
1871
1872 It is possible to have Imager find the number of colors in an image
1873 by using C<$img-E<gt>getcolorcount()>. It requires memory proportionally
1874 to the number of colors in the image so it is possible to have it
1875 stop sooner if you only need to know if there are more than a certain number
1876 of colors in the image.  If there are more colors than asked for
1877 the function return undef.  Examples:
1878
1879   if (!defined($img->getcolorcount(maxcolors=>512)) {
1880     print "Less than 512 colors in image\n";
1881   }
1882
1883 =head2 Drawing Methods
1884
1885 IMPLEMENTATION MORE OR LESS DONE CHECK THE TESTS
1886
1887 DOCUMENTATION OF THIS SECTION OUT OF SYNC
1888
1889 It is possible to draw with graphics primitives onto images.  Such
1890 primitives include boxes, arcs, circles and lines.  A reference
1891 oriented list follows.
1892
1893 Box:
1894   $img->box(color=>$blue,xmin=>10,ymin=>30,xmax=>200,ymax=>300,filled=>1);
1895
1896 The above example calls the C<box> method for the image and the box
1897 covers the pixels with in the rectangle specified.  If C<filled> is
1898 ommited it is drawn as an outline.  If any of the edges of the box are
1899 ommited it will snap to the outer edge of the image in that direction.
1900 Also if a color is omitted a color with (255,255,255,255) is used
1901 instead.
1902
1903 Arc:
1904   $img->arc(color=>$red, r=20, x=>200, y=>100, d1=>10, d2=>20 );
1905
1906 This creates a filled red arc with a 'center' at (200, 100) and spans
1907 10 degrees and the slice has a radius of 20. SEE section on BUGS.
1908
1909 Circle:
1910   $img->circle(color=>$green, r=50, x=>200, y=>100);
1911
1912 This creates a green circle with its center at (200, 100) and has a
1913 radius of 20.
1914
1915 Line:
1916   $img->line(color=>$green, x1=10, x2=>100,
1917                             y1=>20, y2=>50, antialias=>1 );
1918
1919 That draws an antialiased line from (10,100) to (20,50).
1920
1921 Polyline:
1922   $img->polyline(points=>[[$x0,$y0],[$x1,$y1],[$x2,$y2]],color=>$red);
1923   $img->polyline(x=>[$x0,$x1,$x2], y=>[$y0,$y1,$y2], antialias=>1);
1924
1925 Polyline is used to draw multilple lines between a series of points.
1926 The point set can either be specified as an arrayref to an array of
1927 array references (where each such array represents a point).  The
1928 other way is to specify two array references.
1929
1930 =head2 Text rendering
1931
1932 Text rendering is described in the Imager::Font manpage.
1933
1934 =head2 Image resizing
1935
1936 To scale an image so porportions are maintained use the
1937 C<$img-E<gt>scale()> method.  if you give either a xpixels or ypixels
1938 parameter they will determine the width or height respectively.  If
1939 both are given the one resulting in a larger image is used.  example:
1940 C<$img> is 700 pixels wide and 500 pixels tall.
1941
1942   $img->scale(xpixels=>400); # 400x285
1943   $img->scale(ypixels=>400); # 560x400
1944
1945   $img->scale(xpixels=>400,ypixels=>400); # 560x400
1946   $img->scale(xpixels=>400,ypixels=>400,type=>min); # 400x285
1947
1948   $img->scale(scalefactor=>0.25); 175x125 $img->scale(); # 350x250
1949
1950 if you want to create low quality previews of images you can pass
1951 C<qtype=E<gt>'preview'> to scale and it will use nearest neighbor
1952 sampling instead of filtering. It is much faster but also generates
1953 worse looking images - especially if the original has a lot of sharp
1954 variations and the scaled image is by more than 3-5 times smaller than
1955 the original.
1956
1957 If you need to scale images per axis it is best to do it simply by
1958 calling scaleX and scaleY.  You can pass either 'scalefactor' or
1959 'pixels' to both functions.
1960
1961 Another way to resize an image size is to crop it.  The parameters
1962 to crop are the edges of the area that you want in the returned image.
1963 If a parameter is omited a default is used instead.
1964
1965   $newimg = $img->crop(left=>50, right=>100, top=>10, bottom=>100);
1966   $newimg = $img->crop(left=>50, top=>10, width=>50, height=>90);
1967   $newimg = $img->crop(left=>50, right=>100); # top
1968
1969 You can also specify width and height parameters which will produce a
1970 new image cropped from the center of the input image, with the given
1971 width and height.
1972
1973   $newimg = $img->crop(width=>50, height=>50);
1974
1975 The width and height parameters take precedence over the left/right
1976 and top/bottom parameters respectively.
1977
1978 =head2 Copying images
1979
1980 To create a copy of an image use the C<copy()> method.  This is usefull
1981 if you want to keep an original after doing something that changes the image
1982 inplace like writing text.
1983
1984   $img=$orig->copy();
1985
1986 To copy an image to onto another image use the C<paste()> method.
1987
1988   $dest->paste(left=>40,top=>20,img=>$logo);
1989
1990 That copies the entire C<$logo> image onto the C<$dest> image so that the
1991 upper left corner of the C<$logo> image is at (40,20).
1992
1993 =head2 Blending Images
1994
1995 To put an image or a part of an image directly into another it is
1996 best to call the C<paste()> method on the image you want to add to.
1997
1998   $img->paste(img=>$srcimage,left=>30,top=>50);
1999
2000 That will take paste C<$srcimage> into C<$img> with the upper
2001 left corner at (30,50).  If no values are given for C<left>
2002 or C<top> they will default to 0.
2003
2004 A more complicated way of blending images is where one image is
2005 put 'over' the other with a certain amount of opaqueness.  The
2006 method that does this is rubthrough.
2007
2008   $img->rubthrough(src=>$srcimage,tx=>30,ty=>50);
2009
2010 That will take the image C<$srcimage> and overlay it with the
2011 upper left corner at (30,50).  The C<$srcimage> must be a 4 channel
2012 image.  The last channel is used as an alpha channel.
2013
2014
2015 =head2 Filters
2016
2017 A special image method is the filter method. An example is:
2018
2019   $img->filter(type=>'autolevels');
2020
2021 This will call the autolevels filter.  Here is a list of the filters
2022 that are always avaliable in Imager.  This list can be obtained by
2023 running the C<filterlist.perl> script that comes with the module
2024 source.
2025
2026   Filter          Arguments
2027   turbnoise
2028   autolevels      lsat(0.1) usat(0.1) skew(0)
2029   radnoise
2030   noise           amount(3) subtype(0)
2031   contrast        intensity
2032   hardinvert
2033   gradgen         xo yo colors dist
2034
2035 The default values are in parenthesis.  All parameters must have some
2036 value but if a parameter has a default value it may be omitted when
2037 calling the filter function.
2038
2039 FIXME: make a seperate pod for filters?
2040
2041 =head2 Transformations
2042
2043 Another special image method is transform.  It can be used to generate
2044 warps and rotations and such features.  It can be given the operations
2045 in postfix notation or the module Affix::Infix2Postfix can be used.
2046 Look in the test case t/t55trans.t for an example.
2047
2048 transform() needs expressions (or opcodes) that determine the source
2049 pixel for each target pixel.  Source expressions are infix expressions
2050 using any of the +, -, *, / or ** binary operators, the - unary
2051 operator, ( and ) for grouping and the sin() and cos() functions.  The
2052 target pixel is input as the variables x and y.
2053
2054 You specify the x and y expressions as xexpr and yexpr respectively.
2055 You can also specify opcodes directly, but that's magic deep enough
2056 that you can look at the source code.
2057
2058 You can still use the transform() function, but the transform2()
2059 function is just as fast and is more likely to be enhanced and
2060 maintained.
2061
2062 Later versions of Imager also support a transform2() class method
2063 which allows you perform a more general set of operations, rather than
2064 just specifying a spatial transformation as with the transform()
2065 method, you can also perform colour transformations, image synthesis
2066 and image combinations.
2067
2068 transform2() takes an reference to an options hash, and a list of
2069 images to operate one (this list may be empty):
2070
2071   my %opts;
2072   my @imgs;
2073   ...
2074   my $img = Imager::transform2(\%opts, @imgs)
2075       or die "transform2 failed: $Imager::ERRSTR";
2076
2077 The options hash may define a transformation function, and optionally:
2078
2079 =over 4
2080
2081 =item *
2082
2083 width - the width of the image in pixels.  If this isn't supplied the
2084 width of the first input image is used.  If there are no input images
2085 an error occurs.
2086
2087 =item *
2088
2089 height - the height of the image in pixels.  If this isn't supplied
2090 the height of the first input image is used.  If there are no input
2091 images an error occurs.
2092
2093 =item *
2094
2095 constants - a reference to hash of constants to define for the
2096 expression engine.  Some extra constants are defined by Imager
2097
2098 =back
2099
2100 The tranformation function is specified using either the expr or
2101 rpnexpr member of the options.
2102
2103 =over 4
2104
2105 =item Infix expressions
2106
2107 You can supply infix expressions to transform 2 with the expr keyword.
2108
2109 $opts{expr} = 'return getp1(w-x, h-y)'
2110
2111 The 'expression' supplied follows this general grammar:
2112
2113    ( identifier '=' expr ';' )* 'return' expr
2114
2115 This allows you to simplify your expressions using variables.
2116
2117 A more complex example might be:
2118
2119 $opts{expr} = 'pix = getp1(x,y); return if(value(pix)>0.8,pix*0.8,pix)'
2120
2121 Currently to use infix expressions you must have the Parse::RecDescent
2122 module installed (available from CPAN).  There is also what might be a
2123 significant delay the first time you run the infix expression parser
2124 due to the compilation of the expression grammar.
2125
2126 =item Postfix expressions
2127
2128 You can supply postfix or reverse-polish notation expressions to
2129 transform2() through the rpnexpr keyword.
2130
2131 The parser for rpnexpr emulates a stack machine, so operators will
2132 expect to see their parameters on top of the stack.  A stack machine
2133 isn't actually used during the image transformation itself.
2134
2135 You can store the value at the top of the stack in a variable called
2136 foo using !foo and retrieve that value again using @foo.  The !foo
2137 notation will pop the value from the stack.
2138
2139 An example equivalent to the infix expression above:
2140
2141  $opts{rpnexpr} = 'x y getp1 !pix @pix value 0.8 gt @pix 0.8 * @pix ifp'
2142
2143 =back
2144
2145 transform2() has a fairly rich range of operators.
2146
2147 =over 4
2148
2149 =item +, *, -, /, %, **
2150
2151 multiplication, addition, subtraction, division, remainder and
2152 exponentiation.  Multiplication, addition and subtraction can be used
2153 on colour values too - though you need to be careful - adding 2 white
2154 values together and multiplying by 0.5 will give you grey, not white.
2155
2156 Division by zero (or a small number) just results in a large number.
2157 Modulo zero (or a small number) results in zero.
2158
2159 =item sin(N), cos(N), atan2(y,x)
2160
2161 Some basic trig functions.  They work in radians, so you can't just
2162 use the hue values.
2163
2164 =item distance(x1, y1, x2, y2)
2165
2166 Find the distance between two points.  This is handy (along with
2167 atan2()) for producing circular effects.
2168
2169 =item sqrt(n)
2170
2171 Find the square root.  I haven't had much use for this since adding
2172 the distance() function.
2173
2174 =item abs(n)
2175
2176 Find the absolute value.
2177
2178 =item getp1(x,y), getp2(x,y), getp3(x, y)
2179
2180 Get the pixel at position (x,y) from the first, second or third image
2181 respectively.  I may add a getpn() function at some point, but this
2182 prevents static checking of the instructions against the number of
2183 images actually passed in.
2184
2185 =item value(c), hue(c), sat(c), hsv(h,s,v)
2186
2187 Separates a colour value into it's value (brightness), hue (colour)
2188 and saturation elements.  Use hsv() to put them back together (after
2189 suitable manipulation).
2190
2191 =item red(c), green(c), blue(c), rgb(r,g,b)
2192
2193 Separates a colour value into it's red, green and blue colours.  Use
2194 rgb(r,g,b) to put it back together.
2195
2196 =item int(n)
2197
2198 Convert a value to an integer.  Uses a C int cast, so it may break on
2199 large values.
2200
2201 =item if(cond,ntrue,nfalse), if(cond,ctrue,cfalse)
2202
2203 A simple (and inefficient) if function.
2204
2205 =item <=,<,==,>=,>,!=
2206
2207 Relational operators (typically used with if()).  Since we're working
2208 with floating point values the equalities are 'near equalities' - an
2209 epsilon value is used.
2210
2211 =item &&, ||, not(n)
2212
2213 Basic logical operators.
2214
2215 =back
2216
2217 A few examples:
2218
2219 =over 4
2220
2221 =item rpnexpr=>'x 25 % 15 * y 35 % 10 * getp1 !pat x y getp1 !pix @pix sat 0.7 gt @pat @pix ifp'
2222
2223 tiles a smaller version of the input image over itself where the colour has a saturation over 0.7.
2224
2225 =item rpnexpr=>'x 25 % 15 * y 35 % 10 * getp1 !pat y 360 / !rat x y getp1 1 @rat - pmult @pat @rat pmult padd'
2226
2227 tiles the input image over itself so that at the top of the image the
2228 full-size image is at full strength and at the bottom the tiling is
2229 most visible.
2230
2231 =item rpnexpr=>'x y getp1 !pix @pix value 0.96 gt @pix sat 0.1 lt and 128 128 255 rgb @pix ifp'
2232
2233 replace pixels that are white or almost white with a palish blue
2234
2235 =item rpnexpr=>'x 35 % 10 * y 45 % 8 * getp1 !pat x y getp1 !pix @pix sat 0.2 lt @pix value 0.9 gt and @pix @pat @pix value 2 / 0.5 + pmult ifp'
2236
2237 Tiles the input image overitself where the image isn't white or almost
2238 white.
2239
2240 =item rpnexpr=>'x y 160 180 distance !d y 180 - x 160 - atan2 !a @d 10 / @a + 3.1416 2 * % !a2 @a2 180 * 3.1416 / 1 @a2 sin 1 + 2 / hsv'
2241
2242 Produces a spiral.
2243
2244 =item rpnexpr=>'x y 160 180 distance !d y 180 - x 160 - atan2 !a @d 10 / @a + 3.1416 2 * % !a2 @a 180 * 3.1416 / 1 @a2 sin 1 + 2 / hsv'
2245
2246 A spiral built on top of a colour wheel.
2247
2248 =back
2249
2250 For details on expression parsing see L<Imager::Expr>.  For details on
2251 the virtual machine used to transform the images, see
2252 L<Imager::regmach.pod>.
2253
2254 =head2 Plugins
2255
2256 It is possible to add filters to the module without recompiling the
2257 module itself.  This is done by using DSOs (Dynamic shared object)
2258 avaliable on most systems.  This way you can maintain our own filters
2259 and not have to get me to add it, or worse patch every new version of
2260 the Module.  Modules can be loaded AND UNLOADED at runtime.  This
2261 means that you can have a server/daemon thingy that can do something
2262 like:
2263
2264   load_plugin("dynfilt/dyntest.so")  || die "unable to load plugin\n";
2265   %hsh=(a=>35,b=>200,type=>lin_stretch);
2266   $img->filter(%hsh);
2267   unload_plugin("dynfilt/dyntest.so") || die "unable to load plugin\n";
2268   $img->write(type=>'pnm',file=>'testout/t60.jpg')
2269     || die "error in write()\n";
2270
2271 Someone decides that the filter is not working as it should -
2272 dyntest.c modified and recompiled.
2273
2274   load_plugin("dynfilt/dyntest.so") || die "unable to load plugin\n";
2275   $img->filter(%hsh);
2276
2277 An example plugin comes with the module - Please send feedback to
2278 addi@umich.edu if you test this.
2279
2280 Note: This seems to test ok on the following systems:
2281 Linux, Solaris, HPUX, OpenBSD, FreeBSD, TRU64/OSF1, AIX.
2282 If you test this on other systems please let me know.
2283
2284 =head1 BUGS
2285
2286 box, arc, circle do not support antialiasing yet.  arc, is only filled
2287 as of yet.  Some routines do not return $self where they should.  This
2288 affects code like this, C<$img-E<gt>box()-E<gt>arc()> where an object
2289 is expected.
2290
2291 When saving Gif images the program does NOT try to shave of extra
2292 colors if it is possible.  If you specify 128 colors and there are
2293 only 2 colors used - it will have a 128 colortable anyway.
2294
2295 =head1 AUTHOR
2296
2297 Arnar M. Hrafnkelsson, addi@umich.edu
2298 And a great deal of help from others - see the README for a complete
2299 list.
2300 =head1 SEE ALSO
2301
2302 perl(1), Imager::Color(3), Affix::Infix2Postfix(3), Parse::RecDescent(3)
2303 http://www.eecs.umich.edu/~addi/perl/Imager/
2304
2305
2306 =cut