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}='unable to read gif image'; 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}='unable to write gif image'; 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 =head2 Multi-image files
1496
1497 Currently just for gif files, you can create files that contain more
1498 than one image.
1499
1500 To do this:
1501
1502   Imager->write_multi(\%opts, @images)
1503
1504 Where %opts describes 3 possible types of outputs:
1505
1506 =over 4
1507
1508 =item callback
1509
1510 A code reference which is called with a single parameter, the data to
1511 be written.  You can also specify $opts{maxbuffer} which is the
1512 maximum amount of data buffered.  Note that there can be larger writes
1513 than this if the file library writes larger blocks.  A smaller value
1514 maybe useful for writing to a socket for incremental display.
1515
1516 =item fd
1517
1518 The file descriptor to save the images to.
1519
1520 =item file
1521
1522 The name of the file to write to.
1523
1524 %opts may also include the keys from L<Gif options> and L<Quantization
1525 options>.
1526
1527 =back
1528
1529 The current aim is to support other multiple image formats in the
1530 future, such as TIFF, and to support reading multiple images from a
1531 single file.
1532
1533 A simple example:
1534
1535     my @images;
1536     # ... code to put images in @images
1537     Imager->write_multi({type=>'gif',
1538                          file=>'anim.gif',
1539                          gif_delays=>[ 10 x @images ] },
1540                         @images)
1541     or die "Oh dear!";
1542
1543 =head2 Gif options
1544
1545 These options can be specified when calling write_multi() for gif
1546 files, when writing a single image with the gifquant option set to
1547 'gen', or for direct calls to i_writegif_gen and i_writegif_callback.
1548
1549 Note that some viewers will ignore some of these options
1550 (gif_user_input in particular).
1551
1552 =over 4
1553
1554 =item gif_each_palette
1555
1556 Each image in the gif file has it's own palette if this is non-zero.
1557 All but the first image has a local colour table (the first uses the
1558 global colour table.
1559
1560 =item interlace
1561
1562 The images are written interlaced if this is non-zero.
1563
1564 =item gif_delays
1565
1566 A reference to an array containing the delays between images, in 1/100
1567 seconds.
1568
1569 =item gif_user_input
1570
1571 A reference to an array contains user input flags.  If the given flag
1572 is non-zero the image viewer should wait for input before displaying
1573 the next image.
1574
1575 =item gif_disposal
1576
1577 A reference to an array of image disposal methods.  These define what
1578 should be done to the image before displaying the next one.  These are
1579 integers, where 0 means unspecified, 1 means the image should be left
1580 in place, 2 means restore to background colour and 3 means restore to
1581 the previous value.
1582
1583 =item gif_tran_color
1584
1585 A reference to an Imager::Color object, which is the colour to use for
1586 the palette entry used to represent transparency in the palette.  You
1587 need to set the transp option (see L<Quantization options>) for this
1588 value to be used.
1589
1590 =item gif_positions
1591
1592 A reference to an array of references to arrays which represent screen
1593 positions for each image.
1594
1595 =item gif_loop_count
1596
1597 If this is non-zero the Netscape loop extension block is generated,
1598 which makes the animation of the images repeat.
1599
1600 This is currently unimplemented due to some limitations in giflib.
1601
1602 =back
1603
1604 =head2 Quantization options
1605
1606 These options can be specified when calling write_multi() for gif
1607 files, when writing a single image with the gifquant option set to
1608 'gen', or for direct calls to i_writegif_gen and i_writegif_callback.
1609
1610 =over 4
1611
1612 =item colors
1613
1614 A arrayref of colors that are fixed.  Note that some color generators
1615 will ignore this.
1616
1617 =item transp
1618
1619 The type of transparency processing to perform for images with an
1620 alpha channel where the output format does not have a proper alpha
1621 channel (eg. gif).  This can be any of:
1622
1623 =over 4
1624
1625 =item none
1626
1627 No transparency processing is done. (default)
1628
1629 =item threshold
1630
1631 Pixels more transparent that tr_threshold are rendered as transparent.
1632
1633 =item errdiff
1634
1635 An error diffusion dither is done on the alpha channel.  Note that
1636 this is independent of the translation performed on the colour
1637 channels, so some combinations may cause undesired artifacts.
1638
1639 =item ordered
1640
1641 The ordered dither specified by tr_orddith is performed on the alpha
1642 channel.
1643
1644 =back
1645
1646 This will only be used if the image has an alpha channel, and if there
1647 is space in the palette for a transparency colour.
1648
1649 =item tr_threshold
1650
1651 The highest alpha value at which a pixel will be made transparent when
1652 transp is 'threshold'. (0-255, default 127)
1653
1654 =item tr_errdiff
1655
1656 The type of error diffusion to perform on the alpha channel when
1657 transp is 'errdiff'.  This can be any defined error diffusion type
1658 except for custom (see errdiff below).
1659
1660 =item tr_orddith
1661
1662 The type of ordered dither to perform on the alpha channel when transp
1663 is 'ordered'.  Possible values are:
1664
1665 =over 4
1666
1667 =item random
1668
1669 A semi-random map is used.  The map is the same each time.  Currently
1670 the default (which may change.)
1671
1672 =item dot8
1673
1674 8x8 dot dither.
1675
1676 =item dot4
1677
1678 4x4 dot dither
1679
1680 =item hline
1681
1682 horizontal line dither.
1683
1684 =item vline
1685
1686 vertical line dither.
1687
1688 =item "/line"
1689
1690 =item slashline
1691
1692 diagonal line dither
1693
1694 =item '\line'
1695
1696 =item backline
1697
1698 diagonal line dither
1699
1700 =item custom
1701
1702 A custom dither matrix is used - see tr_map
1703
1704 =back
1705
1706 =item tr_map
1707
1708 When tr_orddith is custom this defines an 8 x 8 matrix of integers
1709 representing the transparency threshold for pixels corresponding to
1710 each position.  This should be a 64 element array where the first 8
1711 entries correspond to the first row of the matrix.  Values should be
1712 betweern 0 and 255.
1713
1714 =item make_colors
1715
1716 Defines how the quantization engine will build the palette(s).
1717 Currently this is ignored if 'translate' is 'giflib', but that may
1718 change.  Possible values are:
1719
1720 =over 4
1721
1722 =item none
1723
1724 Only colors supplied in 'colors' are used.
1725
1726 =item webmap
1727
1728 The web color map is used (need url here.)
1729
1730 =item addi
1731
1732 The original code for generating the color map (Addi's code) is used.
1733
1734 =back
1735
1736 Other methods may be added in the future.
1737
1738 =item colors
1739
1740 A arrayref containing Imager::Color objects, which represents the
1741 starting set of colors to use in translating the images.  webmap will
1742 ignore this.  The final colors used are copied back into this array
1743 (which is expanded if necessary.)
1744
1745 =item max_colors
1746
1747 The maximum number of colors to use in the image.
1748
1749 =item translate
1750
1751 The method used to translate the RGB values in the source image into
1752 the colors selected by make_colors.  Note that make_colors is ignored
1753 whene translate is 'giflib'.
1754
1755 Possible values are:
1756
1757 =over 4
1758
1759 =item giflib
1760
1761 The giflib native quantization function is used.
1762
1763 =item closest
1764
1765 The closest color available is used.
1766
1767 =item perturb
1768
1769 The pixel color is modified by perturb, and the closest color is chosen.
1770
1771 =item errdiff
1772
1773 An error diffusion dither is performed.
1774
1775 =back
1776
1777 It's possible other transate values will be added.
1778
1779 =item errdiff
1780
1781 The type of error diffusion dither to perform.  These values (except
1782 for custom) can also be used in tr_errdif.
1783
1784 =over 4
1785
1786 =item floyd
1787
1788 Floyd-Steinberg dither
1789
1790 =item jarvis
1791
1792 Jarvis, Judice and Ninke dither
1793
1794 =item stucki
1795
1796 Stucki dither
1797
1798 =item custom
1799
1800 Custom.  If you use this you must also set errdiff_width,
1801 errdiff_height and errdiff_map.
1802
1803 =back
1804
1805 =item errdiff_width
1806
1807 =item errdiff_height
1808
1809 =item errdiff_orig
1810
1811 =item errdiff_map
1812
1813 When translate is 'errdiff' and errdiff is 'custom' these define a
1814 custom error diffusion map.  errdiff_width and errdiff_height define
1815 the size of the map in the arrayref in errdiff_map.  errdiff_orig is
1816 an integer which indicates the current pixel position in the top row
1817 of the map.
1818
1819 =item perturb
1820
1821 When translate is 'perturb' this is the magnitude of the random bias
1822 applied to each channel of the pixel before it is looked up in the
1823 color table.
1824
1825 =back
1826
1827 =head2 Obtaining/setting attributes of images
1828
1829 To get the size of an image in pixels the C<$img-E<gt>getwidth()> and
1830 C<$img-E<gt>getheight()> are used.
1831
1832 To get the number of channels in
1833 an image C<$img-E<gt>getchannels()> is used.  $img-E<gt>getmask() and
1834 $img-E<gt>setmask() are used to get/set the channel mask of the image.
1835
1836   $mask=$img->getmask();
1837   $img->setmask(mask=>1+2); # modify red and green only
1838   $img->setmask(mask=>8); # modify alpha only
1839   $img->setmask(mask=>$mask); # restore previous mask
1840
1841 The mask of an image describes which channels are updated when some
1842 operation is performed on an image.  Naturally it is not possible to
1843 apply masks to operations like scaling that alter the dimensions of
1844 images.
1845
1846 It is possible to have Imager find the number of colors in an image
1847 by using C<$img-E<gt>getcolorcount()>. It requires memory proportionally
1848 to the number of colors in the image so it is possible to have it
1849 stop sooner if you only need to know if there are more than a certain number
1850 of colors in the image.  If there are more colors than asked for
1851 the function return undef.  Examples:
1852
1853   if (!defined($img->getcolorcount(maxcolors=>512)) {
1854     print "Less than 512 colors in image\n";
1855   }
1856
1857 =head2 Drawing Methods
1858
1859 IMPLEMENTATION MORE OR LESS DONE CHECK THE TESTS
1860
1861 DOCUMENTATION OF THIS SECTION OUT OF SYNC
1862
1863 It is possible to draw with graphics primitives onto images.  Such
1864 primitives include boxes, arcs, circles and lines.  A reference
1865 oriented list follows.
1866
1867 Box:
1868   $img->box(color=>$blue,xmin=>10,ymin=>30,xmax=>200,ymax=>300,filled=>1);
1869
1870 The above example calls the C<box> method for the image and the box
1871 covers the pixels with in the rectangle specified.  If C<filled> is
1872 ommited it is drawn as an outline.  If any of the edges of the box are
1873 ommited it will snap to the outer edge of the image in that direction.
1874 Also if a color is omitted a color with (255,255,255,255) is used
1875 instead.
1876
1877 Arc:
1878   $img->arc(color=>$red, r=20, x=>200, y=>100, d1=>10, d2=>20 );
1879
1880 This creates a filled red arc with a 'center' at (200, 100) and spans
1881 10 degrees and the slice has a radius of 20. SEE section on BUGS.
1882
1883 Circle:
1884   $img->circle(color=>$green, r=50, x=>200, y=>100);
1885
1886 This creates a green circle with its center at (200, 100) and has a
1887 radius of 20.
1888
1889 Line:
1890   $img->line(color=>$green, x1=10, x2=>100,
1891                             y1=>20, y2=>50, antialias=>1 );
1892
1893 That draws an antialiased line from (10,100) to (20,50).
1894
1895 Polyline:
1896   $img->polyline(points=>[[$x0,$y0],[$x1,$y1],[$x2,$y2]],color=>$red);
1897   $img->polyline(x=>[$x0,$x1,$x2], y=>[$y0,$y1,$y2], antialias=>1);
1898
1899 Polyline is used to draw multilple lines between a series of points.
1900 The point set can either be specified as an arrayref to an array of
1901 array references (where each such array represents a point).  The
1902 other way is to specify two array references.
1903
1904 =head2 Text rendering
1905
1906 Text rendering is described in the Imager::Font manpage.
1907
1908 =head2 Image resizing
1909
1910 To scale an image so porportions are maintained use the
1911 C<$img-E<gt>scale()> method.  if you give either a xpixels or ypixels
1912 parameter they will determine the width or height respectively.  If
1913 both are given the one resulting in a larger image is used.  example:
1914 C<$img> is 700 pixels wide and 500 pixels tall.
1915
1916   $img->scale(xpixels=>400); # 400x285
1917   $img->scale(ypixels=>400); # 560x400
1918
1919   $img->scale(xpixels=>400,ypixels=>400); # 560x400
1920   $img->scale(xpixels=>400,ypixels=>400,type=>min); # 400x285
1921
1922   $img->scale(scalefactor=>0.25); 175x125 $img->scale(); # 350x250
1923
1924 if you want to create low quality previews of images you can pass
1925 C<qtype=E<gt>'preview'> to scale and it will use nearest neighbor
1926 sampling instead of filtering. It is much faster but also generates
1927 worse looking images - especially if the original has a lot of sharp
1928 variations and the scaled image is by more than 3-5 times smaller than
1929 the original.
1930
1931 If you need to scale images per axis it is best to do it simply by
1932 calling scaleX and scaleY.  You can pass either 'scalefactor' or
1933 'pixels' to both functions.
1934
1935 Another way to resize an image size is to crop it.  The parameters
1936 to crop are the edges of the area that you want in the returned image.
1937 If a parameter is omited a default is used instead.
1938
1939   $newimg = $img->crop(left=>50, right=>100, top=>10, bottom=>100);
1940   $newimg = $img->crop(left=>50, top=>10, width=>50, height=>90);
1941   $newimg = $img->crop(left=>50, right=>100); # top
1942
1943 You can also specify width and height parameters which will produce a
1944 new image cropped from the center of the input image, with the given
1945 width and height.
1946
1947   $newimg = $img->crop(width=>50, height=>50);
1948
1949 The width and height parameters take precedence over the left/right
1950 and top/bottom parameters respectively.
1951
1952 =head2 Copying images
1953
1954 To create a copy of an image use the C<copy()> method.  This is usefull
1955 if you want to keep an original after doing something that changes the image
1956 inplace like writing text.
1957
1958   $img=$orig->copy();
1959
1960 To copy an image to onto another image use the C<paste()> method.
1961
1962   $dest->paste(left=>40,top=>20,img=>$logo);
1963
1964 That copies the entire C<$logo> image onto the C<$dest> image so that the
1965 upper left corner of the C<$logo> image is at (40,20).
1966
1967 =head2 Blending Images
1968
1969 To put an image or a part of an image directly into another it is
1970 best to call the C<paste()> method on the image you want to add to.
1971
1972   $img->paste(img=>$srcimage,left=>30,top=>50);
1973
1974 That will take paste C<$srcimage> into C<$img> with the upper
1975 left corner at (30,50).  If no values are given for C<left>
1976 or C<top> they will default to 0.
1977
1978 A more complicated way of blending images is where one image is
1979 put 'over' the other with a certain amount of opaqueness.  The
1980 method that does this is rubthrough.
1981
1982   $img->rubthrough(src=>$srcimage,tx=>30,ty=>50);
1983
1984 That will take the image C<$srcimage> and overlay it with the
1985 upper left corner at (30,50).  The C<$srcimage> must be a 4 channel
1986 image.  The last channel is used as an alpha channel.
1987
1988
1989 =head2 Filters
1990
1991 A special image method is the filter method. An example is:
1992
1993   $img->filter(type=>'autolevels');
1994
1995 This will call the autolevels filter.  Here is a list of the filters
1996 that are always avaliable in Imager.  This list can be obtained by
1997 running the C<filterlist.perl> script that comes with the module
1998 source.
1999
2000   Filter          Arguments
2001   turbnoise
2002   autolevels      lsat(0.1) usat(0.1) skew(0)
2003   radnoise
2004   noise           amount(3) subtype(0)
2005   contrast        intensity
2006   hardinvert
2007   gradgen         xo yo colors dist
2008
2009 The default values are in parenthesis.  All parameters must have some
2010 value but if a parameter has a default value it may be omitted when
2011 calling the filter function.
2012
2013 FIXME: make a seperate pod for filters?
2014
2015 =head2 Transformations
2016
2017 Another special image method is transform.  It can be used to generate
2018 warps and rotations and such features.  It can be given the operations
2019 in postfix notation or the module Affix::Infix2Postfix can be used.
2020 Look in the test case t/t55trans.t for an example.
2021
2022 transform() needs expressions (or opcodes) that determine the source
2023 pixel for each target pixel.  Source expressions are infix expressions
2024 using any of the +, -, *, / or ** binary operators, the - unary
2025 operator, ( and ) for grouping and the sin() and cos() functions.  The
2026 target pixel is input as the variables x and y.
2027
2028 You specify the x and y expressions as xexpr and yexpr respectively.
2029 You can also specify opcodes directly, but that's magic deep enough
2030 that you can look at the source code.
2031
2032 You can still use the transform() function, but the transform2()
2033 function is just as fast and is more likely to be enhanced and
2034 maintained.
2035
2036 Later versions of Imager also support a transform2() class method
2037 which allows you perform a more general set of operations, rather than
2038 just specifying a spatial transformation as with the transform()
2039 method, you can also perform colour transformations, image synthesis
2040 and image combinations.
2041
2042 transform2() takes an reference to an options hash, and a list of
2043 images to operate one (this list may be empty):
2044
2045   my %opts;
2046   my @imgs;
2047   ...
2048   my $img = Imager::transform2(\%opts, @imgs)
2049       or die "transform2 failed: $Imager::ERRSTR";
2050
2051 The options hash may define a transformation function, and optionally:
2052
2053 =over 4
2054
2055 =item *
2056
2057 width - the width of the image in pixels.  If this isn't supplied the
2058 width of the first input image is used.  If there are no input images
2059 an error occurs.
2060
2061 =item *
2062
2063 height - the height of the image in pixels.  If this isn't supplied
2064 the height of the first input image is used.  If there are no input
2065 images an error occurs.
2066
2067 =item *
2068
2069 constants - a reference to hash of constants to define for the
2070 expression engine.  Some extra constants are defined by Imager
2071
2072 =back
2073
2074 The tranformation function is specified using either the expr or
2075 rpnexpr member of the options.
2076
2077 =over 4
2078
2079 =item Infix expressions
2080
2081 You can supply infix expressions to transform 2 with the expr keyword.
2082
2083 $opts{expr} = 'return getp1(w-x, h-y)'
2084
2085 The 'expression' supplied follows this general grammar:
2086
2087    ( identifier '=' expr ';' )* 'return' expr
2088
2089 This allows you to simplify your expressions using variables.
2090
2091 A more complex example might be:
2092
2093 $opts{expr} = 'pix = getp1(x,y); return if(value(pix)>0.8,pix*0.8,pix)'
2094
2095 Currently to use infix expressions you must have the Parse::RecDescent
2096 module installed (available from CPAN).  There is also what might be a
2097 significant delay the first time you run the infix expression parser
2098 due to the compilation of the expression grammar.
2099
2100 =item Postfix expressions
2101
2102 You can supply postfix or reverse-polish notation expressions to
2103 transform2() through the rpnexpr keyword.
2104
2105 The parser for rpnexpr emulates a stack machine, so operators will
2106 expect to see their parameters on top of the stack.  A stack machine
2107 isn't actually used during the image transformation itself.
2108
2109 You can store the value at the top of the stack in a variable called
2110 foo using !foo and retrieve that value again using @foo.  The !foo
2111 notation will pop the value from the stack.
2112
2113 An example equivalent to the infix expression above:
2114
2115  $opts{rpnexpr} = 'x y getp1 !pix @pix value 0.8 gt @pix 0.8 * @pix ifp'
2116
2117 =back
2118
2119 transform2() has a fairly rich range of operators.
2120
2121 =over 4
2122
2123 =item +, *, -, /, %, **
2124
2125 multiplication, addition, subtraction, division, remainder and
2126 exponentiation.  Multiplication, addition and subtraction can be used
2127 on colour values too - though you need to be careful - adding 2 white
2128 values together and multiplying by 0.5 will give you grey, not white.
2129
2130 Division by zero (or a small number) just results in a large number.
2131 Modulo zero (or a small number) results in zero.
2132
2133 =item sin(N), cos(N), atan2(y,x)
2134
2135 Some basic trig functions.  They work in radians, so you can't just
2136 use the hue values.
2137
2138 =item distance(x1, y1, x2, y2)
2139
2140 Find the distance between two points.  This is handy (along with
2141 atan2()) for producing circular effects.
2142
2143 =item sqrt(n)
2144
2145 Find the square root.  I haven't had much use for this since adding
2146 the distance() function.
2147
2148 =item abs(n)
2149
2150 Find the absolute value.
2151
2152 =item getp1(x,y), getp2(x,y), getp3(x, y)
2153
2154 Get the pixel at position (x,y) from the first, second or third image
2155 respectively.  I may add a getpn() function at some point, but this
2156 prevents static checking of the instructions against the number of
2157 images actually passed in.
2158
2159 =item value(c), hue(c), sat(c), hsv(h,s,v)
2160
2161 Separates a colour value into it's value (brightness), hue (colour)
2162 and saturation elements.  Use hsv() to put them back together (after
2163 suitable manipulation).
2164
2165 =item red(c), green(c), blue(c), rgb(r,g,b)
2166
2167 Separates a colour value into it's red, green and blue colours.  Use
2168 rgb(r,g,b) to put it back together.
2169
2170 =item int(n)
2171
2172 Convert a value to an integer.  Uses a C int cast, so it may break on
2173 large values.
2174
2175 =item if(cond,ntrue,nfalse), if(cond,ctrue,cfalse)
2176
2177 A simple (and inefficient) if function.
2178
2179 =item <=,<,==,>=,>,!=
2180
2181 Relational operators (typically used with if()).  Since we're working
2182 with floating point values the equalities are 'near equalities' - an
2183 epsilon value is used.
2184
2185 =item &&, ||, not(n)
2186
2187 Basic logical operators.
2188
2189 =back
2190
2191 A few examples:
2192
2193 =over 4
2194
2195 =item rpnexpr=>'x 25 % 15 * y 35 % 10 * getp1 !pat x y getp1 !pix @pix sat 0.7 gt @pat @pix ifp'
2196
2197 tiles a smaller version of the input image over itself where the colour has a saturation over 0.7.
2198
2199 =item rpnexpr=>'x 25 % 15 * y 35 % 10 * getp1 !pat y 360 / !rat x y getp1 1 @rat - pmult @pat @rat pmult padd'
2200
2201 tiles the input image over itself so that at the top of the image the
2202 full-size image is at full strength and at the bottom the tiling is
2203 most visible.
2204
2205 =item rpnexpr=>'x y getp1 !pix @pix value 0.96 gt @pix sat 0.1 lt and 128 128 255 rgb @pix ifp'
2206
2207 replace pixels that are white or almost white with a palish blue
2208
2209 =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'
2210
2211 Tiles the input image overitself where the image isn't white or almost
2212 white.
2213
2214 =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'
2215
2216 Produces a spiral.
2217
2218 =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'
2219
2220 A spiral built on top of a colour wheel.
2221
2222 =back
2223
2224 For details on expression parsing see L<Imager::Expr>.  For details on
2225 the virtual machine used to transform the images, see
2226 L<Imager::regmach.pod>.
2227
2228 =head2 Plugins
2229
2230 It is possible to add filters to the module without recompiling the
2231 module itself.  This is done by using DSOs (Dynamic shared object)
2232 avaliable on most systems.  This way you can maintain our own filters
2233 and not have to get me to add it, or worse patch every new version of
2234 the Module.  Modules can be loaded AND UNLOADED at runtime.  This
2235 means that you can have a server/daemon thingy that can do something
2236 like:
2237
2238   load_plugin("dynfilt/dyntest.so")  || die "unable to load plugin\n";
2239   %hsh=(a=>35,b=>200,type=>lin_stretch);
2240   $img->filter(%hsh);
2241   unload_plugin("dynfilt/dyntest.so") || die "unable to load plugin\n";
2242   $img->write(type=>'pnm',file=>'testout/t60.jpg')
2243     || die "error in write()\n";
2244
2245 Someone decides that the filter is not working as it should -
2246 dyntest.c modified and recompiled.
2247
2248   load_plugin("dynfilt/dyntest.so") || die "unable to load plugin\n";
2249   $img->filter(%hsh);
2250
2251 An example plugin comes with the module - Please send feedback to
2252 addi@umich.edu if you test this.
2253
2254 Note: This seems to test ok on the following systems:
2255 Linux, Solaris, HPUX, OpenBSD, FreeBSD, TRU64/OSF1, AIX.
2256 If you test this on other systems please let me know.
2257
2258 =head1 BUGS
2259
2260 box, arc, circle do not support antialiasing yet.  arc, is only filled
2261 as of yet.  Some routines do not return $self where they should.  This
2262 affects code like this, C<$img-E<gt>box()-E<gt>arc()> where an object
2263 is expected.
2264
2265 When saving Gif images the program does NOT try to shave of extra
2266 colors if it is possible.  If you specify 128 colors and there are
2267 only 2 colors used - it will have a 128 colortable anyway.
2268
2269 =head1 AUTHOR
2270
2271 Arnar M. Hrafnkelsson, addi@umich.edu
2272 And a great deal of help from others - see the README for a complete
2273 list.
2274 =head1 SEE ALSO
2275
2276 perl(1), Imager::Color(3), Affix::Infix2Postfix(3), Parse::RecDescent(3)
2277 http://www.eecs.umich.edu/~addi/perl/Imager/
2278
2279
2280 =cut