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 sub flip {
 997   my $self  = shift;
 998   my %opts  = @_;
 999   my %xlate = (h=>0, v=>1, hv=>2, vh=>2);
1000   my $dir;
1001   return () unless defined $opts{'dir'} and defined $xlate{$opts{'dir'}};
1002   $dir = $xlate{$opts{'dir'}};
1003   return $self if i_flipxy($self->{IMG}, $dir);
1004   return ();
1005 }
1006
1007
1008
1009 # These two are supported for legacy code only
1010
1011 sub i_color_new {
1012   return Imager::Color->new($_[0], $_[1], $_[2], $_[3]);
1013 }
1014
1015 sub i_color_set {
1016   return Imager::Color::set($_[0], $_[1], $_[2], $_[3], $_[4]);
1017 }
1018
1019
1020
1021 # Draws a box between the specified corner points.
1022
1023 sub box {
1024   my $self=shift;
1025   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1026   my $dflcl=i_color_new(255,255,255,255);
1027   my %opts=(color=>$dflcl,xmin=>0,ymin=>0,xmax=>$self->getwidth()-1,ymax=>$self->getheight()-1,@_);
1028
1029   if (exists $opts{'box'}) {
1030     $opts{'xmin'} = min($opts{'box'}->[0],$opts{'box'}->[2]);
1031     $opts{'xmax'} = max($opts{'box'}->[0],$opts{'box'}->[2]);
1032     $opts{'ymin'} = min($opts{'box'}->[1],$opts{'box'}->[3]);
1033     $opts{'ymax'} = max($opts{'box'}->[1],$opts{'box'}->[3]);
1034   }
1035
1036   if ($opts{filled}) { i_box_filled($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},$opts{ymax},$opts{color}); }
1037   else { i_box($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},$opts{ymax},$opts{color}); }
1038   return $self;
1039 }
1040
1041 # Draws an arc - this routine SUCKS and is buggy - it sometimes doesn't work when the arc is a convex polygon
1042
1043 sub arc {
1044   my $self=shift;
1045   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1046   my $dflcl=i_color_new(255,255,255,255);
1047   my %opts=(color=>$dflcl,
1048             'r'=>min($self->getwidth(),$self->getheight())/3,
1049             'x'=>$self->getwidth()/2,
1050             'y'=>$self->getheight()/2,
1051             'd1'=>0, 'd2'=>361, @_);
1052   i_arc($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},$opts{'d1'},$opts{'d2'},$opts{'color'});
1053   return $self;
1054 }
1055
1056 # Draws a line from one point to (but not including) the destination point
1057
1058 sub line {
1059   my $self=shift;
1060   my $dflcl=i_color_new(0,0,0,0);
1061   my %opts=(color=>$dflcl,@_);
1062   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1063
1064   unless (exists $opts{x1} and exists $opts{y1}) { $self->{ERRSTR}='missing begining coord'; return undef; }
1065   unless (exists $opts{x2} and exists $opts{y2}) { $self->{ERRSTR}='missing ending coord'; return undef; }
1066
1067   if ($opts{antialias}) {
1068     i_line_aa($self->{IMG},$opts{x1}, $opts{y1}, $opts{x2}, $opts{y2}, $opts{color});
1069   } else {
1070     i_draw($self->{IMG},$opts{x1}, $opts{y1}, $opts{x2}, $opts{y2}, $opts{color});
1071   }
1072   return $self;
1073 }
1074
1075 # Draws a line between an ordered set of points - It more or less just transforms this
1076 # into a list of lines.
1077
1078 sub polyline {
1079   my $self=shift;
1080   my ($pt,$ls,@points);
1081   my $dflcl=i_color_new(0,0,0,0);
1082   my %opts=(color=>$dflcl,@_);
1083
1084   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1085
1086   if (exists($opts{points})) { @points=@{$opts{points}}; }
1087   if (!exists($opts{points}) and exists($opts{'x'}) and exists($opts{'y'}) ) {
1088     @points=map { [ $opts{'x'}->[$_],$opts{'y'}->[$_] ] } (0..(scalar @{$opts{'x'}}-1));
1089     }
1090
1091 #  print Dumper(\@points);
1092
1093   if ($opts{antialias}) {
1094     for $pt(@points) {
1095       if (defined($ls)) { i_line_aa($self->{IMG},$ls->[0],$ls->[1],$pt->[0],$pt->[1],$opts{color}); }
1096       $ls=$pt;
1097     }
1098   } else {
1099     for $pt(@points) {
1100       if (defined($ls)) { i_draw($self->{IMG},$ls->[0],$ls->[1],$pt->[0],$pt->[1],$opts{color}); }
1101       $ls=$pt;
1102     }
1103   }
1104   return $self;
1105 }
1106
1107 # this the multipoint bezier curve
1108 # this is here more for testing that actual usage since
1109 # this is not a good algorithm.  Usually the curve would be
1110 # broken into smaller segments and each done individually.
1111
1112 sub polybezier {
1113   my $self=shift;
1114   my ($pt,$ls,@points);
1115   my $dflcl=i_color_new(0,0,0,0);
1116   my %opts=(color=>$dflcl,@_);
1117
1118   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1119
1120   if (exists $opts{points}) {
1121     $opts{'x'}=map { $_->[0]; } @{$opts{'points'}};
1122     $opts{'y'}=map { $_->[1]; } @{$opts{'points'}};
1123   }
1124
1125   unless ( @{$opts{'x'}} and @{$opts{'x'}} == @{$opts{'y'}} ) {
1126     $self->{ERRSTR}='Missing or invalid points.';
1127     return;
1128   }
1129
1130   i_bezier_multi($self->{IMG},$opts{'x'},$opts{'y'},$opts{'color'});
1131   return $self;
1132 }
1133
1134
1135 # destructive border - image is shrunk by one pixel all around
1136
1137 sub border {
1138   my ($self,%opts)=@_;
1139   my($tx,$ty)=($self->getwidth()-1,$self->getheight()-1);
1140   $self->polyline('x'=>[0,$tx,$tx,0,0],'y'=>[0,0,$ty,$ty,0],%opts);
1141 }
1142
1143
1144 # Get the width of an image
1145
1146 sub getwidth {
1147   my $self = shift;
1148   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
1149   return (i_img_info($self->{IMG}))[0];
1150 }
1151
1152 # Get the height of an image
1153
1154 sub getheight {
1155   my $self = shift;
1156   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
1157   return (i_img_info($self->{IMG}))[1];
1158 }
1159
1160 # Get number of channels in an image
1161
1162 sub getchannels {
1163   my $self = shift;
1164   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
1165   return i_img_getchannels($self->{IMG});
1166 }
1167
1168 # Get channel mask
1169
1170 sub getmask {
1171   my $self = shift;
1172   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
1173   return i_img_getmask($self->{IMG});
1174 }
1175
1176 # Set channel mask
1177
1178 sub setmask {
1179   my $self = shift;
1180   my %opts = @_;
1181   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
1182   i_img_setmask( $self->{IMG} , $opts{mask} );
1183 }
1184
1185 # Get number of colors in an image
1186
1187 sub getcolorcount {
1188   my $self=shift;
1189   my %opts=(maxcolors=>2**30,@_);
1190   if (!defined($self->{IMG})) { $self->{ERRSTR}='image is empty'; return undef; }
1191   my $rc=i_count_colors($self->{IMG},$opts{'maxcolors'});
1192   return ($rc==-1? undef : $rc);
1193 }
1194
1195 # draw string to an image
1196
1197 sub string {
1198   my $self = shift;
1199   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1200
1201   my %input=('x'=>0, 'y'=>0, @_);
1202   $input{string}||=$input{text};
1203
1204   unless(exists $input{string}) {
1205     $self->{ERRSTR}="missing required parameter 'string'";
1206     return;
1207   }
1208
1209   unless($input{font}) {
1210     $self->{ERRSTR}="missing required parameter 'font'";
1211     return;
1212   }
1213
1214   my $aa=1;
1215   my $font=$input{'font'};
1216   my $align=$font->{'align'} unless exists $input{'align'};
1217   my $color=$input{'color'} || $font->{'color'};
1218   my $size=$input{'size'}   || $font->{'size'};
1219
1220   if (!defined($size)) { $self->{ERRSTR}='No size parameter and no default in font'; return undef; }
1221
1222   $aa=$font->{'aa'} if exists $font->{'aa'};
1223   $aa=$input{'aa'} if exists $input{'aa'};
1224
1225
1226
1227 #  unless($font->can('text')) {
1228 #    $self->{ERRSTR}="font is unable to do what we need";
1229 #    return;
1230 #  }
1231
1232 #  use Data::Dumper;
1233 #  warn Dumper($font);
1234
1235 #  print "Channel=".$input{'channel'}."\n";
1236
1237   if ( $font->{'type'} eq 't1' ) {
1238     if ( exists $input{'channel'} ) {
1239       Imager::Font::t1_set_aa_level($aa);
1240       i_t1_cp($self->{IMG},$input{'x'},$input{'y'},
1241               $input{'channel'},$font->{'id'},$size,
1242               $input{'string'},length($input{'string'}),1);
1243     } else {
1244       Imager::Font::t1_set_aa_level($aa);
1245       i_t1_text($self->{IMG},$input{'x'},$input{'y'},
1246                 $color,$font->{'id'},$size,
1247                 $input{'string'},length($input{'string'}),1);
1248     }
1249   }
1250
1251   if ( $font->{'type'} eq 'tt' ) {
1252     if ( exists $input{'channel'} ) {
1253       i_tt_cp($font->{'id'},$self->{IMG},$input{'x'},$input{'y'},$input{'channel'},
1254               $size,$input{'string'},length($input{'string'}),$aa);
1255     } else {
1256       i_tt_text($font->{'id'},$self->{IMG},$input{'x'},$input{'y'},$color,$size,
1257                 $input{'string'},length($input{'string'}),$aa);
1258     }
1259   }
1260
1261   return $self;
1262 }
1263
1264
1265
1266
1267
1268 # Shortcuts that can be exported
1269
1270 sub newcolor { Imager::Color->new(@_); }
1271 sub newfont  { Imager::Font->new(@_); }
1272
1273 *NC=*newcolour=*newcolor;
1274 *NF=*newfont;
1275
1276 *open=\&read;
1277 *circle=\&arc;
1278
1279
1280 #### Utility routines
1281
1282 sub errstr { $_[0]->{ERRSTR} }
1283
1284
1285
1286
1287
1288
1289 # Default guess for the type of an image from extension
1290
1291 sub def_guess_type {
1292   my $name=lc(shift);
1293   my $ext;
1294   $ext=($name =~ m/\.([^\.]+)$/)[0];
1295   return 'tiff' if ($ext =~ m/^tiff?$/);
1296   return 'jpeg' if ($ext =~ m/^jpe?g$/);
1297   return 'pnm'  if ($ext =~ m/^p[pgb]m$/);
1298   return 'png'  if ($ext eq "png");
1299   return 'gif'  if ($ext eq "gif");
1300   return ();
1301 }
1302
1303 # get the minimum of a list
1304
1305 sub min {
1306   my $mx=shift;
1307   for(@_) { if ($_<$mx) { $mx=$_; }}
1308   return $mx;
1309 }
1310
1311 # get the maximum of a list
1312
1313 sub max {
1314   my $mx=shift;
1315   for(@_) { if ($_>$mx) { $mx=$_; }}
1316   return $mx;
1317 }
1318
1319 # string stuff for iptc headers
1320
1321 sub clean {
1322   my($str)=$_[0];
1323   $str = substr($str,3);
1324   $str =~ s/[\n\r]//g;
1325   $str =~ s/\s+/ /g;
1326   $str =~ s/^\s//;
1327   $str =~ s/\s$//;
1328   return $str;
1329 }
1330
1331 # A little hack to parse iptc headers.
1332
1333 sub parseiptc {
1334   my $self=shift;
1335   my(@sar,$item,@ar);
1336   my($caption,$photogr,$headln,$credit);
1337
1338   my $str=$self->{IPTCRAW};
1339
1340   #print $str;
1341
1342   @ar=split(/8BIM/,$str);
1343
1344   my $i=0;
1345   foreach (@ar) {
1346     if (/^\004\004/) {
1347       @sar=split(/\034\002/);
1348       foreach $item (@sar) {
1349         if ($item =~ m/^x/) {
1350           $caption=&clean($item);
1351           $i++;
1352         }
1353         if ($item =~ m/^P/) {
1354           $photogr=&clean($item);
1355           $i++;
1356         }
1357         if ($item =~ m/^i/) {
1358           $headln=&clean($item);
1359           $i++;
1360         }
1361         if ($item =~ m/^n/) {
1362           $credit=&clean($item);
1363           $i++;
1364         }
1365       }
1366     }
1367   }
1368   return (caption=>$caption,photogr=>$photogr,headln=>$headln,credit=>$credit);
1369 }
1370
1371
1372
1373
1374
1375
1376 # Autoload methods go after =cut, and are processed by the autosplit program.
1377
1378 1;
1379 __END__
1380 # Below is the stub of documentation for your module. You better edit it!
1381
1382 =head1 NAME
1383
1384 Imager - Perl extension for Generating 24 bit Images
1385
1386 =head1 SYNOPSIS
1387
1388   use Imager qw(init);
1389
1390   init();
1391   $img = Imager->new();
1392   $img->open(file=>'image.ppm',type=>'pnm')
1393     || print "failed: ",$img->{ERRSTR},"\n";
1394   $scaled=$img->scale(xpixels=>400,ypixels=>400);
1395   $scaled->write(file=>'sc_image.ppm',type=>'pnm')
1396     || print "failed: ",$scaled->{ERRSTR},"\n";
1397
1398 =head1 DESCRIPTION
1399
1400 Imager is a module for creating and altering images - It is not meant
1401 as a replacement or a competitor to ImageMagick or GD. Both are
1402 excellent packages and well supported.
1403
1404 =head2 API
1405
1406 Almost all functions take the parameters in the hash fashion.
1407 Example:
1408
1409   $img->open(file=>'lena.png',type=>'png');
1410
1411 or just:
1412
1413   $img->open(file=>'lena.png');
1414
1415 =head2 Basic concept
1416
1417 An Image object is created with C<$img = Imager-E<gt>new()> Should
1418 this fail for some reason an explanation can be found in
1419 C<$Imager::ERRSTR> usually error messages are stored in
1420 C<$img-E<gt>{ERRSTR}>, but since no object is created this is the only
1421 way to give back errors.  C<$Imager::ERRSTR> is also used to report
1422 all errors not directly associated with an image object. Examples:
1423
1424   $img=Imager->new(); # This is an empty image (size is 0 by 0)
1425   $img->open(file=>'lena.png',type=>'png'); # initializes from file
1426
1427 or if you want to create an empty image:
1428
1429   $img=Imager->new(xsize=>400,ysize=>300,channels=>4);
1430
1431 This example creates a completely black image of width 400 and
1432 height 300 and 4 channels.
1433
1434 If you have an existing image, use img_set() to change it's dimensions
1435 - this will destroy any existing image data:
1436
1437   $img->img_set(xsize=>500, ysize=>500, channels=>4);
1438
1439 Color objects are created by calling the Imager::Color->new()
1440 method:
1441
1442   $color = Imager::Color->new($red, $green, $blue);
1443   $color = Imager::Color->new($red, $green, $blue, $alpha);
1444   $color = Imager::Color->new("#C0C0FF"); # html color specification
1445
1446 This object can then be passed to functions that require a color parameter.
1447
1448 Coordinates in Imager have the origin in the upper left corner.  The
1449 horizontal coordinate increases to the right and the vertical
1450 downwards.
1451
1452 =head2 Reading and writing images
1453
1454 C<$img-E<gt>read()> generally takes two parameters, 'file' and 'type'.
1455 If the type of the file can be determined from the suffix of the file
1456 it can be omitted.  Format dependant parameters are: For images of
1457 type 'raw' two extra parameters are needed 'xsize' and 'ysize', if the
1458 'channel' parameter is omitted for type 'raw' it is assumed to be 3.
1459 gif and png images might have a palette are converted to truecolor bit
1460 when read.  Alpha channel is preserved for png images irregardless of
1461 them being in RGB or gray colorspace.  Similarly grayscale jpegs are
1462 one channel images after reading them.  For jpeg images the iptc
1463 header information (stored in the APP13 header) is avaliable to some
1464 degree. You can get the raw header with C<$img-E<gt>{IPTCRAW}>, but
1465 you can also retrieve the most basic information with
1466 C<%hsh=$img-E<gt>parseiptc()> as always patches are welcome.  Neither
1467 pnm nor tiff have extra options. Examples:
1468
1469   $img = Imager->new();
1470   $img->read(file=>"cover.jpg") or die $img->errstr; # gets type from name
1471
1472   $img = Imager->new();
1473   { local(*FH,$/); open(FH,"file.gif") or die $!; $a=<FH>; }
1474   $img->read(data=>$a,type=>'gif') or die $img->errstr;
1475
1476 The second example shows how to read an image from a scalar, this is
1477 usefull if your data originates from somewhere else than a filesystem
1478 such as a database over a DBI connection.
1479
1480 *Note that load() is now an alias for read but will be removed later*
1481
1482 C<$img-E<gt>write> has the same interface as C<read()>.  The earlier
1483 comments on C<read()> for autodetecting filetypes apply.  For jpegs
1484 quality can be adjusted via the 'jpegquality' parameter (0-100).  The
1485 number of colorplanes in gifs are set with 'gifplanes' and should be
1486 between 1 (2 color) and 8 (256 colors).  It is also possible to choose
1487 between two quantizing methods with the parameter 'gifquant'. If set
1488 to mc it uses the mediancut algorithm from either giflibrary. If set
1489 to lm it uses a local means algorithm. It is then possible to give
1490 some extra settings. lmdither is the dither deviation amount in pixels
1491 (manhattan distance).  lmfixed can be an array ref who holds an array
1492 of Imager::Color objects.  Note that the local means algorithm needs
1493 much more cpu time but also gives considerable better results than the
1494 median cut algorithm.
1495
1496 Currently just for gif files, you can specify various options for the
1497 conversion from Imager's internal RGB format to the target's indexed
1498 file format.  If you set the gifquant option to 'gen', you can use the
1499 options specified under L<Quantization options>.
1500
1501 To see what Imager is compiled to support the following code snippet
1502 is sufficient:
1503
1504   use Imager;
1505   print "@{[keys %Imager::formats]}";
1506
1507 When reading raw images you need to supply the width and height of the
1508 image in the xsize and ysize options:
1509
1510   $img->read(file=>'foo.raw', xsize=>100, ysize=>100)
1511     or die "Cannot read raw image\n";
1512
1513 If your input file has more channels than you want, or (as is common),
1514 junk in the fourth channel, you can use the datachannels and
1515 storechannels options to control the number of channels in your input
1516 file and the resulting channels in your image.  For example, if your
1517 input image uses 32-bits per pixel with red, green, blue and junk
1518 values for each pixel you could do:
1519
1520   $img->read(file=>'foo.raw', xsize=>100, ysize=>100, datachannels=>4,
1521              storechannels=>3)
1522     or die "Cannot read raw image\n";
1523
1524 Normally the raw image is expected to have the value for channel 1
1525 immediately following channel 0 and channel 2 immediately following
1526 channel 1 for each pixel.  If your input image has all the channel 0
1527 values for the first line of the image, followed by all the channel 1
1528 values for the first line and so on, you can use the interleave option:
1529
1530   $img->read(file=>'foo.raw', xsize=100, ysize=>100, interleave=>1)
1531     or die "Cannot read raw image\n";
1532
1533 =head2 Multi-image files
1534
1535 Currently just for gif files, you can create files that contain more
1536 than one image.
1537
1538 To do this:
1539
1540   Imager->write_multi(\%opts, @images)
1541
1542 Where %opts describes 3 possible types of outputs:
1543
1544 =over 4
1545
1546 =item callback
1547
1548 A code reference which is called with a single parameter, the data to
1549 be written.  You can also specify $opts{maxbuffer} which is the
1550 maximum amount of data buffered.  Note that there can be larger writes
1551 than this if the file library writes larger blocks.  A smaller value
1552 maybe useful for writing to a socket for incremental display.
1553
1554 =item fd
1555
1556 The file descriptor to save the images to.
1557
1558 =item file
1559
1560 The name of the file to write to.
1561
1562 %opts may also include the keys from L<Gif options> and L<Quantization
1563 options>.
1564
1565 =back
1566
1567 The current aim is to support other multiple image formats in the
1568 future, such as TIFF, and to support reading multiple images from a
1569 single file.
1570
1571 A simple example:
1572
1573     my @images;
1574     # ... code to put images in @images
1575     Imager->write_multi({type=>'gif',
1576                          file=>'anim.gif',
1577                          gif_delays=>[ 10 x @images ] },
1578                         @images)
1579     or die "Oh dear!";
1580
1581 =head2 Gif options
1582
1583 These options can be specified when calling write_multi() for gif
1584 files, when writing a single image with the gifquant option set to
1585 'gen', or for direct calls to i_writegif_gen and i_writegif_callback.
1586
1587 Note that some viewers will ignore some of these options
1588 (gif_user_input in particular).
1589
1590 =over 4
1591
1592 =item gif_each_palette
1593
1594 Each image in the gif file has it's own palette if this is non-zero.
1595 All but the first image has a local colour table (the first uses the
1596 global colour table.
1597
1598 =item interlace
1599
1600 The images are written interlaced if this is non-zero.
1601
1602 =item gif_delays
1603
1604 A reference to an array containing the delays between images, in 1/100
1605 seconds.
1606
1607 =item gif_user_input
1608
1609 A reference to an array contains user input flags.  If the given flag
1610 is non-zero the image viewer should wait for input before displaying
1611 the next image.
1612
1613 =item gif_disposal
1614
1615 A reference to an array of image disposal methods.  These define what
1616 should be done to the image before displaying the next one.  These are
1617 integers, where 0 means unspecified, 1 means the image should be left
1618 in place, 2 means restore to background colour and 3 means restore to
1619 the previous value.
1620
1621 =item gif_tran_color
1622
1623 A reference to an Imager::Color object, which is the colour to use for
1624 the palette entry used to represent transparency in the palette.  You
1625 need to set the transp option (see L<Quantization options>) for this
1626 value to be used.
1627
1628 =item gif_positions
1629
1630 A reference to an array of references to arrays which represent screen
1631 positions for each image.
1632
1633 =item gif_loop_count
1634
1635 If this is non-zero the Netscape loop extension block is generated,
1636 which makes the animation of the images repeat.
1637
1638 This is currently unimplemented due to some limitations in giflib.
1639
1640 =back
1641
1642 =head2 Quantization options
1643
1644 These options can be specified when calling write_multi() for gif
1645 files, when writing a single image with the gifquant option set to
1646 'gen', or for direct calls to i_writegif_gen and i_writegif_callback.
1647
1648 =over 4
1649
1650 =item colors
1651
1652 A arrayref of colors that are fixed.  Note that some color generators
1653 will ignore this.
1654
1655 =item transp
1656
1657 The type of transparency processing to perform for images with an
1658 alpha channel where the output format does not have a proper alpha
1659 channel (eg. gif).  This can be any of:
1660
1661 =over 4
1662
1663 =item none
1664
1665 No transparency processing is done. (default)
1666
1667 =item threshold
1668
1669 Pixels more transparent that tr_threshold are rendered as transparent.
1670
1671 =item errdiff
1672
1673 An error diffusion dither is done on the alpha channel.  Note that
1674 this is independent of the translation performed on the colour
1675 channels, so some combinations may cause undesired artifacts.
1676
1677 =item ordered
1678
1679 The ordered dither specified by tr_orddith is performed on the alpha
1680 channel.
1681
1682 =back
1683
1684 This will only be used if the image has an alpha channel, and if there
1685 is space in the palette for a transparency colour.
1686
1687 =item tr_threshold
1688
1689 The highest alpha value at which a pixel will be made transparent when
1690 transp is 'threshold'. (0-255, default 127)
1691
1692 =item tr_errdiff
1693
1694 The type of error diffusion to perform on the alpha channel when
1695 transp is 'errdiff'.  This can be any defined error diffusion type
1696 except for custom (see errdiff below).
1697
1698 =item tr_orddith
1699
1700 The type of ordered dither to perform on the alpha channel when transp
1701 is 'ordered'.  Possible values are:
1702
1703 =over 4
1704
1705 =item random
1706
1707 A semi-random map is used.  The map is the same each time.
1708
1709 =item dot8
1710
1711 8x8 dot dither.
1712
1713 =item dot4
1714
1715 4x4 dot dither
1716
1717 =item hline
1718
1719 horizontal line dither.
1720
1721 =item vline
1722
1723 vertical line dither.
1724
1725 =item "/line"
1726
1727 =item slashline
1728
1729 diagonal line dither
1730
1731 =item '\line'
1732
1733 =item backline
1734
1735 diagonal line dither
1736
1737 =item tiny
1738
1739 dot matrix dither (currently the default).  This is probably the best
1740 for displays (like web pages).
1741
1742 =item custom
1743
1744 A custom dither matrix is used - see tr_map
1745
1746 =back
1747
1748 =item tr_map
1749
1750 When tr_orddith is custom this defines an 8 x 8 matrix of integers
1751 representing the transparency threshold for pixels corresponding to
1752 each position.  This should be a 64 element array where the first 8
1753 entries correspond to the first row of the matrix.  Values should be
1754 betweern 0 and 255.
1755
1756 =item make_colors
1757
1758 Defines how the quantization engine will build the palette(s).
1759 Currently this is ignored if 'translate' is 'giflib', but that may
1760 change.  Possible values are:
1761
1762 =over 4
1763
1764 =item none
1765
1766 Only colors supplied in 'colors' are used.
1767
1768 =item webmap
1769
1770 The web color map is used (need url here.)
1771
1772 =item addi
1773
1774 The original code for generating the color map (Addi's code) is used.
1775
1776 =back
1777
1778 Other methods may be added in the future.
1779
1780 =item colors
1781
1782 A arrayref containing Imager::Color objects, which represents the
1783 starting set of colors to use in translating the images.  webmap will
1784 ignore this.  The final colors used are copied back into this array
1785 (which is expanded if necessary.)
1786
1787 =item max_colors
1788
1789 The maximum number of colors to use in the image.
1790
1791 =item translate
1792
1793 The method used to translate the RGB values in the source image into
1794 the colors selected by make_colors.  Note that make_colors is ignored
1795 whene translate is 'giflib'.
1796
1797 Possible values are:
1798
1799 =over 4
1800
1801 =item giflib
1802
1803 The giflib native quantization function is used.
1804
1805 =item closest
1806
1807 The closest color available is used.
1808
1809 =item perturb
1810
1811 The pixel color is modified by perturb, and the closest color is chosen.
1812
1813 =item errdiff
1814
1815 An error diffusion dither is performed.
1816
1817 =back
1818
1819 It's possible other transate values will be added.
1820
1821 =item errdiff
1822
1823 The type of error diffusion dither to perform.  These values (except
1824 for custom) can also be used in tr_errdif.
1825
1826 =over 4
1827
1828 =item floyd
1829
1830 Floyd-Steinberg dither
1831
1832 =item jarvis
1833
1834 Jarvis, Judice and Ninke dither
1835
1836 =item stucki
1837
1838 Stucki dither
1839
1840 =item custom
1841
1842 Custom.  If you use this you must also set errdiff_width,
1843 errdiff_height and errdiff_map.
1844
1845 =back
1846
1847 =item errdiff_width
1848
1849 =item errdiff_height
1850
1851 =item errdiff_orig
1852
1853 =item errdiff_map
1854
1855 When translate is 'errdiff' and errdiff is 'custom' these define a
1856 custom error diffusion map.  errdiff_width and errdiff_height define
1857 the size of the map in the arrayref in errdiff_map.  errdiff_orig is
1858 an integer which indicates the current pixel position in the top row
1859 of the map.
1860
1861 =item perturb
1862
1863 When translate is 'perturb' this is the magnitude of the random bias
1864 applied to each channel of the pixel before it is looked up in the
1865 color table.
1866
1867 =back
1868
1869 =head2 Obtaining/setting attributes of images
1870
1871 To get the size of an image in pixels the C<$img-E<gt>getwidth()> and
1872 C<$img-E<gt>getheight()> are used.
1873
1874 To get the number of channels in
1875 an image C<$img-E<gt>getchannels()> is used.  $img-E<gt>getmask() and
1876 $img-E<gt>setmask() are used to get/set the channel mask of the image.
1877
1878   $mask=$img->getmask();
1879   $img->setmask(mask=>1+2); # modify red and green only
1880   $img->setmask(mask=>8); # modify alpha only
1881   $img->setmask(mask=>$mask); # restore previous mask
1882
1883 The mask of an image describes which channels are updated when some
1884 operation is performed on an image.  Naturally it is not possible to
1885 apply masks to operations like scaling that alter the dimensions of
1886 images.
1887
1888 It is possible to have Imager find the number of colors in an image
1889 by using C<$img-E<gt>getcolorcount()>. It requires memory proportionally
1890 to the number of colors in the image so it is possible to have it
1891 stop sooner if you only need to know if there are more than a certain number
1892 of colors in the image.  If there are more colors than asked for
1893 the function return undef.  Examples:
1894
1895   if (!defined($img->getcolorcount(maxcolors=>512)) {
1896     print "Less than 512 colors in image\n";
1897   }
1898
1899 =head2 Drawing Methods
1900
1901 IMPLEMENTATION MORE OR LESS DONE CHECK THE TESTS
1902 DOCUMENTATION OF THIS SECTION OUT OF SYNC
1903
1904 It is possible to draw with graphics primitives onto images.  Such
1905 primitives include boxes, arcs, circles and lines.  A reference
1906 oriented list follows.
1907
1908 Box:
1909   $img->box(color=>$blue,xmin=>10,ymin=>30,xmax=>200,ymax=>300,filled=>1);
1910
1911 The above example calls the C<box> method for the image and the box
1912 covers the pixels with in the rectangle specified.  If C<filled> is
1913 ommited it is drawn as an outline.  If any of the edges of the box are
1914 ommited it will snap to the outer edge of the image in that direction.
1915 Also if a color is omitted a color with (255,255,255,255) is used
1916 instead.
1917
1918 Arc:
1919   $img->arc(color=>$red, r=20, x=>200, y=>100, d1=>10, d2=>20 );
1920
1921 This creates a filled red arc with a 'center' at (200, 100) and spans
1922 10 degrees and the slice has a radius of 20. SEE section on BUGS.
1923
1924 Circle:
1925   $img->circle(color=>$green, r=50, x=>200, y=>100);
1926
1927 This creates a green circle with its center at (200, 100) and has a
1928 radius of 20.
1929
1930 Line:
1931   $img->line(color=>$green, x1=10, x2=>100,
1932                             y1=>20, y2=>50, antialias=>1 );
1933
1934 That draws an antialiased line from (10,100) to (20,50).
1935
1936 Polyline:
1937   $img->polyline(points=>[[$x0,$y0],[$x1,$y1],[$x2,$y2]],color=>$red);
1938   $img->polyline(x=>[$x0,$x1,$x2], y=>[$y0,$y1,$y2], antialias=>1);
1939
1940 Polyline is used to draw multilple lines between a series of points.
1941 The point set can either be specified as an arrayref to an array of
1942 array references (where each such array represents a point).  The
1943 other way is to specify two array references.
1944
1945 =head2 Text rendering
1946
1947 Text rendering is described in the Imager::Font manpage.
1948
1949 =head2 Image resizing
1950
1951 To scale an image so porportions are maintained use the
1952 C<$img-E<gt>scale()> method.  if you give either a xpixels or ypixels
1953 parameter they will determine the width or height respectively.  If
1954 both are given the one resulting in a larger image is used.  example:
1955 C<$img> is 700 pixels wide and 500 pixels tall.
1956
1957   $img->scale(xpixels=>400); # 400x285
1958   $img->scale(ypixels=>400); # 560x400
1959
1960   $img->scale(xpixels=>400,ypixels=>400); # 560x400
1961   $img->scale(xpixels=>400,ypixels=>400,type=>min); # 400x285
1962
1963   $img->scale(scalefactor=>0.25); 175x125 $img->scale(); # 350x250
1964
1965 if you want to create low quality previews of images you can pass
1966 C<qtype=E<gt>'preview'> to scale and it will use nearest neighbor
1967 sampling instead of filtering. It is much faster but also generates
1968 worse looking images - especially if the original has a lot of sharp
1969 variations and the scaled image is by more than 3-5 times smaller than
1970 the original.
1971
1972 If you need to scale images per axis it is best to do it simply by
1973 calling scaleX and scaleY.  You can pass either 'scalefactor' or
1974 'pixels' to both functions.
1975
1976 Another way to resize an image size is to crop it.  The parameters
1977 to crop are the edges of the area that you want in the returned image.
1978 If a parameter is omited a default is used instead.
1979
1980   $newimg = $img->crop(left=>50, right=>100, top=>10, bottom=>100);
1981   $newimg = $img->crop(left=>50, top=>10, width=>50, height=>90);
1982   $newimg = $img->crop(left=>50, right=>100); # top
1983
1984 You can also specify width and height parameters which will produce a
1985 new image cropped from the center of the input image, with the given
1986 width and height.
1987
1988   $newimg = $img->crop(width=>50, height=>50);
1989
1990 The width and height parameters take precedence over the left/right
1991 and top/bottom parameters respectively.
1992
1993 =head2 Copying images
1994
1995 To create a copy of an image use the C<copy()> method.  This is usefull
1996 if you want to keep an original after doing something that changes the image
1997 inplace like writing text.
1998
1999   $img=$orig->copy();
2000
2001 To copy an image to onto another image use the C<paste()> method.
2002
2003   $dest->paste(left=>40,top=>20,img=>$logo);
2004
2005 That copies the entire C<$logo> image onto the C<$dest> image so that the
2006 upper left corner of the C<$logo> image is at (40,20).
2007
2008
2009 =head2 Flipping images
2010
2011 An inplace horizontal or vertical flip is possible by calling the
2012 C<flip()> method.  If the original is to be preserved it's possible to
2013 make a copy first.  The only parameter it takes is the C<dir>
2014 parameter which can take the values C<h>, C<v>, C<vh> and C<hv>.
2015
2016   $img->flip(dir=>"h");       # horizontal flip
2017   $img->flip(dir=>"vh");      # vertical and horizontal flip
2018   $nimg = $img->copy->flip(dir=>"v"); # make a copy and flip it vertically
2019
2020 =head2 Blending Images
2021
2022 To put an image or a part of an image directly
2023 into another it is best to call the C<paste()> method on the image you
2024 want to add to.
2025
2026   $img->paste(img=>$srcimage,left=>30,top=>50);
2027
2028 That will take paste C<$srcimage> into C<$img> with the upper
2029 left corner at (30,50).  If no values are given for C<left>
2030 or C<top> they will default to 0.
2031
2032 A more complicated way of blending images is where one image is
2033 put 'over' the other with a certain amount of opaqueness.  The
2034 method that does this is rubthrough.
2035
2036   $img->rubthrough(src=>$srcimage,tx=>30,ty=>50);
2037
2038 That will take the image C<$srcimage> and overlay it with the
2039 upper left corner at (30,50).  The C<$srcimage> must be a 4 channel
2040 image.  The last channel is used as an alpha channel.
2041
2042
2043 =head2 Filters
2044
2045 A special image method is the filter method. An example is:
2046
2047   $img->filter(type=>'autolevels');
2048
2049 This will call the autolevels filter.  Here is a list of the filters
2050 that are always avaliable in Imager.  This list can be obtained by
2051 running the C<filterlist.perl> script that comes with the module
2052 source.
2053
2054   Filter          Arguments
2055   turbnoise
2056   autolevels      lsat(0.1) usat(0.1) skew(0)
2057   radnoise
2058   noise           amount(3) subtype(0)
2059   contrast        intensity
2060   hardinvert
2061   gradgen         xo yo colors dist
2062
2063 The default values are in parenthesis.  All parameters must have some
2064 value but if a parameter has a default value it may be omitted when
2065 calling the filter function.
2066
2067 FIXME: make a seperate pod for filters?
2068
2069 =head2 Transformations
2070
2071 Another special image method is transform.  It can be used to generate
2072 warps and rotations and such features.  It can be given the operations
2073 in postfix notation or the module Affix::Infix2Postfix can be used.
2074 Look in the test case t/t55trans.t for an example.
2075
2076 transform() needs expressions (or opcodes) that determine the source
2077 pixel for each target pixel.  Source expressions are infix expressions
2078 using any of the +, -, *, / or ** binary operators, the - unary
2079 operator, ( and ) for grouping and the sin() and cos() functions.  The
2080 target pixel is input as the variables x and y.
2081
2082 You specify the x and y expressions as xexpr and yexpr respectively.
2083 You can also specify opcodes directly, but that's magic deep enough
2084 that you can look at the source code.
2085
2086 You can still use the transform() function, but the transform2()
2087 function is just as fast and is more likely to be enhanced and
2088 maintained.
2089
2090 Later versions of Imager also support a transform2() class method
2091 which allows you perform a more general set of operations, rather than
2092 just specifying a spatial transformation as with the transform()
2093 method, you can also perform colour transformations, image synthesis
2094 and image combinations.
2095
2096 transform2() takes an reference to an options hash, and a list of
2097 images to operate one (this list may be empty):
2098
2099   my %opts;
2100   my @imgs;
2101   ...
2102   my $img = Imager::transform2(\%opts, @imgs)
2103       or die "transform2 failed: $Imager::ERRSTR";
2104
2105 The options hash may define a transformation function, and optionally:
2106
2107 =over 4
2108
2109 =item *
2110
2111 width - the width of the image in pixels.  If this isn't supplied the
2112 width of the first input image is used.  If there are no input images
2113 an error occurs.
2114
2115 =item *
2116
2117 height - the height of the image in pixels.  If this isn't supplied
2118 the height of the first input image is used.  If there are no input
2119 images an error occurs.
2120
2121 =item *
2122
2123 constants - a reference to hash of constants to define for the
2124 expression engine.  Some extra constants are defined by Imager
2125
2126 =back
2127
2128 The tranformation function is specified using either the expr or
2129 rpnexpr member of the options.
2130
2131 =over 4
2132
2133 =item Infix expressions
2134
2135 You can supply infix expressions to transform 2 with the expr keyword.
2136
2137 $opts{expr} = 'return getp1(w-x, h-y)'
2138
2139 The 'expression' supplied follows this general grammar:
2140
2141    ( identifier '=' expr ';' )* 'return' expr
2142
2143 This allows you to simplify your expressions using variables.
2144
2145 A more complex example might be:
2146
2147 $opts{expr} = 'pix = getp1(x,y); return if(value(pix)>0.8,pix*0.8,pix)'
2148
2149 Currently to use infix expressions you must have the Parse::RecDescent
2150 module installed (available from CPAN).  There is also what might be a
2151 significant delay the first time you run the infix expression parser
2152 due to the compilation of the expression grammar.
2153
2154 =item Postfix expressions
2155
2156 You can supply postfix or reverse-polish notation expressions to
2157 transform2() through the rpnexpr keyword.
2158
2159 The parser for rpnexpr emulates a stack machine, so operators will
2160 expect to see their parameters on top of the stack.  A stack machine
2161 isn't actually used during the image transformation itself.
2162
2163 You can store the value at the top of the stack in a variable called
2164 foo using !foo and retrieve that value again using @foo.  The !foo
2165 notation will pop the value from the stack.
2166
2167 An example equivalent to the infix expression above:
2168
2169  $opts{rpnexpr} = 'x y getp1 !pix @pix value 0.8 gt @pix 0.8 * @pix ifp'
2170
2171 =back
2172
2173 transform2() has a fairly rich range of operators.
2174
2175 =over 4
2176
2177 =item +, *, -, /, %, **
2178
2179 multiplication, addition, subtraction, division, remainder and
2180 exponentiation.  Multiplication, addition and subtraction can be used
2181 on colour values too - though you need to be careful - adding 2 white
2182 values together and multiplying by 0.5 will give you grey, not white.
2183
2184 Division by zero (or a small number) just results in a large number.
2185 Modulo zero (or a small number) results in zero.
2186
2187 =item sin(N), cos(N), atan2(y,x)
2188
2189 Some basic trig functions.  They work in radians, so you can't just
2190 use the hue values.
2191
2192 =item distance(x1, y1, x2, y2)
2193
2194 Find the distance between two points.  This is handy (along with
2195 atan2()) for producing circular effects.
2196
2197 =item sqrt(n)
2198
2199 Find the square root.  I haven't had much use for this since adding
2200 the distance() function.
2201
2202 =item abs(n)
2203
2204 Find the absolute value.
2205
2206 =item getp1(x,y), getp2(x,y), getp3(x, y)
2207
2208 Get the pixel at position (x,y) from the first, second or third image
2209 respectively.  I may add a getpn() function at some point, but this
2210 prevents static checking of the instructions against the number of
2211 images actually passed in.
2212
2213 =item value(c), hue(c), sat(c), hsv(h,s,v)
2214
2215 Separates a colour value into it's value (brightness), hue (colour)
2216 and saturation elements.  Use hsv() to put them back together (after
2217 suitable manipulation).
2218
2219 =item red(c), green(c), blue(c), rgb(r,g,b)
2220
2221 Separates a colour value into it's red, green and blue colours.  Use
2222 rgb(r,g,b) to put it back together.
2223
2224 =item int(n)
2225
2226 Convert a value to an integer.  Uses a C int cast, so it may break on
2227 large values.
2228
2229 =item if(cond,ntrue,nfalse), if(cond,ctrue,cfalse)
2230
2231 A simple (and inefficient) if function.
2232
2233 =item <=,<,==,>=,>,!=
2234
2235 Relational operators (typically used with if()).  Since we're working
2236 with floating point values the equalities are 'near equalities' - an
2237 epsilon value is used.
2238
2239 =item &&, ||, not(n)
2240
2241 Basic logical operators.
2242
2243 =back
2244
2245 A few examples:
2246
2247 =over 4
2248
2249 =item rpnexpr=>'x 25 % 15 * y 35 % 10 * getp1 !pat x y getp1 !pix @pix sat 0.7 gt @pat @pix ifp'
2250
2251 tiles a smaller version of the input image over itself where the colour has a saturation over 0.7.
2252
2253 =item rpnexpr=>'x 25 % 15 * y 35 % 10 * getp1 !pat y 360 / !rat x y getp1 1 @rat - pmult @pat @rat pmult padd'
2254
2255 tiles the input image over itself so that at the top of the image the
2256 full-size image is at full strength and at the bottom the tiling is
2257 most visible.
2258
2259 =item rpnexpr=>'x y getp1 !pix @pix value 0.96 gt @pix sat 0.1 lt and 128 128 255 rgb @pix ifp'
2260
2261 replace pixels that are white or almost white with a palish blue
2262
2263 =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'
2264
2265 Tiles the input image overitself where the image isn't white or almost
2266 white.
2267
2268 =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'
2269
2270 Produces a spiral.
2271
2272 =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'
2273
2274 A spiral built on top of a colour wheel.
2275
2276 =back
2277
2278 For details on expression parsing see L<Imager::Expr>.  For details on
2279 the virtual machine used to transform the images, see
2280 L<Imager::regmach.pod>.
2281
2282 =head2 Plugins
2283
2284 It is possible to add filters to the module without recompiling the
2285 module itself.  This is done by using DSOs (Dynamic shared object)
2286 avaliable on most systems.  This way you can maintain our own filters
2287 and not have to get me to add it, or worse patch every new version of
2288 the Module.  Modules can be loaded AND UNLOADED at runtime.  This
2289 means that you can have a server/daemon thingy that can do something
2290 like:
2291
2292   load_plugin("dynfilt/dyntest.so")  || die "unable to load plugin\n";
2293   %hsh=(a=>35,b=>200,type=>lin_stretch);
2294   $img->filter(%hsh);
2295   unload_plugin("dynfilt/dyntest.so") || die "unable to load plugin\n";
2296   $img->write(type=>'pnm',file=>'testout/t60.jpg')
2297     || die "error in write()\n";
2298
2299 Someone decides that the filter is not working as it should -
2300 dyntest.c modified and recompiled.
2301
2302   load_plugin("dynfilt/dyntest.so") || die "unable to load plugin\n";
2303   $img->filter(%hsh);
2304
2305 An example plugin comes with the module - Please send feedback to
2306 addi@umich.edu if you test this.
2307
2308 Note: This seems to test ok on the following systems:
2309 Linux, Solaris, HPUX, OpenBSD, FreeBSD, TRU64/OSF1, AIX.
2310 If you test this on other systems please let me know.
2311
2312 =head1 BUGS
2313
2314 box, arc, circle do not support antialiasing yet.  arc, is only filled
2315 as of yet.  Some routines do not return $self where they should.  This
2316 affects code like this, C<$img-E<gt>box()-E<gt>arc()> where an object
2317 is expected.
2318
2319 When saving Gif images the program does NOT try to shave of extra
2320 colors if it is possible.  If you specify 128 colors and there are
2321 only 2 colors used - it will have a 128 colortable anyway.
2322
2323 =head1 AUTHOR
2324
2325 Arnar M. Hrafnkelsson, addi@umich.edu
2326 And a great deal of help from others - see the README for a complete
2327 list.
2328 =head1 SEE ALSO
2329
2330 perl(1), Imager::Color(3), Affix::Infix2Postfix(3), Parse::RecDescent(3)
2331 http://www.eecs.umich.edu/~addi/perl/Imager/
2332
2333
2334 =cut