Various changes:
[imager.git] / Imager.pm
1 package Imager;
2
3 use strict;
4 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS %formats $DEBUG %filters %DSOs $ERRSTR $fontstate %OPCODES $I2P $FORMATGUESS $warn_obsolete);
5 use IO::File;
6
7 use Imager::Color;
8 use Imager::Font;
9
10 @EXPORT_OK = qw(
11                 init
12                 init_log
13                 DSO_open
14                 DSO_close
15                 DSO_funclist
16                 DSO_call
17
18                 load_plugin
19                 unload_plugin
20
21                 i_list_formats
22                 i_has_format
23
24                 i_color_new
25                 i_color_set
26                 i_color_info
27
28                 i_img_empty
29                 i_img_empty_ch
30                 i_img_exorcise
31                 i_img_destroy
32
33                 i_img_info
34
35                 i_img_setmask
36                 i_img_getmask
37
38                 i_line
39                 i_line_aa
40                 i_box
41                 i_box_filled
42                 i_arc
43                 i_circle_aa
44
45                 i_bezier_multi
46                 i_poly_aa
47                 i_poly_aa_cfill
48
49                 i_copyto
50                 i_rubthru
51                 i_scaleaxis
52                 i_scale_nn
53                 i_haar
54                 i_count_colors
55
56                 i_gaussian
57                 i_conv
58
59                 i_convert
60                 i_map
61
62                 i_img_diff
63
64                 i_init_fonts
65                 i_t1_new
66                 i_t1_destroy
67                 i_t1_set_aa
68                 i_t1_cp
69                 i_t1_text
70                 i_t1_bbox
71
72                 i_tt_set_aa
73                 i_tt_cp
74                 i_tt_text
75                 i_tt_bbox
76
77                 i_readjpeg_wiol
78                 i_writejpeg_wiol
79
80                 i_readtiff_wiol
81                 i_writetiff_wiol
82                 i_writetiff_wiol_faxable
83
84                 i_readpng_wiol
85                 i_writepng_wiol
86
87                 i_readgif
88                 i_readgif_wiol
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_wiol
97
98                 i_readraw_wiol
99                 i_writeraw_wiol
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 @EXPORT=qw(
123            init_log
124            i_list_formats
125            i_has_format
126            malloc_state
127            i_color_new
128
129            i_img_empty
130            i_img_empty_ch
131           );
132
133 %EXPORT_TAGS=
134   (handy => [qw(
135                 newfont
136                 newcolor
137                 NF
138                 NC
139                )],
140    all => [@EXPORT_OK],
141    default => [qw(
142                   load_plugin
143                   unload_plugin
144                  )]);
145
146 # registered file readers
147 my %readers;
148
149 # registered file writers
150 my %writers;
151
152 # modules we attempted to autoload
153 my %attempted_to_load;
154
155 BEGIN {
156   require Exporter;
157   @ISA = qw(Exporter);
158   $VERSION = '0.55';
159   eval {
160     require XSLoader;
161     XSLoader::load(Imager => $VERSION);
162     1;
163   } or do {
164     require DynaLoader;
165     push @ISA, 'DynaLoader';
166     bootstrap Imager $VERSION;
167   }
168 }
169
170 BEGIN {
171   i_init_fonts(); # Initialize font engines
172   Imager::Font::__init();
173   for(i_list_formats()) { $formats{$_}++; }
174
175   if ($formats{'t1'}) {
176     i_t1_set_aa(1);
177   }
178
179   if (!$formats{'t1'} and !$formats{'tt'} 
180       && !$formats{'ft2'} && !$formats{'w32'}) {
181     $fontstate='no font support';
182   }
183
184   %OPCODES=(Add=>[0],Sub=>[1],Mult=>[2],Div=>[3],Parm=>[4],'sin'=>[5],'cos'=>[6],'x'=>[4,0],'y'=>[4,1]);
185
186   $DEBUG=0;
187
188   # the members of the subhashes under %filters are:
189   #  callseq - a list of the parameters to the underlying filter in the
190   #            order they are passed
191   #  callsub - a code ref that takes a named parameter list and calls the
192   #            underlying filter
193   #  defaults - a hash of default values
194   #  names - defines names for value of given parameters so if the names 
195   #          field is foo=> { bar=>1 }, and the user supplies "bar" as the
196   #          foo parameter, the filter will receive 1 for the foo
197   #          parameter
198   $filters{contrast}={
199                       callseq => ['image','intensity'],
200                       callsub => sub { my %hsh=@_; i_contrast($hsh{image},$hsh{intensity}); } 
201                      };
202
203   $filters{noise} ={
204                     callseq => ['image', 'amount', 'subtype'],
205                     defaults => { amount=>3,subtype=>0 },
206                     callsub => sub { my %hsh=@_; i_noise($hsh{image},$hsh{amount},$hsh{subtype}); }
207                    };
208
209   $filters{hardinvert} ={
210                          callseq => ['image'],
211                          defaults => { },
212                          callsub => sub { my %hsh=@_; i_hardinvert($hsh{image}); }
213                         };
214
215   $filters{autolevels} ={
216                          callseq => ['image','lsat','usat','skew'],
217                          defaults => { lsat=>0.1,usat=>0.1,skew=>0.0 },
218                          callsub => sub { my %hsh=@_; i_autolevels($hsh{image},$hsh{lsat},$hsh{usat},$hsh{skew}); }
219                         };
220
221   $filters{turbnoise} ={
222                         callseq => ['image'],
223                         defaults => { xo=>0.0,yo=>0.0,scale=>10.0 },
224                         callsub => sub { my %hsh=@_; i_turbnoise($hsh{image},$hsh{xo},$hsh{yo},$hsh{scale}); }
225                        };
226
227   $filters{radnoise} ={
228                        callseq => ['image'],
229                        defaults => { xo=>100,yo=>100,ascale=>17.0,rscale=>0.02 },
230                        callsub => sub { my %hsh=@_; i_radnoise($hsh{image},$hsh{xo},$hsh{yo},$hsh{rscale},$hsh{ascale}); }
231                       };
232
233   $filters{conv} ={
234                        callseq => ['image', 'coef'],
235                        defaults => { },
236                        callsub => sub { my %hsh=@_; i_conv($hsh{image},$hsh{coef}); }
237                       };
238
239   $filters{gradgen} =
240     {
241      callseq => ['image', 'xo', 'yo', 'colors', 'dist'],
242      defaults => { dist => 0 },
243      callsub => 
244      sub { 
245        my %hsh=@_;
246        my @colors = @{$hsh{colors}};
247        $_ = _color($_)
248          for @colors;
249        i_gradgen($hsh{image}, $hsh{xo}, $hsh{yo}, \@colors, $hsh{dist});
250      }
251     };
252
253   $filters{nearest_color} =
254     {
255      callseq => ['image', 'xo', 'yo', 'colors', 'dist'],
256      defaults => { },
257      callsub => 
258      sub { 
259        my %hsh=@_; 
260        # make sure the segments are specified with colors
261        my @colors;
262        for my $color (@{$hsh{colors}}) {
263          my $new_color = _color($color) 
264            or die $Imager::ERRSTR."\n";
265          push @colors, $new_color;
266        }
267
268        i_nearest_color($hsh{image}, $hsh{xo}, $hsh{yo}, \@colors, 
269                        $hsh{dist})
270          or die Imager->_error_as_msg() . "\n";
271      },
272     };
273   $filters{gaussian} = {
274                         callseq => [ 'image', 'stddev' ],
275                         defaults => { },
276                         callsub => sub { my %hsh = @_; i_gaussian($hsh{image}, $hsh{stddev}); },
277                        };
278   $filters{mosaic} =
279     {
280      callseq => [ qw(image size) ],
281      defaults => { size => 20 },
282      callsub => sub { my %hsh = @_; i_mosaic($hsh{image}, $hsh{size}) },
283     };
284   $filters{bumpmap} =
285     {
286      callseq => [ qw(image bump elevation lightx lighty st) ],
287      defaults => { elevation=>0, st=> 2 },
288      callsub => sub {
289        my %hsh = @_;
290        i_bumpmap($hsh{image}, $hsh{bump}{IMG}, $hsh{elevation},
291                  $hsh{lightx}, $hsh{lighty}, $hsh{st});
292      },
293     };
294   $filters{bumpmap_complex} =
295     {
296      callseq => [ qw(image bump channel tx ty Lx Ly Lz cd cs n Ia Il Is) ],
297      defaults => {
298                   channel => 0,
299                   tx => 0,
300                   ty => 0,
301                   Lx => 0.2,
302                   Ly => 0.4,
303                   Lz => -1.0,
304                   cd => 1.0,
305                   cs => 40,
306                   n => 1.3,
307                   Ia => Imager::Color->new(rgb=>[0,0,0]),
308                   Il => Imager::Color->new(rgb=>[255,255,255]),
309                   Is => Imager::Color->new(rgb=>[255,255,255]),
310                  },
311      callsub => sub {
312        my %hsh = @_;
313        i_bumpmap_complex($hsh{image}, $hsh{bump}{IMG}, $hsh{channel},
314                  $hsh{tx}, $hsh{ty}, $hsh{Lx}, $hsh{Ly}, $hsh{Lz},
315                  $hsh{cd}, $hsh{cs}, $hsh{n}, $hsh{Ia}, $hsh{Il},
316                  $hsh{Is});
317      },
318     };
319   $filters{postlevels} =
320     {
321      callseq  => [ qw(image levels) ],
322      defaults => { levels => 10 },
323      callsub  => sub { my %hsh = @_; i_postlevels($hsh{image}, $hsh{levels}); },
324     };
325   $filters{watermark} =
326     {
327      callseq  => [ qw(image wmark tx ty pixdiff) ],
328      defaults => { pixdiff=>10, tx=>0, ty=>0 },
329      callsub  => 
330      sub { 
331        my %hsh = @_; 
332        i_watermark($hsh{image}, $hsh{wmark}{IMG}, $hsh{tx}, $hsh{ty}, 
333                    $hsh{pixdiff}); 
334      },
335     };
336   $filters{fountain} =
337     {
338      callseq  => [ qw(image xa ya xb yb ftype repeat combine super_sample ssample_param segments) ],
339      names    => {
340                   ftype => { linear         => 0,
341                              bilinear       => 1,
342                              radial         => 2,
343                              radial_square  => 3,
344                              revolution     => 4,
345                              conical        => 5 },
346                   repeat => { none      => 0,
347                               sawtooth  => 1,
348                               triangle  => 2,
349                               saw_both  => 3,
350                               tri_both  => 4,
351                             },
352                   super_sample => {
353                                    none    => 0,
354                                    grid    => 1,
355                                    random  => 2,
356                                    circle  => 3,
357                                   },
358                   combine => {
359                               none      => 0,
360                               normal    => 1,
361                               multiply  => 2, mult => 2,
362                               dissolve  => 3,
363                               add       => 4,
364                               subtract  => 5, 'sub' => 5,
365                               diff      => 6,
366                               lighten   => 7,
367                               darken    => 8,
368                               hue       => 9,
369                               sat       => 10,
370                               value     => 11,
371                               color     => 12,
372                              },
373                  },
374      defaults => { ftype => 0, repeat => 0, combine => 0,
375                    super_sample => 0, ssample_param => 4,
376                    segments=>[ 
377                               [ 0, 0.5, 1,
378                                 Imager::Color->new(0,0,0),
379                                 Imager::Color->new(255, 255, 255),
380                                 0, 0,
381                               ],
382                              ],
383                  },
384      callsub  => 
385      sub {
386        my %hsh = @_;
387
388        # make sure the segments are specified with colors
389        my @segments;
390        for my $segment (@{$hsh{segments}}) {
391          my @new_segment = @$segment;
392          
393          $_ = _color($_) or die $Imager::ERRSTR."\n" for @new_segment[3,4];
394          push @segments, \@new_segment;
395        }
396
397        i_fountain($hsh{image}, $hsh{xa}, $hsh{ya}, $hsh{xb}, $hsh{yb},
398                   $hsh{ftype}, $hsh{repeat}, $hsh{combine}, $hsh{super_sample},
399                   $hsh{ssample_param}, \@segments)
400          or die Imager->_error_as_msg() . "\n";
401      },
402     };
403   $filters{unsharpmask} =
404     {
405      callseq => [ qw(image stddev scale) ],
406      defaults => { stddev=>2.0, scale=>1.0 },
407      callsub => 
408      sub { 
409        my %hsh = @_;
410        i_unsharp_mask($hsh{image}, $hsh{stddev}, $hsh{scale});
411      },
412     };
413
414   $FORMATGUESS=\&def_guess_type;
415
416   $warn_obsolete = 1;
417 }
418
419 #
420 # Non methods
421 #
422
423 # initlize Imager
424 # NOTE: this might be moved to an import override later on
425
426 #sub import {
427 #  my $pack = shift;
428 #  (look through @_ for special tags, process, and remove them);   
429 #  use Data::Dumper;
430 #  print Dumper($pack);
431 #  print Dumper(@_);
432 #}
433
434 sub init_log {
435   i_init_log($_[0],$_[1]);
436   i_log_entry("Imager $VERSION starting\n", 1);
437 }
438
439
440 sub init {
441   my %parms=(loglevel=>1,@_);
442   if ($parms{'log'}) {
443     init_log($parms{'log'},$parms{'loglevel'});
444   }
445
446   if (exists $parms{'warn_obsolete'}) {
447     $warn_obsolete = $parms{'warn_obsolete'};
448   }
449
450 #    if ($parms{T1LIB_CONFIG}) { $ENV{T1LIB_CONFIG}=$parms{T1LIB_CONFIG}; }
451 #    if ( $ENV{T1LIB_CONFIG} and ( $fontstate eq 'missing conf' )) {
452 #       i_init_fonts();
453 #       $fontstate='ok';
454 #    }
455   if (exists $parms{'t1log'}) {
456     i_init_fonts($parms{'t1log'});
457   }
458 }
459
460 END {
461   if ($DEBUG) {
462     print "shutdown code\n";
463     #   for(keys %instances) { $instances{$_}->DESTROY(); }
464     malloc_state(); # how do decide if this should be used? -- store something from the import
465     print "Imager exiting\n";
466   }
467 }
468
469 # Load a filter plugin 
470
471 sub load_plugin {
472   my ($filename)=@_;
473   my $i;
474   my ($DSO_handle,$str)=DSO_open($filename);
475   if (!defined($DSO_handle)) { $Imager::ERRSTR="Couldn't load plugin '$filename'\n"; return undef; }
476   my %funcs=DSO_funclist($DSO_handle);
477   if ($DEBUG) { print "loading module $filename\n"; $i=0; for(keys %funcs) { printf("  %2d: %s\n",$i++,$_); } }
478   $i=0;
479   for(keys %funcs) { if ($filters{$_}) { $ERRSTR="filter '$_' already exists\n"; DSO_close($DSO_handle); return undef; } }
480
481   $DSOs{$filename}=[$DSO_handle,\%funcs];
482
483   for(keys %funcs) { 
484     my $evstr="\$filters{'".$_."'}={".$funcs{$_}.'};';
485     $DEBUG && print "eval string:\n",$evstr,"\n";
486     eval $evstr;
487     print $@ if $@;
488   }
489   return 1;
490 }
491
492 # Unload a plugin
493
494 sub unload_plugin {
495   my ($filename)=@_;
496
497   if (!$DSOs{$filename}) { $ERRSTR="plugin '$filename' not loaded."; return undef; }
498   my ($DSO_handle,$funcref)=@{$DSOs{$filename}};
499   for(keys %{$funcref}) {
500     delete $filters{$_};
501     $DEBUG && print "unloading: $_\n";
502   }
503   my $rc=DSO_close($DSO_handle);
504   if (!defined($rc)) { $ERRSTR="unable to unload plugin '$filename'."; return undef; }
505   return 1;
506 }
507
508 # take the results of i_error() and make a message out of it
509 sub _error_as_msg {
510   return join(": ", map $_->[0], i_errors());
511 }
512
513 # this function tries to DWIM for color parameters
514 #  color objects are used as is
515 #  simple scalars are simply treated as single parameters to Imager::Color->new
516 #  hashrefs are treated as named argument lists to Imager::Color->new
517 #  arrayrefs are treated as list arguments to Imager::Color->new iff any
518 #    parameter is > 1
519 #  other arrayrefs are treated as list arguments to Imager::Color::Float
520
521 sub _color {
522   my $arg = shift;
523   # perl 5.6.0 seems to do weird things to $arg if we don't make an 
524   # explicitly stringified copy
525   # I vaguely remember a bug on this on p5p, but couldn't find it
526   # through bugs.perl.org (I had trouble getting it to find any bugs)
527   my $copy = $arg . "";
528   my $result;
529
530   if (ref $arg) {
531     if (UNIVERSAL::isa($arg, "Imager::Color")
532         || UNIVERSAL::isa($arg, "Imager::Color::Float")) {
533       $result = $arg;
534     }
535     else {
536       if ($copy =~ /^HASH\(/) {
537         $result = Imager::Color->new(%$arg);
538       }
539       elsif ($copy =~ /^ARRAY\(/) {
540         $result = Imager::Color->new(@$arg);
541       }
542       else {
543         $Imager::ERRSTR = "Not a color";
544       }
545     }
546   }
547   else {
548     # assume Imager::Color::new knows how to handle it
549     $result = Imager::Color->new($arg);
550   }
551
552   return $result;
553 }
554
555 sub _valid_image {
556   my ($self) = @_;
557
558   $self->{IMG} and return 1;
559
560   $self->_set_error('empty input image');
561
562   return;
563 }
564
565 #
566 # Methods to be called on objects.
567 #
568
569 # Create a new Imager object takes very few parameters.
570 # usually you call this method and then call open from
571 # the resulting object
572
573 sub new {
574   my $class = shift;
575   my $self ={};
576   my %hsh=@_;
577   bless $self,$class;
578   $self->{IMG}=undef;    # Just to indicate what exists
579   $self->{ERRSTR}=undef; #
580   $self->{DEBUG}=$DEBUG;
581   $self->{DEBUG} && print "Initialized Imager\n";
582   if (defined $hsh{xsize} && defined $hsh{ysize}) { 
583     unless ($self->img_set(%hsh)) {
584       $Imager::ERRSTR = $self->{ERRSTR};
585       return;
586     }
587   }
588   return $self;
589 }
590
591 # Copy an entire image with no changes 
592 # - if an image has magic the copy of it will not be magical
593
594 sub copy {
595   my $self = shift;
596   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
597
598   unless (defined wantarray) {
599     my @caller = caller;
600     warn "copy() called in void context - copy() returns the copied image at $caller[1] line $caller[2]\n";
601     return;
602   }
603
604   my $newcopy=Imager->new();
605   $newcopy->{IMG} = i_copy($self->{IMG});
606   return $newcopy;
607 }
608
609 # Paste a region
610
611 sub paste {
612   my $self = shift;
613
614   unless ($self->{IMG}) { 
615     $self->_set_error('empty input image');
616     return;
617   }
618   my %input=(left=>0, top=>0, src_minx => 0, src_miny => 0, @_);
619   my $src = $input{img} || $input{src};
620   unless($src) {
621     $self->_set_error("no source image");
622     return;
623   }
624   $input{left}=0 if $input{left} <= 0;
625   $input{top}=0 if $input{top} <= 0;
626
627   my($r,$b)=i_img_info($src->{IMG});
628   my ($src_left, $src_top) = @input{qw/src_minx src_miny/};
629   my ($src_right, $src_bottom);
630   if ($input{src_coords}) {
631     ($src_left, $src_top, $src_right, $src_bottom) = @{$input{src_coords}}
632   }
633   else {
634     if (defined $input{src_maxx}) {
635       $src_right = $input{src_maxx};
636     }
637     elsif (defined $input{width}) {
638       if ($input{width} <= 0) {
639         $self->_set_error("paste: width must me positive");
640         return;
641       }
642       $src_right = $src_left + $input{width};
643     }
644     else {
645       $src_right = $r;
646     }
647     if (defined $input{src_maxy}) {
648       $src_bottom = $input{src_maxy};
649     }
650     elsif (defined $input{height}) {
651       if ($input{height} < 0) {
652         $self->_set_error("paste: height must be positive");
653         return;
654       }
655       $src_bottom = $src_top + $input{height};
656     }
657     else {
658       $src_bottom = $b;
659     }
660   }
661
662   $src_right > $r and $src_right = $r;
663   $src_bottom > $b and $src_bottom = $b;
664
665   if ($src_right <= $src_left
666       || $src_bottom < $src_top) {
667     $self->_set_error("nothing to paste");
668     return;
669   }
670
671   i_copyto($self->{IMG}, $src->{IMG}, 
672            $src_left, $src_top, $src_right, $src_bottom, 
673            $input{left}, $input{top});
674
675   return $self;  # What should go here??
676 }
677
678 # Crop an image - i.e. return a new image that is smaller
679
680 sub crop {
681   my $self=shift;
682   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
683   
684   unless (defined wantarray) {
685     my @caller = caller;
686     warn "crop() called in void context - crop() returns the cropped image at $caller[1] line $caller[2]\n";
687     return;
688   }
689
690   my %hsh=@_;
691
692   my ($w, $h, $l, $r, $b, $t) =
693     @hsh{qw(width height left right bottom top)};
694
695   # work through the various possibilities
696   if (defined $l) {
697     if (defined $w) {
698       $r = $l + $w;
699     }
700     elsif (!defined $r) {
701       $r = $self->getwidth;
702     }
703   }
704   elsif (defined $r) {
705     if (defined $w) {
706       $l = $r - $w;
707     }
708     else {
709       $l = 0;
710     }
711   }
712   elsif (defined $w) {
713     $l = int(0.5+($self->getwidth()-$w)/2);
714     $r = $l + $w;
715   }
716   else {
717     $l = 0;
718     $r = $self->getwidth;
719   }
720   if (defined $t) {
721     if (defined $h) {
722       $b = $t + $h;
723     }
724     elsif (!defined $b) {
725       $b = $self->getheight;
726     }
727   }
728   elsif (defined $b) {
729     if (defined $h) {
730       $t = $b - $h;
731     }
732     else {
733       $t = 0;
734     }
735   }
736   elsif (defined $h) {
737     $t=int(0.5+($self->getheight()-$h)/2);
738     $b=$t+$h;
739   }
740   else {
741     $t = 0;
742     $b = $self->getheight;
743   }
744
745   ($l,$r)=($r,$l) if $l>$r;
746   ($t,$b)=($b,$t) if $t>$b;
747
748   $l < 0 and $l = 0;
749   $r > $self->getwidth and $r = $self->getwidth;
750   $t < 0 and $t = 0;
751   $b > $self->getheight and $b = $self->getheight;
752
753   if ($l == $r || $t == $b) {
754     $self->_set_error("resulting image would have no content");
755     return;
756   }
757
758   my $dst = $self->_sametype(xsize=>$r-$l, ysize=>$b-$t);
759
760   i_copyto($dst->{IMG},$self->{IMG},$l,$t,$r,$b,0,0);
761   return $dst;
762 }
763
764 sub _sametype {
765   my ($self, %opts) = @_;
766
767   $self->{IMG} or return $self->_set_error("Not a valid image");
768
769   my $x = $opts{xsize} || $self->getwidth;
770   my $y = $opts{ysize} || $self->getheight;
771   my $channels = $opts{channels} || $self->getchannels;
772   
773   my $out = Imager->new;
774   if ($channels == $self->getchannels) {
775     $out->{IMG} = i_sametype($self->{IMG}, $x, $y);
776   }
777   else {
778     $out->{IMG} = i_sametype_chans($self->{IMG}, $x, $y, $channels);
779   }
780   unless ($out->{IMG}) {
781     $self->{ERRSTR} = $self->_error_as_msg;
782     return;
783   }
784   
785   return $out;
786 }
787
788 # Sets an image to a certain size and channel number
789 # if there was previously data in the image it is discarded
790
791 sub img_set {
792   my $self=shift;
793
794   my %hsh=(xsize=>100, ysize=>100, channels=>3, bits=>8, type=>'direct', @_);
795
796   if (defined($self->{IMG})) {
797     # let IIM_DESTROY destroy it, it's possible this image is
798     # referenced from a virtual image (like masked)
799     #i_img_destroy($self->{IMG});
800     undef($self->{IMG});
801   }
802
803   if ($hsh{type} eq 'paletted' || $hsh{type} eq 'pseudo') {
804     $self->{IMG} = i_img_pal_new($hsh{xsize}, $hsh{ysize}, $hsh{channels},
805                                  $hsh{maxcolors} || 256);
806   }
807   elsif ($hsh{bits} eq 'double') {
808     $self->{IMG} = i_img_double_new($hsh{xsize}, $hsh{ysize}, $hsh{channels});
809   }
810   elsif ($hsh{bits} == 16) {
811     $self->{IMG} = i_img_16_new($hsh{xsize}, $hsh{ysize}, $hsh{channels});
812   }
813   else {
814     $self->{IMG}=Imager::ImgRaw::new($hsh{'xsize'}, $hsh{'ysize'},
815                                      $hsh{'channels'});
816   }
817
818   unless ($self->{IMG}) {
819     $self->{ERRSTR} = Imager->_error_as_msg();
820     return;
821   }
822
823   $self;
824 }
825
826 # created a masked version of the current image
827 sub masked {
828   my $self = shift;
829
830   $self or return undef;
831   my %opts = (left    => 0, 
832               top     => 0, 
833               right   => $self->getwidth, 
834               bottom  => $self->getheight,
835               @_);
836   my $mask = $opts{mask} ? $opts{mask}{IMG} : undef;
837
838   my $result = Imager->new;
839   $result->{IMG} = i_img_masked_new($self->{IMG}, $mask, $opts{left}, 
840                                     $opts{top}, $opts{right} - $opts{left},
841                                     $opts{bottom} - $opts{top});
842   # keep references to the mask and base images so they don't
843   # disappear on us
844   $result->{DEPENDS} = [ $self->{IMG}, $mask ];
845
846   $result;
847 }
848
849 # convert an RGB image into a paletted image
850 sub to_paletted {
851   my $self = shift;
852   my $opts;
853   if (@_ != 1 && !ref $_[0]) {
854     $opts = { @_ };
855   }
856   else {
857     $opts = shift;
858   }
859
860   unless (defined wantarray) {
861     my @caller = caller;
862     warn "to_paletted() called in void context - to_paletted() returns the converted image at $caller[1] line $caller[2]\n";
863     return;
864   }
865
866   my $result = Imager->new;
867   $result->{IMG} = i_img_to_pal($self->{IMG}, $opts);
868
869   #print "Type ", i_img_type($result->{IMG}), "\n";
870
871   if ($result->{IMG}) {
872     return $result;
873   }
874   else {
875     $self->{ERRSTR} = $self->_error_as_msg;
876     return;
877   }
878 }
879
880 # convert a paletted (or any image) to an 8-bit/channel RGB images
881 sub to_rgb8 {
882   my $self = shift;
883   my $result;
884
885   unless (defined wantarray) {
886     my @caller = caller;
887     warn "to_rgb8() called in void context - to_rgb8() returns the converted image at $caller[1] line $caller[2]\n";
888     return;
889   }
890
891   if ($self->{IMG}) {
892     $result = Imager->new;
893     $result->{IMG} = i_img_to_rgb($self->{IMG})
894       or undef $result;
895   }
896
897   return $result;
898 }
899
900 sub addcolors {
901   my $self = shift;
902   my %opts = (colors=>[], @_);
903
904   unless ($self->{IMG}) {
905     $self->_set_error("empty input image");
906     return;
907   }
908
909   my @colors = @{$opts{colors}}
910     or return undef;
911
912   for my $color (@colors) {
913     $color = _color($color);
914     unless ($color) {
915       $self->_set_error($Imager::ERRSTR);
916       return;
917     }  
918   }
919
920   return i_addcolors($self->{IMG}, @colors);
921 }
922
923 sub setcolors {
924   my $self = shift;
925   my %opts = (start=>0, colors=>[], @_);
926
927   unless ($self->{IMG}) {
928     $self->_set_error("empty input image");
929     return;
930   }
931
932   my @colors = @{$opts{colors}}
933     or return undef;
934
935   for my $color (@colors) {
936     $color = _color($color);
937     unless ($color) {
938       $self->_set_error($Imager::ERRSTR);
939       return;
940     }  
941   }
942
943   return i_setcolors($self->{IMG}, $opts{start}, @colors);
944 }
945
946 sub getcolors {
947   my $self = shift;
948   my %opts = @_;
949   if (!exists $opts{start} && !exists $opts{count}) {
950     # get them all
951     $opts{start} = 0;
952     $opts{count} = $self->colorcount;
953   }
954   elsif (!exists $opts{count}) {
955     $opts{count} = 1;
956   }
957   elsif (!exists $opts{start}) {
958     $opts{start} = 0;
959   }
960   
961   $self->{IMG} and 
962     return i_getcolors($self->{IMG}, $opts{start}, $opts{count});
963 }
964
965 sub colorcount {
966   i_colorcount($_[0]{IMG});
967 }
968
969 sub maxcolors {
970   i_maxcolors($_[0]{IMG});
971 }
972
973 sub findcolor {
974   my $self = shift;
975   my %opts = @_;
976   $opts{color} or return undef;
977
978   $self->{IMG} and i_findcolor($self->{IMG}, $opts{color});
979 }
980
981 sub bits {
982   my $self = shift;
983   my $bits = $self->{IMG} && i_img_bits($self->{IMG});
984   if ($bits && $bits == length(pack("d", 1)) * 8) {
985     $bits = 'double';
986   }
987   $bits;
988 }
989
990 sub type {
991   my $self = shift;
992   if ($self->{IMG}) {
993     return i_img_type($self->{IMG}) ? "paletted" : "direct";
994   }
995 }
996
997 sub virtual {
998   my $self = shift;
999   $self->{IMG} and i_img_virtual($self->{IMG});
1000 }
1001
1002 sub tags {
1003   my ($self, %opts) = @_;
1004
1005   $self->{IMG} or return;
1006
1007   if (defined $opts{name}) {
1008     my @result;
1009     my $start = 0;
1010     my $found;
1011     while (defined($found = i_tags_find($self->{IMG}, $opts{name}, $start))) {
1012       push @result, (i_tags_get($self->{IMG}, $found))[1];
1013       $start = $found+1;
1014     }
1015     return wantarray ? @result : $result[0];
1016   }
1017   elsif (defined $opts{code}) {
1018     my @result;
1019     my $start = 0;
1020     my $found;
1021     while (defined($found = i_tags_findn($self->{IMG}, $opts{code}, $start))) {
1022       push @result, (i_tags_get($self->{IMG}, $found))[1];
1023       $start = $found+1;
1024     }
1025     return @result;
1026   }
1027   else {
1028     if (wantarray) {
1029       return map { [ i_tags_get($self->{IMG}, $_) ] } 0.. i_tags_count($self->{IMG})-1;
1030     }
1031     else {
1032       return i_tags_count($self->{IMG});
1033     }
1034   }
1035 }
1036
1037 sub addtag {
1038   my $self = shift;
1039   my %opts = @_;
1040
1041   return -1 unless $self->{IMG};
1042   if ($opts{name}) {
1043     if (defined $opts{value}) {
1044       if ($opts{value} =~ /^\d+$/) {
1045         # add as a number
1046         return i_tags_addn($self->{IMG}, $opts{name}, 0, $opts{value});
1047       }
1048       else {
1049         return i_tags_add($self->{IMG}, $opts{name}, 0, $opts{value}, 0);
1050       }
1051     }
1052     elsif (defined $opts{data}) {
1053       # force addition as a string
1054       return i_tags_add($self->{IMG}, $opts{name}, 0, $opts{data}, 0);
1055     }
1056     else {
1057       $self->{ERRSTR} = "No value supplied";
1058       return undef;
1059     }
1060   }
1061   elsif ($opts{code}) {
1062     if (defined $opts{value}) {
1063       if ($opts{value} =~ /^\d+$/) {
1064         # add as a number
1065         return i_tags_addn($self->{IMG}, $opts{code}, 0, $opts{value});
1066       }
1067       else {
1068         return i_tags_add($self->{IMG}, $opts{code}, 0, $opts{value}, 0);
1069       }
1070     }
1071     elsif (defined $opts{data}) {
1072       # force addition as a string
1073       return i_tags_add($self->{IMG}, $opts{code}, 0, $opts{data}, 0);
1074     }
1075     else {
1076       $self->{ERRSTR} = "No value supplied";
1077       return undef;
1078     }
1079   }
1080   else {
1081     return undef;
1082   }
1083 }
1084
1085 sub deltag {
1086   my $self = shift;
1087   my %opts = @_;
1088
1089   return 0 unless $self->{IMG};
1090
1091   if (defined $opts{'index'}) {
1092     return i_tags_delete($self->{IMG}, $opts{'index'});
1093   }
1094   elsif (defined $opts{name}) {
1095     return i_tags_delbyname($self->{IMG}, $opts{name});
1096   }
1097   elsif (defined $opts{code}) {
1098     return i_tags_delbycode($self->{IMG}, $opts{code});
1099   }
1100   else {
1101     $self->{ERRSTR} = "Need to supply index, name, or code parameter";
1102     return 0;
1103   }
1104 }
1105
1106 sub settag {
1107   my ($self, %opts) = @_;
1108
1109   if ($opts{name}) {
1110     $self->deltag(name=>$opts{name});
1111     return $self->addtag(name=>$opts{name}, value=>$opts{value});
1112   }
1113   elsif (defined $opts{code}) {
1114     $self->deltag(code=>$opts{code});
1115     return $self->addtag(code=>$opts{code}, value=>$opts{value});
1116   }
1117   else {
1118     return undef;
1119   }
1120 }
1121
1122
1123 sub _get_reader_io {
1124   my ($self, $input) = @_;
1125
1126   if ($input->{io}) {
1127     return $input->{io}, undef;
1128   }
1129   elsif ($input->{fd}) {
1130     return io_new_fd($input->{fd});
1131   }
1132   elsif ($input->{fh}) {
1133     my $fd = fileno($input->{fh});
1134     unless ($fd) {
1135       $self->_set_error("Handle in fh option not opened");
1136       return;
1137     }
1138     return io_new_fd($fd);
1139   }
1140   elsif ($input->{file}) {
1141     my $file = IO::File->new($input->{file}, "r");
1142     unless ($file) {
1143       $self->_set_error("Could not open $input->{file}: $!");
1144       return;
1145     }
1146     binmode $file;
1147     return (io_new_fd(fileno($file)), $file);
1148   }
1149   elsif ($input->{data}) {
1150     return io_new_buffer($input->{data});
1151   }
1152   elsif ($input->{callback} || $input->{readcb}) {
1153     if (!$input->{seekcb}) {
1154       $self->_set_error("Need a seekcb parameter");
1155     }
1156     if ($input->{maxbuffer}) {
1157       return io_new_cb($input->{writecb},
1158                        $input->{callback} || $input->{readcb},
1159                        $input->{seekcb}, $input->{closecb},
1160                        $input->{maxbuffer});
1161     }
1162     else {
1163       return io_new_cb($input->{writecb},
1164                        $input->{callback} || $input->{readcb},
1165                        $input->{seekcb}, $input->{closecb});
1166     }
1167   }
1168   else {
1169     $self->_set_error("file/fd/fh/data/callback parameter missing");
1170     return;
1171   }
1172 }
1173
1174 sub _get_writer_io {
1175   my ($self, $input, $type) = @_;
1176
1177   if ($input->{io}) {
1178     return $input->{io};
1179   }
1180   elsif ($input->{fd}) {
1181     return io_new_fd($input->{fd});
1182   }
1183   elsif ($input->{fh}) {
1184     my $fd = fileno($input->{fh});
1185     unless ($fd) {
1186       $self->_set_error("Handle in fh option not opened");
1187       return;
1188     }
1189     # flush it
1190     my $oldfh = select($input->{fh});
1191     # flush anything that's buffered, and make sure anything else is flushed
1192     $| = 1;
1193     select($oldfh);
1194     return io_new_fd($fd);
1195   }
1196   elsif ($input->{file}) {
1197     my $fh = new IO::File($input->{file},"w+");
1198     unless ($fh) { 
1199       $self->_set_error("Could not open file $input->{file}: $!");
1200       return;
1201     }
1202     binmode($fh) or die;
1203     return (io_new_fd(fileno($fh)), $fh);
1204   }
1205   elsif ($input->{data}) {
1206     return io_new_bufchain();
1207   }
1208   elsif ($input->{callback} || $input->{writecb}) {
1209     if ($input->{maxbuffer}) {
1210       return io_new_cb($input->{callback} || $input->{writecb},
1211                        $input->{readcb},
1212                        $input->{seekcb}, $input->{closecb},
1213                        $input->{maxbuffer});
1214     }
1215     else {
1216       return io_new_cb($input->{callback} || $input->{writecb},
1217                        $input->{readcb},
1218                        $input->{seekcb}, $input->{closecb});
1219     }
1220   }
1221   else {
1222     $self->_set_error("file/fd/fh/data/callback parameter missing");
1223     return;
1224   }
1225 }
1226
1227 # Read an image from file
1228
1229 sub read {
1230   my $self = shift;
1231   my %input=@_;
1232
1233   if (defined($self->{IMG})) {
1234     # let IIM_DESTROY do the destruction, since the image may be
1235     # referenced from elsewhere
1236     #i_img_destroy($self->{IMG});
1237     undef($self->{IMG});
1238   }
1239
1240   my ($IO, $fh) = $self->_get_reader_io(\%input) or return;
1241
1242   unless ($input{'type'}) {
1243     $input{'type'} = i_test_format_probe($IO, -1);
1244   }
1245
1246   unless ($input{'type'}) {
1247           $self->_set_error('type parameter missing and not possible to guess from extension'); 
1248     return undef;
1249   }
1250
1251   _reader_autoload($input{type});
1252
1253   if ($readers{$input{type}} && $readers{$input{type}}{single}) {
1254     return $readers{$input{type}}{single}->($self, $IO, %input);
1255   }
1256
1257   unless ($formats{$input{'type'}}) {
1258     $self->_set_error("format '$input{'type'}' not supported");
1259     return;
1260   }
1261
1262   # Setup data source
1263   if ( $input{'type'} eq 'jpeg' ) {
1264     ($self->{IMG},$self->{IPTCRAW}) = i_readjpeg_wiol( $IO );
1265     if ( !defined($self->{IMG}) ) {
1266       $self->{ERRSTR}=$self->_error_as_msg(); return undef;
1267     }
1268     $self->{DEBUG} && print "loading a jpeg file\n";
1269     return $self;
1270   }
1271
1272   my $allow_partial = $input{allow_partial};
1273   defined $allow_partial or $allow_partial = 0;
1274
1275   if ( $input{'type'} eq 'tiff' ) {
1276     my $page = $input{'page'};
1277     defined $page or $page = 0;
1278     $self->{IMG}=i_readtiff_wiol( $IO, $allow_partial, $page ); 
1279     if ( !defined($self->{IMG}) ) {
1280       $self->{ERRSTR}=$self->_error_as_msg(); return undef;
1281     }
1282     $self->{DEBUG} && print "loading a tiff file\n";
1283     return $self;
1284   }
1285
1286   if ( $input{'type'} eq 'pnm' ) {
1287     $self->{IMG}=i_readpnm_wiol( $IO, $allow_partial );
1288     if ( !defined($self->{IMG}) ) {
1289       $self->{ERRSTR}='unable to read pnm image: '._error_as_msg(); 
1290       return undef;
1291     }
1292     $self->{DEBUG} && print "loading a pnm file\n";
1293     return $self;
1294   }
1295
1296   if ( $input{'type'} eq 'png' ) {
1297     $self->{IMG}=i_readpng_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed
1298     if ( !defined($self->{IMG}) ) {
1299       $self->{ERRSTR} = $self->_error_as_msg();
1300       return undef;
1301     }
1302     $self->{DEBUG} && print "loading a png file\n";
1303   }
1304
1305   if ( $input{'type'} eq 'bmp' ) {
1306     $self->{IMG}=i_readbmp_wiol( $IO, $allow_partial );
1307     if ( !defined($self->{IMG}) ) {
1308       $self->{ERRSTR}=$self->_error_as_msg();
1309       return undef;
1310     }
1311     $self->{DEBUG} && print "loading a bmp file\n";
1312   }
1313
1314   if ( $input{'type'} eq 'gif' ) {
1315     if ($input{colors} && !ref($input{colors})) {
1316       # must be a reference to a scalar that accepts the colour map
1317       $self->{ERRSTR} = "option 'colors' must be a scalar reference";
1318       return undef;
1319     }
1320     if ($input{'gif_consolidate'}) {
1321       if ($input{colors}) {
1322         my $colors;
1323         ($self->{IMG}, $colors) =i_readgif_wiol( $IO );
1324         if ($colors) {
1325           ${ $input{colors} } = [ map { NC(@$_) } @$colors ];
1326         }
1327       }
1328       else {
1329         $self->{IMG} =i_readgif_wiol( $IO );
1330       }
1331     }
1332     else {
1333       my $page = $input{'page'};
1334       defined $page or $page = 0;
1335       $self->{IMG} = i_readgif_single_wiol( $IO, $page );
1336       if ($input{colors}) {
1337         ${ $input{colors} } =
1338           [ i_getcolors($self->{IMG}, 0, i_colorcount($self->{IMG})) ];
1339       }
1340     }
1341
1342     if ( !defined($self->{IMG}) ) {
1343       $self->{ERRSTR}=$self->_error_as_msg();
1344       return undef;
1345     }
1346     $self->{DEBUG} && print "loading a gif file\n";
1347   }
1348
1349   if ( $input{'type'} eq 'tga' ) {
1350     $self->{IMG}=i_readtga_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed
1351     if ( !defined($self->{IMG}) ) {
1352       $self->{ERRSTR}=$self->_error_as_msg();
1353       return undef;
1354     }
1355     $self->{DEBUG} && print "loading a tga file\n";
1356   }
1357
1358   if ( $input{'type'} eq 'rgb' ) {
1359     $self->{IMG}=i_readrgb_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed
1360     if ( !defined($self->{IMG}) ) {
1361       $self->{ERRSTR}=$self->_error_as_msg();
1362       return undef;
1363     }
1364     $self->{DEBUG} && print "loading a tga file\n";
1365   }
1366
1367
1368   if ( $input{'type'} eq 'raw' ) {
1369     my %params=(datachannels=>3,storechannels=>3,interleave=>1,%input);
1370
1371     if ( !($params{xsize} && $params{ysize}) ) {
1372       $self->{ERRSTR}='missing xsize or ysize parameter for raw';
1373       return undef;
1374     }
1375
1376     $self->{IMG} = i_readraw_wiol( $IO,
1377                                    $params{xsize},
1378                                    $params{ysize},
1379                                    $params{datachannels},
1380                                    $params{storechannels},
1381                                    $params{interleave});
1382     if ( !defined($self->{IMG}) ) {
1383       $self->{ERRSTR}=$self->_error_as_msg();
1384       return undef;
1385     }
1386     $self->{DEBUG} && print "loading a raw file\n";
1387   }
1388
1389   return $self;
1390 }
1391
1392 sub register_reader {
1393   my ($class, %opts) = @_;
1394
1395   defined $opts{type}
1396     or die "register_reader called with no type parameter\n";
1397
1398   my $type = $opts{type};
1399
1400   defined $opts{single} || defined $opts{multiple}
1401     or die "register_reader called with no single or multiple parameter\n";
1402
1403   $readers{$type} = {  };
1404   if ($opts{single}) {
1405     $readers{$type}{single} = $opts{single};
1406   }
1407   if ($opts{multiple}) {
1408     $readers{$type}{multiple} = $opts{multiple};
1409   }
1410
1411   return 1;
1412 }
1413
1414 sub register_writer {
1415   my ($class, %opts) = @_;
1416
1417   defined $opts{type}
1418     or die "register_writer called with no type parameter\n";
1419
1420   my $type = $opts{type};
1421
1422   defined $opts{single} || defined $opts{multiple}
1423     or die "register_writer called with no single or multiple parameter\n";
1424
1425   $writers{$type} = {  };
1426   if ($opts{single}) {
1427     $writers{$type}{single} = $opts{single};
1428   }
1429   if ($opts{multiple}) {
1430     $writers{$type}{multiple} = $opts{multiple};
1431   }
1432
1433   return 1;
1434 }
1435
1436 # probes for an Imager::File::whatever module
1437 sub _reader_autoload {
1438   my $type = shift;
1439
1440   return if $formats{$type} || $readers{$type};
1441
1442   return unless $type =~ /^\w+$/;
1443
1444   my $file = "Imager/File/\U$type\E.pm";
1445
1446   unless ($attempted_to_load{$file}) {
1447     eval {
1448       ++$attempted_to_load{$file};
1449       require $file;
1450     };
1451     if ($@) {
1452       # try to get a reader specific module
1453       my $file = "Imager/File/\U$type\EReader.pm";
1454       unless ($attempted_to_load{$file}) {
1455         eval {
1456           ++$attempted_to_load{$file};
1457           require $file;
1458         };
1459       }
1460     }
1461   }
1462 }
1463
1464 # probes for an Imager::File::whatever module
1465 sub _writer_autoload {
1466   my $type = shift;
1467
1468   return if $formats{$type} || $readers{$type};
1469
1470   return unless $type =~ /^\w+$/;
1471
1472   my $file = "Imager/File/\U$type\E.pm";
1473
1474   unless ($attempted_to_load{$file}) {
1475     eval {
1476       ++$attempted_to_load{$file};
1477       require $file;
1478     };
1479     if ($@) {
1480       # try to get a writer specific module
1481       my $file = "Imager/File/\U$type\EWriter.pm";
1482       unless ($attempted_to_load{$file}) {
1483         eval {
1484           ++$attempted_to_load{$file};
1485           require $file;
1486         };
1487       }
1488     }
1489   }
1490 }
1491
1492 sub _fix_gif_positions {
1493   my ($opts, $opt, $msg, @imgs) = @_;
1494
1495   my $positions = $opts->{'gif_positions'};
1496   my $index = 0;
1497   for my $pos (@$positions) {
1498     my ($x, $y) = @$pos;
1499     my $img = $imgs[$index++];
1500     $img->settag(name=>'gif_left', value=>$x);
1501     $img->settag(name=>'gif_top', value=>$y) if defined $y;
1502   }
1503   $$msg .= "replaced with the gif_left and gif_top tags";
1504 }
1505
1506 my %obsolete_opts =
1507   (
1508    gif_each_palette=>'gif_local_map',
1509    interlace       => 'gif_interlace',
1510    gif_delays => 'gif_delay',
1511    gif_positions => \&_fix_gif_positions,
1512    gif_loop_count => 'gif_loop',
1513   );
1514
1515 sub _set_opts {
1516   my ($self, $opts, $prefix, @imgs) = @_;
1517
1518   for my $opt (keys %$opts) {
1519     my $tagname = $opt;
1520     if ($obsolete_opts{$opt}) {
1521       my $new = $obsolete_opts{$opt};
1522       my $msg = "Obsolete option $opt ";
1523       if (ref $new) {
1524         $new->($opts, $opt, \$msg, @imgs);
1525       }
1526       else {
1527         $msg .= "replaced with the $new tag ";
1528         $tagname = $new;
1529       }
1530       $msg .= "line ".(caller(2))[2]." of file ".(caller(2))[1];
1531       warn $msg if $warn_obsolete && $^W;
1532     }
1533     next unless $tagname =~ /^\Q$prefix/;
1534     my $value = $opts->{$opt};
1535     if (ref $value) {
1536       if (UNIVERSAL::isa($value, "Imager::Color")) {
1537         my $tag = sprintf("color(%d,%d,%d,%d)", $value->rgba);
1538         for my $img (@imgs) {
1539           $img->settag(name=>$tagname, value=>$tag);
1540         }
1541       }
1542       elsif (ref($value) eq 'ARRAY') {
1543         for my $i (0..$#$value) {
1544           my $val = $value->[$i];
1545           if (ref $val) {
1546             if (UNIVERSAL::isa($val, "Imager::Color")) {
1547               my $tag = sprintf("color(%d,%d,%d,%d)", $value->rgba);
1548               $i < @imgs and
1549                 $imgs[$i]->settag(name=>$tagname, value=>$tag);
1550             }
1551             else {
1552               $self->_set_error("Unknown reference type " . ref($value) . 
1553                                 " supplied in array for $opt");
1554               return;
1555             }
1556           }
1557           else {
1558             $i < @imgs
1559               and $imgs[$i]->settag(name=>$tagname, value=>$val);
1560           }
1561         }
1562       }
1563       else {
1564         $self->_set_error("Unknown reference type " . ref($value) . 
1565                           " supplied for $opt");
1566         return;
1567       }
1568     }
1569     else {
1570       # set it as a tag for every image
1571       for my $img (@imgs) {
1572         $img->settag(name=>$tagname, value=>$value);
1573       }
1574     }
1575   }
1576
1577   return 1;
1578 }
1579
1580 # Write an image to file
1581 sub write {
1582   my $self = shift;
1583   my %input=(jpegquality=>75,
1584              gifquant=>'mc',
1585              lmdither=>6.0,
1586              lmfixed=>[],
1587              idstring=>"",
1588              compress=>1,
1589              wierdpack=>0,
1590              fax_fine=>1, @_);
1591   my $rc;
1592
1593   $self->_set_opts(\%input, "i_", $self)
1594     or return undef;
1595
1596   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1597
1598   if (!$input{'type'} and $input{file}) { 
1599     $input{'type'}=$FORMATGUESS->($input{file});
1600   }
1601   if (!$input{'type'}) { 
1602     $self->{ERRSTR}='type parameter missing and not possible to guess from extension';
1603     return undef;
1604   }
1605
1606   _writer_autoload($input{type});
1607
1608   my ($IO, $fh);
1609   if ($writers{$input{type}} && $writers{$input{type}}{single}) {
1610     ($IO, $fh) = $self->_get_writer_io(\%input, $input{'type'})
1611       or return undef;
1612
1613     $writers{$input{type}}{single}->($self, $IO, %input)
1614       or return undef;
1615   }
1616   else {
1617     if (!$formats{$input{'type'}}) { 
1618       $self->{ERRSTR}='format not supported'; 
1619       return undef;
1620     }
1621     
1622     ($IO, $fh) = $self->_get_writer_io(\%input, $input{'type'})
1623       or return undef;
1624     
1625     if ($input{'type'} eq 'tiff') {
1626       $self->_set_opts(\%input, "tiff_", $self)
1627         or return undef;
1628       $self->_set_opts(\%input, "exif_", $self)
1629         or return undef;
1630       
1631       if (defined $input{class} && $input{class} eq 'fax') {
1632         if (!i_writetiff_wiol_faxable($self->{IMG}, $IO, $input{fax_fine})) {
1633           $self->{ERRSTR} = $self->_error_as_msg();
1634           return undef;
1635         }
1636       } else {
1637         if (!i_writetiff_wiol($self->{IMG}, $IO)) {
1638           $self->{ERRSTR} = $self->_error_as_msg();
1639           return undef;
1640         }
1641       }
1642     } elsif ( $input{'type'} eq 'pnm' ) {
1643       $self->_set_opts(\%input, "pnm_", $self)
1644         or return undef;
1645       if ( ! i_writeppm_wiol($self->{IMG},$IO) ) {
1646         $self->{ERRSTR} = $self->_error_as_msg();
1647         return undef;
1648       }
1649       $self->{DEBUG} && print "writing a pnm file\n";
1650     } elsif ( $input{'type'} eq 'raw' ) {
1651       $self->_set_opts(\%input, "raw_", $self)
1652         or return undef;
1653       if ( !i_writeraw_wiol($self->{IMG},$IO) ) {
1654         $self->{ERRSTR} = $self->_error_as_msg();
1655         return undef;
1656       }
1657       $self->{DEBUG} && print "writing a raw file\n";
1658     } elsif ( $input{'type'} eq 'png' ) {
1659       $self->_set_opts(\%input, "png_", $self)
1660         or return undef;
1661       if ( !i_writepng_wiol($self->{IMG}, $IO) ) {
1662         $self->{ERRSTR}='unable to write png image';
1663         return undef;
1664       }
1665       $self->{DEBUG} && print "writing a png file\n";
1666     } elsif ( $input{'type'} eq 'jpeg' ) {
1667       $self->_set_opts(\%input, "jpeg_", $self)
1668         or return undef;
1669       $self->_set_opts(\%input, "exif_", $self)
1670         or return undef;
1671       if ( !i_writejpeg_wiol($self->{IMG}, $IO, $input{jpegquality})) {
1672         $self->{ERRSTR} = $self->_error_as_msg();
1673         return undef;
1674       }
1675       $self->{DEBUG} && print "writing a jpeg file\n";
1676     } elsif ( $input{'type'} eq 'bmp' ) {
1677       $self->_set_opts(\%input, "bmp_", $self)
1678         or return undef;
1679       if ( !i_writebmp_wiol($self->{IMG}, $IO) ) {
1680         $self->{ERRSTR}='unable to write bmp image';
1681         return undef;
1682       }
1683       $self->{DEBUG} && print "writing a bmp file\n";
1684     } elsif ( $input{'type'} eq 'tga' ) {
1685       $self->_set_opts(\%input, "tga_", $self)
1686         or return undef;
1687       
1688       if ( !i_writetga_wiol($self->{IMG}, $IO, $input{wierdpack}, $input{compress}, $input{idstring}) ) {
1689         $self->{ERRSTR}=$self->_error_as_msg();
1690         return undef;
1691       }
1692       $self->{DEBUG} && print "writing a tga file\n";
1693     } elsif ( $input{'type'} eq 'gif' ) {
1694       $self->_set_opts(\%input, "gif_", $self)
1695         or return undef;
1696       # compatibility with the old interfaces
1697       if ($input{gifquant} eq 'lm') {
1698         $input{make_colors} = 'addi';
1699         $input{translate} = 'perturb';
1700         $input{perturb} = $input{lmdither};
1701       } elsif ($input{gifquant} eq 'gen') {
1702         # just pass options through
1703       } else {
1704         $input{make_colors} = 'webmap'; # ignored
1705         $input{translate} = 'giflib';
1706       }
1707       if (!i_writegif_wiol($IO, \%input, $self->{IMG})) {
1708         $self->{ERRSTR} = $self->_error_as_msg;
1709         return;
1710       }
1711     }
1712   }
1713
1714   if (exists $input{'data'}) {
1715     my $data = io_slurp($IO);
1716     if (!$data) {
1717       $self->{ERRSTR}='Could not slurp from buffer';
1718       return undef;
1719     }
1720     ${$input{data}} = $data;
1721   }
1722   return $self;
1723 }
1724
1725 sub write_multi {
1726   my ($class, $opts, @images) = @_;
1727
1728   my $type = $opts->{type};
1729
1730   if (!$type && $opts->{'file'}) {
1731     $type = $FORMATGUESS->($opts->{'file'});
1732   }
1733   unless ($type) {
1734     $class->_set_error('type parameter missing and not possible to guess from extension');
1735     return;
1736   }
1737   # translate to ImgRaw
1738   if (grep !UNIVERSAL::isa($_, 'Imager') || !$_->{IMG}, @images) {
1739     $class->_set_error('Usage: Imager->write_multi({ options }, @images)');
1740     return 0;
1741   }
1742   $class->_set_opts($opts, "i_", @images)
1743     or return;
1744   my @work = map $_->{IMG}, @images;
1745
1746   _writer_autoload($type);
1747
1748   my ($IO, $file);
1749   if ($writers{$type} && $writers{$type}{multiple}) {
1750     ($IO, $file) = $class->_get_writer_io($opts, $type)
1751       or return undef;
1752
1753     $writers{$type}{multiple}->($class, $IO, $opts, @images)
1754       or return undef;
1755   }
1756   else {
1757     if (!$formats{$type}) { 
1758       $class->_set_error("format $type not supported"); 
1759       return undef;
1760     }
1761     
1762     ($IO, $file) = $class->_get_writer_io($opts, $type)
1763       or return undef;
1764     
1765     if ($type eq 'gif') {
1766       $class->_set_opts($opts, "gif_", @images)
1767         or return;
1768       my $gif_delays = $opts->{gif_delays};
1769       local $opts->{gif_delays} = $gif_delays;
1770       if ($opts->{gif_delays} && !ref $opts->{gif_delays}) {
1771         # assume the caller wants the same delay for each frame
1772         $opts->{gif_delays} = [ ($gif_delays) x @images ];
1773       }
1774       unless (i_writegif_wiol($IO, $opts, @work)) {
1775         $class->_set_error($class->_error_as_msg());
1776         return undef;
1777       }
1778     }
1779     elsif ($type eq 'tiff') {
1780       $class->_set_opts($opts, "tiff_", @images)
1781         or return;
1782       $class->_set_opts($opts, "exif_", @images)
1783         or return;
1784       my $res;
1785       $opts->{fax_fine} = 1 unless exists $opts->{fax_fine};
1786       if ($opts->{'class'} && $opts->{'class'} eq 'fax') {
1787         $res = i_writetiff_multi_wiol_faxable($IO, $opts->{fax_fine}, @work);
1788       }
1789       else {
1790         $res = i_writetiff_multi_wiol($IO, @work);
1791       }
1792       unless ($res) {
1793         $class->_set_error($class->_error_as_msg());
1794         return undef;
1795       }
1796     }
1797     else {
1798       if (@images == 1) {
1799         unless ($images[0]->write(%$opts, io => $IO, type => $type)) {
1800           return 1;
1801         }
1802       }
1803       else {
1804         $ERRSTR = "Sorry, write_multi doesn't support $type yet";
1805         return 0;
1806       }
1807     }
1808   }
1809
1810   if (exists $opts->{'data'}) {
1811     my $data = io_slurp($IO);
1812     if (!$data) {
1813       Imager->_set_error('Could not slurp from buffer');
1814       return undef;
1815     }
1816     ${$opts->{data}} = $data;
1817   }
1818   return 1;
1819 }
1820
1821 # read multiple images from a file
1822 sub read_multi {
1823   my ($class, %opts) = @_;
1824
1825   my ($IO, $file) = $class->_get_reader_io(\%opts, $opts{'type'})
1826     or return;
1827
1828   my $type = $opts{'type'};
1829   unless ($type) {
1830     $type = i_test_format_probe($IO, -1);
1831   }
1832
1833   if ($opts{file} && !$type) {
1834     # guess the type 
1835     $type = $FORMATGUESS->($opts{file});
1836   }
1837
1838   unless ($type) {
1839     $ERRSTR = "No type parameter supplied and it couldn't be guessed";
1840     return;
1841   }
1842
1843   _reader_autoload($type);
1844
1845   if ($readers{$type} && $readers{$type}{multiple}) {
1846     return $readers{$type}{multiple}->($IO, %opts);
1847   }
1848
1849   if ($type eq 'gif') {
1850     my @imgs;
1851     @imgs = i_readgif_multi_wiol($IO);
1852     if (@imgs) {
1853       return map { 
1854         bless { IMG=>$_, DEBUG=>$DEBUG, ERRSTR=>undef }, 'Imager' 
1855       } @imgs;
1856     }
1857     else {
1858       $ERRSTR = _error_as_msg();
1859       return;
1860     }
1861   }
1862   elsif ($type eq 'tiff') {
1863     my @imgs = i_readtiff_multi_wiol($IO, -1);
1864     if (@imgs) {
1865       return map { 
1866         bless { IMG=>$_, DEBUG=>$DEBUG, ERRSTR=>undef }, 'Imager' 
1867       } @imgs;
1868     }
1869     else {
1870       $ERRSTR = _error_as_msg();
1871       return;
1872     }
1873   }
1874   else {
1875     my $img = Imager->new;
1876     if ($img->read(%opts, io => $IO, type => $type)) {
1877       return ( $img );
1878     }
1879   }
1880
1881   $ERRSTR = "Cannot read multiple images from $type files";
1882   return;
1883 }
1884
1885 # Destroy an Imager object
1886
1887 sub DESTROY {
1888   my $self=shift;
1889   #    delete $instances{$self};
1890   if (defined($self->{IMG})) {
1891     # the following is now handled by the XS DESTROY method for
1892     # Imager::ImgRaw object
1893     # Re-enabling this will break virtual images
1894     # tested for in t/t020masked.t
1895     # i_img_destroy($self->{IMG});
1896     undef($self->{IMG});
1897   } else {
1898 #    print "Destroy Called on an empty image!\n"; # why did I put this here??
1899   }
1900 }
1901
1902 # Perform an inplace filter of an image
1903 # that is the image will be overwritten with the data
1904
1905 sub filter {
1906   my $self=shift;
1907   my %input=@_;
1908   my %hsh;
1909   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1910
1911   if (!$input{'type'}) { $self->{ERRSTR}='type parameter missing'; return undef; }
1912
1913   if ( (grep { $_ eq $input{'type'} } keys %filters) != 1) {
1914     $self->{ERRSTR}='type parameter not matching any filter'; return undef;
1915   }
1916
1917   if ($filters{$input{'type'}}{names}) {
1918     my $names = $filters{$input{'type'}}{names};
1919     for my $name (keys %$names) {
1920       if (defined $input{$name} && exists $names->{$name}{$input{$name}}) {
1921         $input{$name} = $names->{$name}{$input{$name}};
1922       }
1923     }
1924   }
1925   if (defined($filters{$input{'type'}}{defaults})) {
1926     %hsh=( image => $self->{IMG},
1927            imager => $self,
1928            %{$filters{$input{'type'}}{defaults}},
1929            %input );
1930   } else {
1931     %hsh=( image => $self->{IMG},
1932            imager => $self,
1933            %input );
1934   }
1935
1936   my @cs=@{$filters{$input{'type'}}{callseq}};
1937
1938   for(@cs) {
1939     if (!defined($hsh{$_})) {
1940       $self->{ERRSTR}="missing parameter '$_' for filter ".$input{'type'}; return undef;
1941     }
1942   }
1943
1944   eval {
1945     local $SIG{__DIE__}; # we don't want this processed by confess, etc
1946     &{$filters{$input{'type'}}{callsub}}(%hsh);
1947   };
1948   if ($@) {
1949     chomp($self->{ERRSTR} = $@);
1950     return;
1951   }
1952
1953   my @b=keys %hsh;
1954
1955   $self->{DEBUG} && print "callseq is: @cs\n";
1956   $self->{DEBUG} && print "matching callseq is: @b\n";
1957
1958   return $self;
1959 }
1960
1961 sub register_filter {
1962   my $class = shift;
1963   my %hsh = ( defaults => {}, @_ );
1964
1965   defined $hsh{type}
1966     or die "register_filter() with no type\n";
1967   defined $hsh{callsub}
1968     or die "register_filter() with no callsub\n";
1969   defined $hsh{callseq}
1970     or die "register_filter() with no callseq\n";
1971
1972   exists $filters{$hsh{type}}
1973     and return;
1974
1975   $filters{$hsh{type}} = \%hsh;
1976
1977   return 1;
1978 }
1979
1980 # Scale an image to requested size and return the scaled version
1981
1982 sub scale {
1983   my $self=shift;
1984   my %opts=('type'=>'max',qtype=>'normal',@_);
1985   my $img = Imager->new();
1986   my $tmp = Imager->new();
1987   my ($x_scale, $y_scale);
1988
1989   unless (defined wantarray) {
1990     my @caller = caller;
1991     warn "scale() called in void context - scale() returns the scaled image at $caller[1] line $caller[2]\n";
1992     return;
1993   }
1994
1995   unless ($self->{IMG}) { 
1996     $self->_set_error('empty input image'); 
1997     return undef;
1998   }
1999
2000   if ($opts{'xscalefactor'} && $opts{'yscalefactor'}) {
2001     $x_scale = $opts{'xscalefactor'};
2002     $y_scale = $opts{'yscalefactor'};
2003   }
2004   elsif ($opts{'xscalefactor'}) {
2005     $x_scale = $opts{'xscalefactor'};
2006     $y_scale = $opts{'scalefactor'} || $x_scale;
2007   }
2008   elsif ($opts{'yscalefactor'}) {
2009     $y_scale = $opts{'yscalefactor'};
2010     $x_scale = $opts{'scalefactor'} || $y_scale;
2011   }
2012   else {
2013     $x_scale = $y_scale = $opts{'scalefactor'} || 0.5;
2014   }
2015
2016   # work out the scaling
2017   if ($opts{xpixels} and $opts{ypixels} and $opts{'type'}) {
2018     my ($xpix, $ypix)=( $opts{xpixels} / $self->getwidth() , 
2019                         $opts{ypixels} / $self->getheight() );
2020     if ($opts{'type'} eq 'min') { 
2021       $x_scale = $y_scale = _min($xpix,$ypix); 
2022     }
2023     elsif ($opts{'type'} eq 'max') {
2024       $x_scale = $y_scale = _max($xpix,$ypix);
2025     }
2026     elsif ($opts{'type'} eq 'nonprop' || $opts{'type'} eq 'non-proportional') {
2027       $x_scale = $xpix;
2028       $y_scale = $ypix;
2029     }
2030     else {
2031       $self->_set_error('invalid value for type parameter');
2032       return undef;
2033     }
2034   } elsif ($opts{xpixels}) { 
2035     $x_scale = $y_scale = $opts{xpixels} / $self->getwidth();
2036   }
2037   elsif ($opts{ypixels}) { 
2038     $x_scale = $y_scale = $opts{ypixels}/$self->getheight();
2039   }
2040   elsif ($opts{constrain} && ref $opts{constrain}
2041          && $opts{constrain}->can('constrain')) {
2042     # we've been passed an Image::Math::Constrain object or something
2043     # that looks like one
2044     my $scalefactor;
2045     (undef, undef, $scalefactor)
2046       = $opts{constrain}->constrain($self->getwidth, $self->getheight);
2047     unless ($scalefactor) {
2048       $self->_set_error('constrain method failed on constrain parameter');
2049       return undef;
2050     }
2051     $x_scale = $y_scale = $scalefactor;
2052   }
2053
2054   if ($opts{qtype} eq 'normal') {
2055     $tmp->{IMG} = i_scaleaxis($self->{IMG}, $x_scale, 0);
2056     if ( !defined($tmp->{IMG}) ) { 
2057       $self->{ERRSTR} = 'unable to scale image';
2058       return undef;
2059     }
2060     $img->{IMG}=i_scaleaxis($tmp->{IMG}, $y_scale, 1);
2061     if ( !defined($img->{IMG}) ) { 
2062       $self->{ERRSTR}='unable to scale image'; 
2063       return undef;
2064     }
2065
2066     return $img;
2067   }
2068   elsif ($opts{'qtype'} eq 'preview') {
2069     $img->{IMG} = i_scale_nn($self->{IMG}, $x_scale, $y_scale); 
2070     if ( !defined($img->{IMG}) ) { 
2071       $self->{ERRSTR}='unable to scale image'; 
2072       return undef;
2073     }
2074     return $img;
2075   }
2076   elsif ($opts{'qtype'} eq 'mixing') {
2077     my $new_width = int(0.5 + $self->getwidth * $x_scale);
2078     my $new_height = int(0.5 + $self->getheight * $y_scale);
2079     $new_width >= 1 or $new_width = 1;
2080     $new_height >= 1 or $new_height = 1;
2081     $img->{IMG} = i_scale_mixing($self->{IMG}, $new_width, $new_height);
2082     unless ($img->{IMG}) {
2083       $self->_set_error(Imager->_error_as_meg);
2084       return;
2085     }
2086     return $img;
2087   }
2088   else {
2089     $self->_set_error('invalid value for qtype parameter');
2090     return undef;
2091   }
2092 }
2093
2094 # Scales only along the X axis
2095
2096 sub scaleX {
2097   my $self = shift;
2098   my %opts = ( scalefactor=>0.5, @_ );
2099
2100   unless (defined wantarray) {
2101     my @caller = caller;
2102     warn "scaleX() called in void context - scaleX() returns the scaled image at $caller[1] line $caller[2]\n";
2103     return;
2104   }
2105
2106   unless ($self->{IMG}) { 
2107     $self->{ERRSTR} = 'empty input image';
2108     return undef;
2109   }
2110
2111   my $img = Imager->new();
2112
2113   my $scalefactor = $opts{scalefactor};
2114
2115   if ($opts{pixels}) { 
2116     $scalefactor = $opts{pixels} / $self->getwidth();
2117   }
2118
2119   unless ($self->{IMG}) { 
2120     $self->{ERRSTR}='empty input image'; 
2121     return undef;
2122   }
2123
2124   $img->{IMG} = i_scaleaxis($self->{IMG}, $scalefactor, 0);
2125
2126   if ( !defined($img->{IMG}) ) { 
2127     $self->{ERRSTR} = 'unable to scale image'; 
2128     return undef;
2129   }
2130
2131   return $img;
2132 }
2133
2134 # Scales only along the Y axis
2135
2136 sub scaleY {
2137   my $self = shift;
2138   my %opts = ( scalefactor => 0.5, @_ );
2139
2140   unless (defined wantarray) {
2141     my @caller = caller;
2142     warn "scaleY() called in void context - scaleY() returns the scaled image at $caller[1] line $caller[2]\n";
2143     return;
2144   }
2145
2146   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2147
2148   my $img = Imager->new();
2149
2150   my $scalefactor = $opts{scalefactor};
2151
2152   if ($opts{pixels}) { 
2153     $scalefactor = $opts{pixels} / $self->getheight();
2154   }
2155
2156   unless ($self->{IMG}) { 
2157     $self->{ERRSTR} = 'empty input image'; 
2158     return undef;
2159   }
2160   $img->{IMG}=i_scaleaxis($self->{IMG}, $scalefactor, 1);
2161
2162   if ( !defined($img->{IMG}) ) {
2163     $self->{ERRSTR} = 'unable to scale image';
2164     return undef;
2165   }
2166
2167   return $img;
2168 }
2169
2170 # Transform returns a spatial transformation of the input image
2171 # this moves pixels to a new location in the returned image.
2172 # NOTE - should make a utility function to check transforms for
2173 # stack overruns
2174
2175 sub transform {
2176   my $self=shift;
2177   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2178   my %opts=@_;
2179   my (@op,@ropx,@ropy,$iop,$or,@parm,$expr,@xt,@yt,@pt,$numre);
2180
2181 #  print Dumper(\%opts);
2182 #  xopcopdes
2183
2184   if ( $opts{'xexpr'} and $opts{'yexpr'} ) {
2185     if (!$I2P) {
2186       eval ("use Affix::Infix2Postfix;");
2187       print $@;
2188       if ( $@ ) {
2189         $self->{ERRSTR}='transform: expr given and Affix::Infix2Postfix is not avaliable.'; 
2190         return undef;
2191       }
2192       $I2P=Affix::Infix2Postfix->new('ops'=>[{op=>'+',trans=>'Add'},
2193                                              {op=>'-',trans=>'Sub'},
2194                                              {op=>'*',trans=>'Mult'},
2195                                              {op=>'/',trans=>'Div'},
2196                                              {op=>'-','type'=>'unary',trans=>'u-'},
2197                                              {op=>'**'},
2198                                              {op=>'func','type'=>'unary'}],
2199                                      'grouping'=>[qw( \( \) )],
2200                                      'func'=>[qw( sin cos )],
2201                                      'vars'=>[qw( x y )]
2202                                     );
2203     }
2204
2205     @xt=$I2P->translate($opts{'xexpr'});
2206     @yt=$I2P->translate($opts{'yexpr'});
2207
2208     $numre=$I2P->{'numre'};
2209     @pt=(0,0);
2210
2211     for(@xt) { if (/$numre/) { push(@pt,$_); push(@{$opts{'xopcodes'}},'Parm',$#pt); } else { push(@{$opts{'xopcodes'}},$_); } }
2212     for(@yt) { if (/$numre/) { push(@pt,$_); push(@{$opts{'yopcodes'}},'Parm',$#pt); } else { push(@{$opts{'yopcodes'}},$_); } }
2213     @{$opts{'parm'}}=@pt;
2214   }
2215
2216 #  print Dumper(\%opts);
2217
2218   if ( !exists $opts{'xopcodes'} or @{$opts{'xopcodes'}}==0) {
2219     $self->{ERRSTR}='transform: no xopcodes given.';
2220     return undef;
2221   }
2222
2223   @op=@{$opts{'xopcodes'}};
2224   for $iop (@op) { 
2225     if (!defined ($OPCODES{$iop}) and ($iop !~ /^\d+$/) ) {
2226       $self->{ERRSTR}="transform: illegal opcode '$_'.";
2227       return undef;
2228     }
2229     push(@ropx,(exists $OPCODES{$iop}) ? @{$OPCODES{$iop}} : $iop );
2230   }
2231
2232
2233 # yopcopdes
2234
2235   if ( !exists $opts{'yopcodes'} or @{$opts{'yopcodes'}}==0) {
2236     $self->{ERRSTR}='transform: no yopcodes given.';
2237     return undef;
2238   }
2239
2240   @op=@{$opts{'yopcodes'}};
2241   for $iop (@op) { 
2242     if (!defined ($OPCODES{$iop}) and ($iop !~ /^\d+$/) ) {
2243       $self->{ERRSTR}="transform: illegal opcode '$_'.";
2244       return undef;
2245     }
2246     push(@ropy,(exists $OPCODES{$iop}) ? @{$OPCODES{$iop}} : $iop );
2247   }
2248
2249 #parameters
2250
2251   if ( !exists $opts{'parm'}) {
2252     $self->{ERRSTR}='transform: no parameter arg given.';
2253     return undef;
2254   }
2255
2256 #  print Dumper(\@ropx);
2257 #  print Dumper(\@ropy);
2258 #  print Dumper(\@ropy);
2259
2260   my $img = Imager->new();
2261   $img->{IMG}=i_transform($self->{IMG},\@ropx,\@ropy,$opts{'parm'});
2262   if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='transform: failed'; return undef; }
2263   return $img;
2264 }
2265
2266
2267 sub transform2 {
2268   my ($opts, @imgs) = @_;
2269   
2270   require "Imager/Expr.pm";
2271
2272   $opts->{variables} = [ qw(x y) ];
2273   my ($width, $height) = @{$opts}{qw(width height)};
2274   if (@imgs) {
2275     $width ||= $imgs[0]->getwidth();
2276     $height ||= $imgs[0]->getheight();
2277     my $img_num = 1;
2278     for my $img (@imgs) {
2279       $opts->{constants}{"w$img_num"} = $img->getwidth();
2280       $opts->{constants}{"h$img_num"} = $img->getheight();
2281       $opts->{constants}{"cx$img_num"} = $img->getwidth()/2;
2282       $opts->{constants}{"cy$img_num"} = $img->getheight()/2;
2283       ++$img_num;
2284     }
2285   }
2286   if ($width) {
2287     $opts->{constants}{w} = $width;
2288     $opts->{constants}{cx} = $width/2;
2289   }
2290   else {
2291     $Imager::ERRSTR = "No width supplied";
2292     return;
2293   }
2294   if ($height) {
2295     $opts->{constants}{h} = $height;
2296     $opts->{constants}{cy} = $height/2;
2297   }
2298   else {
2299     $Imager::ERRSTR = "No height supplied";
2300     return;
2301   }
2302   my $code = Imager::Expr->new($opts);
2303   if (!$code) {
2304     $Imager::ERRSTR = Imager::Expr::error();
2305     return;
2306   }
2307   my $channels = $opts->{channels} || 3;
2308   unless ($channels >= 1 && $channels <= 4) {
2309     return Imager->_set_error("channels must be an integer between 1 and 4");
2310   }
2311
2312   my $img = Imager->new();
2313   $img->{IMG} = i_transform2($opts->{width}, $opts->{height}, 
2314                              $channels, $code->code(),
2315                              $code->nregs(), $code->cregs(),
2316                              [ map { $_->{IMG} } @imgs ]);
2317   if (!defined $img->{IMG}) {
2318     $Imager::ERRSTR = Imager->_error_as_msg();
2319     return;
2320   }
2321
2322   return $img;
2323 }
2324
2325 sub rubthrough {
2326   my $self=shift;
2327   my %opts=(tx => 0,ty => 0, @_);
2328
2329   unless ($self->{IMG}) { 
2330     $self->{ERRSTR}='empty input image'; 
2331     return undef;
2332   }
2333   unless ($opts{src} && $opts{src}->{IMG}) {
2334     $self->{ERRSTR}='empty input image for src'; 
2335     return undef;
2336   }
2337
2338   %opts = (src_minx => 0,
2339            src_miny => 0,
2340            src_maxx => $opts{src}->getwidth(),
2341            src_maxy => $opts{src}->getheight(),
2342            %opts);
2343
2344   unless (i_rubthru($self->{IMG}, $opts{src}->{IMG}, $opts{tx}, $opts{ty},
2345                     $opts{src_minx}, $opts{src_miny}, 
2346                     $opts{src_maxx}, $opts{src_maxy})) {
2347     $self->_set_error($self->_error_as_msg());
2348     return undef;
2349   }
2350   return $self;
2351 }
2352
2353
2354 sub flip {
2355   my $self  = shift;
2356   my %opts  = @_;
2357   my %xlate = (h=>0, v=>1, hv=>2, vh=>2);
2358   my $dir;
2359   return () unless defined $opts{'dir'} and defined $xlate{$opts{'dir'}};
2360   $dir = $xlate{$opts{'dir'}};
2361   return $self if i_flipxy($self->{IMG}, $dir);
2362   return ();
2363 }
2364
2365 sub rotate {
2366   my $self = shift;
2367   my %opts = @_;
2368
2369   unless (defined wantarray) {
2370     my @caller = caller;
2371     warn "rotate() called in void context - rotate() returns the rotated image at $caller[1] line $caller[2]\n";
2372     return;
2373   }
2374
2375   if (defined $opts{right}) {
2376     my $degrees = $opts{right};
2377     if ($degrees < 0) {
2378       $degrees += 360 * int(((-$degrees)+360)/360);
2379     }
2380     $degrees = $degrees % 360;
2381     if ($degrees == 0) {
2382       return $self->copy();
2383     }
2384     elsif ($degrees == 90 || $degrees == 180 || $degrees == 270) {
2385       my $result = Imager->new();
2386       if ($result->{IMG} = i_rotate90($self->{IMG}, $degrees)) {
2387         return $result;
2388       }
2389       else {
2390         $self->{ERRSTR} = $self->_error_as_msg();
2391         return undef;
2392       }
2393     }
2394     else {
2395       $self->{ERRSTR} = "Parameter 'right' must be a multiple of 90 degrees";
2396       return undef;
2397     }
2398   }
2399   elsif (defined $opts{radians} || defined $opts{degrees}) {
2400     my $amount = $opts{radians} || $opts{degrees} * 3.1415926535 / 180;
2401
2402     my $back = $opts{back};
2403     my $result = Imager->new;
2404     if ($back) {
2405       $back = _color($back);
2406       unless ($back) {
2407         $self->_set_error(Imager->errstr);
2408         return undef;
2409       }
2410
2411       $result->{IMG} = i_rotate_exact($self->{IMG}, $amount, $back);
2412     }
2413     else {
2414       $result->{IMG} = i_rotate_exact($self->{IMG}, $amount);
2415     }
2416     if ($result->{IMG}) {
2417       return $result;
2418     }
2419     else {
2420       $self->{ERRSTR} = $self->_error_as_msg();
2421       return undef;
2422     }
2423   }
2424   else {
2425     $self->{ERRSTR} = "Only the 'right', 'radians' and 'degrees' parameters are available";
2426     return undef;
2427   }
2428 }
2429
2430 sub matrix_transform {
2431   my $self = shift;
2432   my %opts = @_;
2433
2434   unless (defined wantarray) {
2435     my @caller = caller;
2436     warn "copy() called in void context - copy() returns the copied image at $caller[1] line $caller[2]\n";
2437     return;
2438   }
2439
2440   if ($opts{matrix}) {
2441     my $xsize = $opts{xsize} || $self->getwidth;
2442     my $ysize = $opts{ysize} || $self->getheight;
2443
2444     my $result = Imager->new;
2445     if ($opts{back}) {
2446       $result->{IMG} = i_matrix_transform($self->{IMG}, $xsize, $ysize, 
2447                                           $opts{matrix}, $opts{back})
2448         or return undef;
2449     }
2450     else {
2451       $result->{IMG} = i_matrix_transform($self->{IMG}, $xsize, $ysize, 
2452                                           $opts{matrix})
2453         or return undef;
2454     }
2455
2456     return $result;
2457   }
2458   else {
2459     $self->{ERRSTR} = "matrix parameter required";
2460     return undef;
2461   }
2462 }
2463
2464 # blame Leolo :)
2465 *yatf = \&matrix_transform;
2466
2467 # These two are supported for legacy code only
2468
2469 sub i_color_new {
2470   return Imager::Color->new(@_);
2471 }
2472
2473 sub i_color_set {
2474   return Imager::Color::set(@_);
2475 }
2476
2477 # Draws a box between the specified corner points.
2478 sub box {
2479   my $self=shift;
2480   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2481   my $dflcl=i_color_new(255,255,255,255);
2482   my %opts=(color=>$dflcl,xmin=>0,ymin=>0,xmax=>$self->getwidth()-1,ymax=>$self->getheight()-1,@_);
2483
2484   if (exists $opts{'box'}) { 
2485     $opts{'xmin'} = _min($opts{'box'}->[0],$opts{'box'}->[2]);
2486     $opts{'xmax'} = _max($opts{'box'}->[0],$opts{'box'}->[2]);
2487     $opts{'ymin'} = _min($opts{'box'}->[1],$opts{'box'}->[3]);
2488     $opts{'ymax'} = _max($opts{'box'}->[1],$opts{'box'}->[3]);
2489   }
2490
2491   if ($opts{filled}) { 
2492     my $color = _color($opts{'color'});
2493     unless ($color) { 
2494       $self->{ERRSTR} = $Imager::ERRSTR; 
2495       return; 
2496     }
2497     i_box_filled($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},
2498                  $opts{ymax}, $color); 
2499   }
2500   elsif ($opts{fill}) {
2501     unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
2502       # assume it's a hash ref
2503       require 'Imager/Fill.pm';
2504       unless ($opts{fill} = Imager::Fill->new(%{$opts{fill}})) {
2505         $self->{ERRSTR} = $Imager::ERRSTR;
2506         return undef;
2507       }
2508     }
2509     i_box_cfill($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},
2510                 $opts{ymax},$opts{fill}{fill});
2511   }
2512   else {
2513     my $color = _color($opts{'color'});
2514     unless ($color) { 
2515       $self->{ERRSTR} = $Imager::ERRSTR;
2516       return;
2517     }
2518     i_box($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},$opts{ymax},
2519           $color);
2520   }
2521   return $self;
2522 }
2523
2524 sub arc {
2525   my $self=shift;
2526   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2527   my $dflcl=i_color_new(255,255,255,255);
2528   my %opts=(color=>$dflcl,
2529             'r'=>_min($self->getwidth(),$self->getheight())/3,
2530             'x'=>$self->getwidth()/2,
2531             'y'=>$self->getheight()/2,
2532             'd1'=>0, 'd2'=>361, @_);
2533   if ($opts{aa}) {
2534     if ($opts{fill}) {
2535       unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
2536         # assume it's a hash ref
2537         require 'Imager/Fill.pm';
2538         unless ($opts{fill} = Imager::Fill->new(%{$opts{fill}})) {
2539           $self->{ERRSTR} = $Imager::ERRSTR;
2540           return;
2541         }
2542       }
2543       i_arc_aa_cfill($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},$opts{'d1'},
2544                      $opts{'d2'}, $opts{fill}{fill});
2545     }
2546     else {
2547       my $color = _color($opts{'color'});
2548       unless ($color) { 
2549         $self->{ERRSTR} = $Imager::ERRSTR; 
2550         return; 
2551       }
2552       if ($opts{d1} == 0 && $opts{d2} == 361 && $opts{aa}) {
2553         i_circle_aa($self->{IMG}, $opts{'x'}, $opts{'y'}, $opts{'r'}, 
2554                     $color);
2555       }
2556       else {
2557         i_arc_aa($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},
2558                  $opts{'d1'}, $opts{'d2'}, $color); 
2559       }
2560     }
2561   }
2562   else {
2563     if ($opts{fill}) {
2564       unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
2565         # assume it's a hash ref
2566         require 'Imager/Fill.pm';
2567         unless ($opts{fill} = Imager::Fill->new(%{$opts{fill}})) {
2568           $self->{ERRSTR} = $Imager::ERRSTR;
2569           return;
2570         }
2571       }
2572       i_arc_cfill($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},$opts{'d1'},
2573                   $opts{'d2'}, $opts{fill}{fill});
2574     }
2575     else {
2576       my $color = _color($opts{'color'});
2577       unless ($color) { 
2578         $self->{ERRSTR} = $Imager::ERRSTR; 
2579         return; 
2580       }
2581       i_arc($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},
2582             $opts{'d1'}, $opts{'d2'}, $color); 
2583     }
2584   }
2585
2586   return $self;
2587 }
2588
2589 # Draws a line from one point to the other
2590 # the endpoint is set if the endp parameter is set which it is by default.
2591 # to turn of the endpoint being set use endp=>0 when calling line.
2592
2593 sub line {
2594   my $self=shift;
2595   my $dflcl=i_color_new(0,0,0,0);
2596   my %opts=(color=>$dflcl,
2597             endp => 1,
2598             @_);
2599   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2600
2601   unless (exists $opts{x1} and exists $opts{y1}) { $self->{ERRSTR}='missing begining coord'; return undef; }
2602   unless (exists $opts{x2} and exists $opts{y2}) { $self->{ERRSTR}='missing ending coord'; return undef; }
2603
2604   my $color = _color($opts{'color'});
2605   unless ($color) {
2606     $self->{ERRSTR} = $Imager::ERRSTR;
2607     return;
2608   }
2609
2610   $opts{antialias} = $opts{aa} if defined $opts{aa};
2611   if ($opts{antialias}) {
2612     i_line_aa($self->{IMG},$opts{x1}, $opts{y1}, $opts{x2}, $opts{y2},
2613               $color, $opts{endp});
2614   } else {
2615     i_line($self->{IMG},$opts{x1}, $opts{y1}, $opts{x2}, $opts{y2},
2616            $color, $opts{endp});
2617   }
2618   return $self;
2619 }
2620
2621 # Draws a line between an ordered set of points - It more or less just transforms this
2622 # into a list of lines.
2623
2624 sub polyline {
2625   my $self=shift;
2626   my ($pt,$ls,@points);
2627   my $dflcl=i_color_new(0,0,0,0);
2628   my %opts=(color=>$dflcl,@_);
2629
2630   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2631
2632   if (exists($opts{points})) { @points=@{$opts{points}}; }
2633   if (!exists($opts{points}) and exists($opts{'x'}) and exists($opts{'y'}) ) {
2634     @points=map { [ $opts{'x'}->[$_],$opts{'y'}->[$_] ] } (0..(scalar @{$opts{'x'}}-1));
2635     }
2636
2637 #  print Dumper(\@points);
2638
2639   my $color = _color($opts{'color'});
2640   unless ($color) { 
2641     $self->{ERRSTR} = $Imager::ERRSTR; 
2642     return; 
2643   }
2644   $opts{antialias} = $opts{aa} if defined $opts{aa};
2645   if ($opts{antialias}) {
2646     for $pt(@points) {
2647       if (defined($ls)) { 
2648         i_line_aa($self->{IMG},$ls->[0],$ls->[1],$pt->[0],$pt->[1],$color, 1);
2649       }
2650       $ls=$pt;
2651     }
2652   } else {
2653     for $pt(@points) {
2654       if (defined($ls)) { 
2655         i_line($self->{IMG},$ls->[0],$ls->[1],$pt->[0],$pt->[1],$color,1);
2656       }
2657       $ls=$pt;
2658     }
2659   }
2660   return $self;
2661 }
2662
2663 sub polygon {
2664   my $self = shift;
2665   my ($pt,$ls,@points);
2666   my $dflcl = i_color_new(0,0,0,0);
2667   my %opts = (color=>$dflcl, @_);
2668
2669   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2670
2671   if (exists($opts{points})) {
2672     $opts{'x'} = [ map { $_->[0] } @{$opts{points}} ];
2673     $opts{'y'} = [ map { $_->[1] } @{$opts{points}} ];
2674   }
2675
2676   if (!exists $opts{'x'} or !exists $opts{'y'})  {
2677     $self->{ERRSTR} = 'no points array, or x and y arrays.'; return undef;
2678   }
2679
2680   if ($opts{'fill'}) {
2681     unless (UNIVERSAL::isa($opts{'fill'}, 'Imager::Fill')) {
2682       # assume it's a hash ref
2683       require 'Imager/Fill.pm';
2684       unless ($opts{'fill'} = Imager::Fill->new(%{$opts{'fill'}})) {
2685         $self->{ERRSTR} = $Imager::ERRSTR;
2686         return undef;
2687       }
2688     }
2689     i_poly_aa_cfill($self->{IMG}, $opts{'x'}, $opts{'y'}, 
2690                     $opts{'fill'}{'fill'});
2691   }
2692   else {
2693     my $color = _color($opts{'color'});
2694     unless ($color) { 
2695       $self->{ERRSTR} = $Imager::ERRSTR; 
2696       return; 
2697     }
2698     i_poly_aa($self->{IMG}, $opts{'x'}, $opts{'y'}, $color);
2699   }
2700
2701   return $self;
2702 }
2703
2704
2705 # this the multipoint bezier curve
2706 # this is here more for testing that actual usage since
2707 # this is not a good algorithm.  Usually the curve would be
2708 # broken into smaller segments and each done individually.
2709
2710 sub polybezier {
2711   my $self=shift;
2712   my ($pt,$ls,@points);
2713   my $dflcl=i_color_new(0,0,0,0);
2714   my %opts=(color=>$dflcl,@_);
2715
2716   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2717
2718   if (exists $opts{points}) {
2719     $opts{'x'}=map { $_->[0]; } @{$opts{'points'}};
2720     $opts{'y'}=map { $_->[1]; } @{$opts{'points'}};
2721   }
2722
2723   unless ( @{$opts{'x'}} and @{$opts{'x'}} == @{$opts{'y'}} ) {
2724     $self->{ERRSTR}='Missing or invalid points.';
2725     return;
2726   }
2727
2728   my $color = _color($opts{'color'});
2729   unless ($color) { 
2730     $self->{ERRSTR} = $Imager::ERRSTR; 
2731     return; 
2732   }
2733   i_bezier_multi($self->{IMG},$opts{'x'},$opts{'y'},$color);
2734   return $self;
2735 }
2736
2737 sub flood_fill {
2738   my $self = shift;
2739   my %opts = ( color=>Imager::Color->new(255, 255, 255), @_ );
2740   my $rc;
2741
2742   unless (exists $opts{'x'} && exists $opts{'y'}) {
2743     $self->{ERRSTR} = "missing seed x and y parameters";
2744     return undef;
2745   }
2746
2747   if ($opts{border}) {
2748     my $border = _color($opts{border});
2749     unless ($border) {
2750       $self->_set_error($Imager::ERRSTR);
2751       return;
2752     }
2753     if ($opts{fill}) {
2754       unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
2755         # assume it's a hash ref
2756         require Imager::Fill;
2757         unless ($opts{fill} = Imager::Fill->new(%{$opts{fill}})) {
2758           $self->{ERRSTR} = $Imager::ERRSTR;
2759           return;
2760         }
2761       }
2762       $rc = i_flood_cfill_border($self->{IMG}, $opts{'x'}, $opts{'y'}, 
2763                                  $opts{fill}{fill}, $border);
2764     }
2765     else {
2766       my $color = _color($opts{'color'});
2767       unless ($color) {
2768         $self->{ERRSTR} = $Imager::ERRSTR;
2769         return;
2770       }
2771       $rc = i_flood_fill_border($self->{IMG}, $opts{'x'}, $opts{'y'}, 
2772                                 $color, $border);
2773     }
2774     if ($rc) { 
2775       return $self; 
2776     } 
2777     else { 
2778       $self->{ERRSTR} = $self->_error_as_msg(); 
2779       return;
2780     }
2781   }
2782   else {
2783     if ($opts{fill}) {
2784       unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
2785         # assume it's a hash ref
2786         require 'Imager/Fill.pm';
2787         unless ($opts{fill} = Imager::Fill->new(%{$opts{fill}})) {
2788           $self->{ERRSTR} = $Imager::ERRSTR;
2789           return;
2790         }
2791       }
2792       $rc = i_flood_cfill($self->{IMG}, $opts{'x'}, $opts{'y'}, $opts{fill}{fill});
2793     }
2794     else {
2795       my $color = _color($opts{'color'});
2796       unless ($color) {
2797         $self->{ERRSTR} = $Imager::ERRSTR;
2798         return;
2799       }
2800       $rc = i_flood_fill($self->{IMG}, $opts{'x'}, $opts{'y'}, $color);
2801     }
2802     if ($rc) { 
2803       return $self; 
2804     } 
2805     else { 
2806       $self->{ERRSTR} = $self->_error_as_msg(); 
2807       return;
2808     }
2809   } 
2810 }
2811
2812 sub setpixel {
2813   my $self = shift;
2814
2815   my %opts = ( color=>$self->{fg} || NC(255, 255, 255), @_);
2816
2817   unless (exists $opts{'x'} && exists $opts{'y'}) {
2818     $self->{ERRSTR} = 'missing x and y parameters';
2819     return undef;
2820   }
2821
2822   my $x = $opts{'x'};
2823   my $y = $opts{'y'};
2824   my $color = _color($opts{color})
2825     or return undef;
2826   if (ref $x && ref $y) {
2827     unless (@$x == @$y) {
2828       $self->{ERRSTR} = 'length of x and y mismatch';
2829       return undef;
2830     }
2831     if ($color->isa('Imager::Color')) {
2832       for my $i (0..$#{$opts{'x'}}) {
2833         i_ppix($self->{IMG}, $x->[$i], $y->[$i], $color);
2834       }
2835     }
2836     else {
2837       for my $i (0..$#{$opts{'x'}}) {
2838         i_ppixf($self->{IMG}, $x->[$i], $y->[$i], $color);
2839       }
2840     }
2841   }
2842   else {
2843     if ($color->isa('Imager::Color')) {
2844       i_ppix($self->{IMG}, $x, $y, $color);
2845     }
2846     else {
2847       i_ppixf($self->{IMG}, $x, $y, $color);
2848     }
2849   }
2850
2851   $self;
2852 }
2853
2854 sub getpixel {
2855   my $self = shift;
2856
2857   my %opts = ( "type"=>'8bit', @_);
2858
2859   unless (exists $opts{'x'} && exists $opts{'y'}) {
2860     $self->{ERRSTR} = 'missing x and y parameters';
2861     return undef;
2862   }
2863
2864   my $x = $opts{'x'};
2865   my $y = $opts{'y'};
2866   if (ref $x && ref $y) {
2867     unless (@$x == @$y) {
2868       $self->{ERRSTR} = 'length of x and y mismatch';
2869       return undef;
2870     }
2871     my @result;
2872     if ($opts{"type"} eq '8bit') {
2873       for my $i (0..$#{$opts{'x'}}) {
2874         push(@result, i_get_pixel($self->{IMG}, $x->[$i], $y->[$i]));
2875       }
2876     }
2877     else {
2878       for my $i (0..$#{$opts{'x'}}) {
2879         push(@result, i_gpixf($self->{IMG}, $x->[$i], $y->[$i]));
2880       }
2881     }
2882     return wantarray ? @result : \@result;
2883   }
2884   else {
2885     if ($opts{"type"} eq '8bit') {
2886       return i_get_pixel($self->{IMG}, $x, $y);
2887     }
2888     else {
2889       return i_gpixf($self->{IMG}, $x, $y);
2890     }
2891   }
2892
2893   $self;
2894 }
2895
2896 sub getscanline {
2897   my $self = shift;
2898   my %opts = ( type => '8bit', x=>0, @_);
2899
2900   $self->_valid_image or return;
2901
2902   defined $opts{width} or $opts{width} = $self->getwidth - $opts{x};
2903
2904   unless (defined $opts{'y'}) {
2905     $self->_set_error("missing y parameter");
2906     return;
2907   }
2908
2909   if ($opts{type} eq '8bit') {
2910     return i_glin($self->{IMG}, $opts{x}, $opts{x}+$opts{width},
2911                   $opts{'y'});
2912   }
2913   elsif ($opts{type} eq 'float') {
2914     return i_glinf($self->{IMG}, $opts{x}, $opts{x}+$opts{width},
2915                   $opts{'y'});
2916   }
2917   elsif ($opts{type} eq 'index') {
2918     unless (i_img_type($self->{IMG})) {
2919       $self->_set_error("type => index only valid on paletted images");
2920       return;
2921     }
2922     return i_gpal($self->{IMG}, $opts{x}, $opts{x} + $opts{width},
2923                   $opts{'y'});
2924   }
2925   else {
2926     $self->_set_error("invalid type parameter - must be '8bit' or 'float'");
2927     return;
2928   }
2929 }
2930
2931 sub setscanline {
2932   my $self = shift;
2933   my %opts = ( x=>0, @_);
2934
2935   $self->_valid_image or return;
2936
2937   unless (defined $opts{'y'}) {
2938     $self->_set_error("missing y parameter");
2939     return;
2940   }
2941
2942   if (!$opts{type}) {
2943     if (ref $opts{pixels} && @{$opts{pixels}}) {
2944       # try to guess the type
2945       if ($opts{pixels}[0]->isa('Imager::Color')) {
2946         $opts{type} = '8bit';
2947       }
2948       elsif ($opts{pixels}[0]->isa('Imager::Color::Float')) {
2949         $opts{type} = 'float';
2950       }
2951       else {
2952         $self->_set_error("missing type parameter and could not guess from pixels");
2953         return;
2954       }
2955     }
2956     else {
2957       # default
2958       $opts{type} = '8bit';
2959     }
2960   }
2961
2962   if ($opts{type} eq '8bit') {
2963     if (ref $opts{pixels}) {
2964       return i_plin($self->{IMG}, $opts{x}, $opts{'y'}, @{$opts{pixels}});
2965     }
2966     else {
2967       return i_plin($self->{IMG}, $opts{x}, $opts{'y'}, $opts{pixels});
2968     }
2969   }
2970   elsif ($opts{type} eq 'float') {
2971     if (ref $opts{pixels}) {
2972       return i_plinf($self->{IMG}, $opts{x}, $opts{'y'}, @{$opts{pixels}});
2973     }
2974     else {
2975       return i_plinf($self->{IMG}, $opts{x}, $opts{'y'}, $opts{pixels});
2976     }
2977   }
2978   elsif ($opts{type} eq 'index') {
2979     if (ref $opts{pixels}) {
2980       return i_ppal($self->{IMG}, $opts{x}, $opts{'y'}, @{$opts{pixels}});
2981     }
2982     else {
2983       return i_ppal_p($self->{IMG}, $opts{x}, $opts{'y'}, $opts{pixels});
2984     }
2985   }
2986   else {
2987     $self->_set_error("invalid type parameter - must be '8bit' or 'float'");
2988     return;
2989   }
2990 }
2991
2992 sub getsamples {
2993   my $self = shift;
2994   my %opts = ( type => '8bit', x=>0, @_);
2995
2996   defined $opts{width} or $opts{width} = $self->getwidth - $opts{x};
2997
2998   unless (defined $opts{'y'}) {
2999     $self->_set_error("missing y parameter");
3000     return;
3001   }
3002   
3003   unless ($opts{channels}) {
3004     $opts{channels} = [ 0 .. $self->getchannels()-1 ];
3005   }
3006
3007   if ($opts{type} eq '8bit') {
3008     return i_gsamp($self->{IMG}, $opts{x}, $opts{x}+$opts{width},
3009                    $opts{y}, @{$opts{channels}});
3010   }
3011   elsif ($opts{type} eq 'float') {
3012     return i_gsampf($self->{IMG}, $opts{x}, $opts{x}+$opts{width},
3013                     $opts{y}, @{$opts{channels}});
3014   }
3015   else {
3016     $self->_set_error("invalid type parameter - must be '8bit' or 'float'");
3017     return;
3018   }
3019 }
3020
3021 # make an identity matrix of the given size
3022 sub _identity {
3023   my ($size) = @_;
3024
3025   my $matrix = [ map { [ (0) x $size ] } 1..$size ];
3026   for my $c (0 .. ($size-1)) {
3027     $matrix->[$c][$c] = 1;
3028   }
3029   return $matrix;
3030 }
3031
3032 # general function to convert an image
3033 sub convert {
3034   my ($self, %opts) = @_;
3035   my $matrix;
3036
3037   unless (defined wantarray) {
3038     my @caller = caller;
3039     warn "convert() called in void context - convert() returns the converted image at $caller[1] line $caller[2]\n";
3040     return;
3041   }
3042
3043   # the user can either specify a matrix or preset
3044   # the matrix overrides the preset
3045   if (!exists($opts{matrix})) {
3046     unless (exists($opts{preset})) {
3047       $self->{ERRSTR} = "convert() needs a matrix or preset";
3048       return;
3049     }
3050     else {
3051       if ($opts{preset} eq 'gray' || $opts{preset} eq 'grey') {
3052         # convert to greyscale, keeping the alpha channel if any
3053         if ($self->getchannels == 3) {
3054           $matrix = [ [ 0.222, 0.707, 0.071 ] ];
3055         }
3056         elsif ($self->getchannels == 4) {
3057           # preserve the alpha channel
3058           $matrix = [ [ 0.222, 0.707, 0.071, 0 ],
3059                       [ 0,     0,     0,     1 ] ];
3060         }
3061         else {
3062           # an identity
3063           $matrix = _identity($self->getchannels);
3064         }
3065       }
3066       elsif ($opts{preset} eq 'noalpha') {
3067         # strip the alpha channel
3068         if ($self->getchannels == 2 or $self->getchannels == 4) {
3069           $matrix = _identity($self->getchannels);
3070           pop(@$matrix); # lose the alpha entry
3071         }
3072         else {
3073           $matrix = _identity($self->getchannels);
3074         }
3075       }
3076       elsif ($opts{preset} eq 'red' || $opts{preset} eq 'channel0') {
3077         # extract channel 0
3078         $matrix = [ [ 1 ] ];
3079       }
3080       elsif ($opts{preset} eq 'green' || $opts{preset} eq 'channel1') {
3081         $matrix = [ [ 0, 1 ] ];
3082       }
3083       elsif ($opts{preset} eq 'blue' || $opts{preset} eq 'channel2') {
3084         $matrix = [ [ 0, 0, 1 ] ];
3085       }
3086       elsif ($opts{preset} eq 'alpha') {
3087         if ($self->getchannels == 2 or $self->getchannels == 4) {
3088           $matrix = [ [ (0) x ($self->getchannels-1), 1 ] ];
3089         }
3090         else {
3091           # the alpha is just 1 <shrug>
3092           $matrix = [ [ (0) x $self->getchannels, 1 ] ];
3093         }
3094       }
3095       elsif ($opts{preset} eq 'rgb') {
3096         if ($self->getchannels == 1) {
3097           $matrix = [ [ 1 ], [ 1 ], [ 1 ] ];
3098         }
3099         elsif ($self->getchannels == 2) {
3100           # preserve the alpha channel
3101           $matrix = [ [ 1, 0 ], [ 1, 0 ], [ 1, 0 ], [ 0, 1 ] ];
3102         }
3103         else {
3104           $matrix = _identity($self->getchannels);
3105         }
3106       }
3107       elsif ($opts{preset} eq 'addalpha') {
3108         if ($self->getchannels == 1) {
3109           $matrix = _identity(2);
3110         }
3111         elsif ($self->getchannels == 3) {
3112           $matrix = _identity(4);
3113         }
3114         else {
3115           $matrix = _identity($self->getchannels);
3116         }
3117       }
3118       else {
3119         $self->{ERRSTR} = "Unknown convert preset $opts{preset}";
3120         return undef;
3121       }
3122     }
3123   }
3124   else {
3125     $matrix = $opts{matrix};
3126   }
3127
3128   my $new = Imager->new();
3129   $new->{IMG} = i_img_new();
3130   unless (i_convert($new->{IMG}, $self->{IMG}, $matrix)) {
3131     # most likely a bad matrix
3132     $self->{ERRSTR} = _error_as_msg();
3133     return undef;
3134   }
3135   return $new;
3136 }
3137
3138
3139 # general function to map an image through lookup tables
3140
3141 sub map {
3142   my ($self, %opts) = @_;
3143   my @chlist = qw( red green blue alpha );
3144
3145   if (!exists($opts{'maps'})) {
3146     # make maps from channel maps
3147     my $chnum;
3148     for $chnum (0..$#chlist) {
3149       if (exists $opts{$chlist[$chnum]}) {
3150         $opts{'maps'}[$chnum] = $opts{$chlist[$chnum]};
3151       } elsif (exists $opts{'all'}) {
3152         $opts{'maps'}[$chnum] = $opts{'all'};
3153       }
3154     }
3155   }
3156   if ($opts{'maps'} and $self->{IMG}) {
3157     i_map($self->{IMG}, $opts{'maps'} );
3158   }
3159   return $self;
3160 }
3161
3162 sub difference {
3163   my ($self, %opts) = @_;
3164
3165   defined $opts{mindist} or $opts{mindist} = 0;
3166
3167   defined $opts{other}
3168     or return $self->_set_error("No 'other' parameter supplied");
3169   defined $opts{other}{IMG}
3170     or return $self->_set_error("No image data in 'other' image");
3171
3172   $self->{IMG}
3173     or return $self->_set_error("No image data");
3174
3175   my $result = Imager->new;
3176   $result->{IMG} = i_diff_image($self->{IMG}, $opts{other}{IMG}, 
3177                                 $opts{mindist})
3178     or return $self->_set_error($self->_error_as_msg());
3179
3180   return $result;
3181 }
3182
3183 # destructive border - image is shrunk by one pixel all around
3184
3185 sub border {
3186   my ($self,%opts)=@_;
3187   my($tx,$ty)=($self->getwidth()-1,$self->getheight()-1);
3188   $self->polyline('x'=>[0,$tx,$tx,0,0],'y'=>[0,0,$ty,$ty,0],%opts);
3189 }
3190
3191
3192 # Get the width of an image
3193
3194 sub getwidth {
3195   my $self = shift;
3196   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
3197   return (i_img_info($self->{IMG}))[0];
3198 }
3199
3200 # Get the height of an image
3201
3202 sub getheight {
3203   my $self = shift;
3204   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
3205   return (i_img_info($self->{IMG}))[1];
3206 }
3207
3208 # Get number of channels in an image
3209
3210 sub getchannels {
3211   my $self = shift;
3212   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
3213   return i_img_getchannels($self->{IMG});
3214 }
3215
3216 # Get channel mask
3217
3218 sub getmask {
3219   my $self = shift;
3220   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
3221   return i_img_getmask($self->{IMG});
3222 }
3223
3224 # Set channel mask
3225
3226 sub setmask {
3227   my $self = shift;
3228   my %opts = @_;
3229   if (!defined($self->{IMG})) { 
3230     $self->{ERRSTR} = 'image is empty';
3231     return undef;
3232   }
3233   unless (defined $opts{mask}) {
3234     $self->_set_error("mask parameter required");
3235     return;
3236   }
3237   i_img_setmask( $self->{IMG} , $opts{mask} );
3238
3239   1;
3240 }
3241
3242 # Get number of colors in an image
3243
3244 sub getcolorcount {
3245   my $self=shift;
3246   my %opts=('maxcolors'=>2**30,@_);
3247   if (!defined($self->{IMG})) { $self->{ERRSTR}='image is empty'; return undef; }
3248   my $rc=i_count_colors($self->{IMG},$opts{'maxcolors'});
3249   return ($rc==-1? undef : $rc);
3250 }
3251
3252 # draw string to an image
3253
3254 sub string {
3255   my $self = shift;
3256   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
3257
3258   my %input=('x'=>0, 'y'=>0, @_);
3259   defined($input{string}) or $input{string} = $input{text};
3260
3261   unless(defined $input{string}) {
3262     $self->{ERRSTR}="missing required parameter 'string'";
3263     return;
3264   }
3265
3266   unless($input{font}) {
3267     $self->{ERRSTR}="missing required parameter 'font'";
3268     return;
3269   }
3270
3271   unless ($input{font}->draw(image=>$self, %input)) {
3272     return;
3273   }
3274
3275   return $self;
3276 }
3277
3278 sub align_string {
3279   my $self = shift;
3280
3281   my $img;
3282   if (ref $self) {
3283     unless ($self->{IMG}) { 
3284       $self->{ERRSTR}='empty input image'; 
3285       return;
3286     }
3287     $img = $self;
3288   }
3289   else {
3290     $img = undef;
3291   }
3292
3293   my %input=('x'=>0, 'y'=>0, @_);
3294   $input{string}||=$input{text};
3295
3296   unless(exists $input{string}) {
3297     $self->_set_error("missing required parameter 'string'");
3298     return;
3299   }
3300
3301   unless($input{font}) {
3302     $self->_set_error("missing required parameter 'font'");
3303     return;
3304   }
3305
3306   my @result;
3307   unless (@result = $input{font}->align(image=>$img, %input)) {
3308     return;
3309   }
3310
3311   return wantarray ? @result : $result[0];
3312 }
3313
3314 my @file_limit_names = qw/width height bytes/;
3315
3316 sub set_file_limits {
3317   shift;
3318
3319   my %opts = @_;
3320   my %values;
3321   
3322   if ($opts{reset}) {
3323     @values{@file_limit_names} = (0) x @file_limit_names;
3324   }
3325   else {
3326     @values{@file_limit_names} = i_get_image_file_limits();
3327   }
3328
3329   for my $key (keys %values) {
3330     defined $opts{$key} and $values{$key} = $opts{$key};
3331   }
3332
3333   i_set_image_file_limits($values{width}, $values{height}, $values{bytes});
3334 }
3335
3336 sub get_file_limits {
3337   i_get_image_file_limits();
3338 }
3339
3340 # Shortcuts that can be exported
3341
3342 sub newcolor { Imager::Color->new(@_); }
3343 sub newfont  { Imager::Font->new(@_); }
3344
3345 *NC=*newcolour=*newcolor;
3346 *NF=*newfont;
3347
3348 *open=\&read;
3349 *circle=\&arc;
3350
3351
3352 #### Utility routines
3353
3354 sub errstr { 
3355   ref $_[0] ? $_[0]->{ERRSTR} : $ERRSTR
3356 }
3357
3358 sub _set_error {
3359   my ($self, $msg) = @_;
3360
3361   if (ref $self) {
3362     $self->{ERRSTR} = $msg;
3363   }
3364   else {
3365     $ERRSTR = $msg;
3366   }
3367   return;
3368 }
3369
3370 # Default guess for the type of an image from extension
3371
3372 sub def_guess_type {
3373   my $name=lc(shift);
3374   my $ext;
3375   $ext=($name =~ m/\.([^\.]+)$/)[0];
3376   return 'tiff' if ($ext =~ m/^tiff?$/);
3377   return 'jpeg' if ($ext =~ m/^jpe?g$/);
3378   return 'pnm'  if ($ext =~ m/^p[pgb]m$/);
3379   return 'png'  if ($ext eq "png");
3380   return 'bmp'  if ($ext eq "bmp" || $ext eq "dib");
3381   return 'tga'  if ($ext eq "tga");
3382   return 'rgb'  if ($ext eq "rgb");
3383   return 'gif'  if ($ext eq "gif");
3384   return 'raw'  if ($ext eq "raw");
3385   return lc $ext; # best guess
3386   return ();
3387 }
3388
3389 # get the minimum of a list
3390
3391 sub _min {
3392   my $mx=shift;
3393   for(@_) { if ($_<$mx) { $mx=$_; }}
3394   return $mx;
3395 }
3396
3397 # get the maximum of a list
3398
3399 sub _max {
3400   my $mx=shift;
3401   for(@_) { if ($_>$mx) { $mx=$_; }}
3402   return $mx;
3403 }
3404
3405 # string stuff for iptc headers
3406
3407 sub _clean {
3408   my($str)=$_[0];
3409   $str = substr($str,3);
3410   $str =~ s/[\n\r]//g;
3411   $str =~ s/\s+/ /g;
3412   $str =~ s/^\s//;
3413   $str =~ s/\s$//;
3414   return $str;
3415 }
3416
3417 # A little hack to parse iptc headers.
3418
3419 sub parseiptc {
3420   my $self=shift;
3421   my(@sar,$item,@ar);
3422   my($caption,$photogr,$headln,$credit);
3423
3424   my $str=$self->{IPTCRAW};
3425
3426   defined $str
3427     or return;
3428
3429   @ar=split(/8BIM/,$str);
3430
3431   my $i=0;
3432   foreach (@ar) {
3433     if (/^\004\004/) {
3434       @sar=split(/\034\002/);
3435       foreach $item (@sar) {
3436         if ($item =~ m/^x/) {
3437           $caption = _clean($item);
3438           $i++;
3439         }
3440         if ($item =~ m/^P/) {
3441           $photogr = _clean($item);
3442           $i++;
3443         }
3444         if ($item =~ m/^i/) {
3445           $headln = _clean($item);
3446           $i++;
3447         }
3448         if ($item =~ m/^n/) {
3449           $credit = _clean($item);
3450           $i++;
3451         }
3452       }
3453     }
3454   }
3455   return (caption=>$caption,photogr=>$photogr,headln=>$headln,credit=>$credit);
3456 }
3457
3458 sub Inline {
3459   my ($lang) = @_;
3460
3461   $lang eq 'C'
3462     or die "Only C language supported";
3463
3464   require Imager::ExtUtils;
3465   return Imager::ExtUtils->inline_config;
3466 }
3467
3468 1;
3469 __END__
3470 # Below is the stub of documentation for your module. You better edit it!
3471
3472 =head1 NAME
3473
3474 Imager - Perl extension for Generating 24 bit Images
3475
3476 =head1 SYNOPSIS
3477
3478   # Thumbnail example
3479
3480   #!/usr/bin/perl -w
3481   use strict;
3482   use Imager;
3483
3484   die "Usage: thumbmake.pl filename\n" if !-f $ARGV[0];
3485   my $file = shift;
3486
3487   my $format;
3488
3489   my $img = Imager->new();
3490   # see Imager::Files for information on the read() method
3491   $img->read(file=>$file) or die $img->errstr();
3492
3493   $file =~ s/\.[^.]*$//;
3494
3495   # Create smaller version
3496   # documented in Imager::Transformations
3497   my $thumb = $img->scale(scalefactor=>.3);
3498
3499   # Autostretch individual channels
3500   $thumb->filter(type=>'autolevels');
3501
3502   # try to save in one of these formats
3503   SAVE:
3504
3505   for $format ( qw( png gif jpg tiff ppm ) ) {
3506     # Check if given format is supported
3507     if ($Imager::formats{$format}) {
3508       $file.="_low.$format";
3509       print "Storing image as: $file\n";
3510       # documented in Imager::Files
3511       $thumb->write(file=>$file) or
3512         die $thumb->errstr;
3513       last SAVE;
3514     }
3515   }
3516
3517 =head1 DESCRIPTION
3518
3519 Imager is a module for creating and altering images.  It can read and
3520 write various image formats, draw primitive shapes like lines,and
3521 polygons, blend multiple images together in various ways, scale, crop,
3522 render text and more.
3523
3524 =head2 Overview of documentation
3525
3526 =over
3527
3528 =item *
3529
3530 Imager - This document - Synopsis, Example, Table of Contents and
3531 Overview.
3532
3533 =item *
3534
3535 L<Imager::Tutorial> - a brief introduction to Imager.
3536
3537 =item *
3538
3539 L<Imager::Cookbook> - how to do various things with Imager.
3540
3541 =item *
3542
3543 L<Imager::ImageTypes> - Basics of constructing image objects with
3544 C<new()>: Direct type/virtual images, RGB(A)/paletted images,
3545 8/16/double bits/channel, color maps, channel masks, image tags, color
3546 quantization.  Also discusses basic image information methods.
3547
3548 =item *
3549
3550 L<Imager::Files> - IO interaction, reading/writing images, format
3551 specific tags.
3552
3553 =item *
3554
3555 L<Imager::Draw> - Drawing Primitives, lines, boxes, circles, arcs,
3556 flood fill.
3557
3558 =item *
3559
3560 L<Imager::Color> - Color specification.
3561
3562 =item *
3563
3564 L<Imager::Fill> - Fill pattern specification.
3565
3566 =item *
3567
3568 L<Imager::Font> - General font rendering, bounding boxes and font
3569 metrics.
3570
3571 =item *
3572
3573 L<Imager::Transformations> - Copying, scaling, cropping, flipping,
3574 blending, pasting, convert and map.
3575
3576 =item *
3577
3578 L<Imager::Engines> - Programmable transformations through
3579 C<transform()>, C<transform2()> and C<matrix_transform()>.
3580
3581 =item *
3582
3583 L<Imager::Filters> - Filters, sharpen, blur, noise, convolve etc. and
3584 filter plugins.
3585
3586 =item *
3587
3588 L<Imager::Expr> - Expressions for evaluation engine used by
3589 transform2().
3590
3591 =item *
3592
3593 L<Imager::Matrix2d> - Helper class for affine transformations.
3594
3595 =item *
3596
3597 L<Imager::Fountain> - Helper for making gradient profiles.
3598
3599 =item *
3600
3601 L<Imager::API> - using Imager's C API
3602
3603 =item *
3604
3605 L<Imager::APIRef> - API function reference
3606
3607 =item *
3608
3609 L<Imager::Inline> - using Imager's C API from Inline::C
3610
3611 =item *
3612
3613 L<Imager::ExtUtils> - tools to get access to Imager's C API.
3614
3615 =back
3616
3617 =head2 Basic Overview
3618
3619 An Image object is created with C<$img = Imager-E<gt>new()>.
3620 Examples:
3621
3622   $img=Imager->new();                         # create empty image
3623   $img->read(file=>'lena.png',type=>'png') or # read image from file
3624      die $img->errstr();                      # give an explanation
3625                                               # if something failed
3626
3627 or if you want to create an empty image:
3628
3629   $img=Imager->new(xsize=>400,ysize=>300,channels=>4);
3630
3631 This example creates a completely black image of width 400 and height
3632 300 and 4 channels.
3633
3634 =head1 ERROR HANDLING
3635
3636 In general a method will return false when it fails, if it does use the errstr() method to find out why:
3637
3638 =over
3639
3640 =item errstr
3641
3642 Returns the last error message in that context.
3643
3644 If the last error you received was from calling an object method, such
3645 as read, call errstr() as an object method to find out why:
3646
3647   my $image = Imager->new;
3648   $image->read(file => 'somefile.gif')
3649      or die $image->errstr;
3650
3651 If it was a class method then call errstr() as a class method:
3652
3653   my @imgs = Imager->read_multi(file => 'somefile.gif')
3654     or die Imager->errstr;
3655
3656 Note that in some cases object methods are implemented in terms of
3657 class methods so a failing object method may set both.
3658
3659 =back
3660
3661 The C<Imager-E<gt>new> method is described in detail in
3662 L<Imager::ImageTypes>.
3663
3664 =head1 METHOD INDEX
3665
3666 Where to find information on methods for Imager class objects.
3667
3668 addcolors() -  L<Imager::ImageTypes/addcolors>
3669
3670 addtag() -  L<Imager::ImageTypes/addtag> - add image tags
3671
3672 align_string() - L<Imager::Draw/align_string>
3673
3674 arc() - L<Imager::Draw/arc>
3675
3676 bits() - L<Imager::ImageTypes/bits> - number of bits per sample for the
3677 image
3678
3679 box() - L<Imager::Draw/box>
3680
3681 circle() - L<Imager::Draw/circle>
3682
3683 colorcount() - L<Imager::Draw/colorcount>
3684
3685 convert() - L<Imager::Transformations/"Color transformations"> -
3686 transform the color space
3687
3688 copy() - L<Imager::Transformations/copy>
3689
3690 crop() - L<Imager::Transformations/crop> - extract part of an image
3691
3692 def_guess_type() - L<Imager::Files/def_guess_type>
3693
3694 deltag() -  L<Imager::ImageTypes/deltag> - delete image tags
3695
3696 difference() - L<Imager::Filters/"Image Difference">
3697
3698 errstr() - L<"Basic Overview">
3699
3700 filter() - L<Imager::Filters>
3701
3702 findcolor() - L<Imager::ImageTypes/findcolor> - search the image palette, if it
3703 has one
3704
3705 flip() - L<Imager::Transformations/flip>
3706
3707 flood_fill() - L<Imager::Draw/flood_fill>
3708
3709 getchannels() -  L<Imager::ImageTypes/getchannels>
3710
3711 getcolorcount() -  L<Imager::ImageTypes/getcolorcount>
3712
3713 getcolors() - L<Imager::ImageTypes/getcolors> - get colors from the image
3714 palette, if it has one
3715
3716 get_file_limits() - L<Imager::Files/"Limiting the sizes of images you read">
3717
3718 getheight() - L<Imager::ImageTypes/getwidth>
3719
3720 getmask() - L<Imager::ImageTypes/getmask>
3721
3722 getpixel() - L<Imager::Draw/getpixel>
3723
3724 getsamples() - L<Imager::Draw/getsamples>
3725
3726 getscanline() - L<Imager::Draw/getscanline>
3727
3728 getwidth() - L<Imager::ImageTypes/getwidth>
3729
3730 img_set() - L<Imager::ImageTypes/img_set>
3731
3732 init() - L<Imager::ImageTypes/init>
3733
3734 line() - L<Imager::Draw/line>
3735
3736 load_plugin() - L<Imager::Filters/load_plugin>
3737
3738 map() - L<Imager::Transformations/"Color Mappings"> - remap color
3739 channel values
3740
3741 masked() -  L<Imager::ImageTypes/masked> - make a masked image
3742
3743 matrix_transform() - L<Imager::Engines/matrix_transform>
3744
3745 maxcolors() - L<Imager::ImageTypes/maxcolors>
3746
3747 NC() - L<Imager::Handy/NC>
3748
3749 new() - L<Imager::ImageTypes/new>
3750
3751 newcolor() - L<Imager::Handy/newcolor>
3752
3753 newcolour() - L<Imager::Handy/newcolour>
3754
3755 newfont() - L<Imager::Handy/newfont>
3756
3757 NF() - L<Imager::Handy/NF>
3758
3759 open() - L<Imager::Files> - an alias for read()
3760
3761 parseiptc() - L<Imager::Files/parseiptc> - parse IPTC data from a JPEG
3762 image
3763
3764 paste() - L<Imager::Transformations/paste> - draw an image onto an image
3765
3766 polygon() - L<Imager::Draw/polygon>
3767
3768 polyline() - L<Imager::Draw/polyline>
3769
3770 read() - L<Imager::Files> - read a single image from an image file
3771
3772 read_multi() - L<Imager::Files> - read multiple images from an image
3773 file
3774
3775 register_filter() - L<Imager::Filters/register_filter>
3776
3777 register_reader() - L<Imager::Filters/register_reader>
3778
3779 register_writer() - L<Imager::Filters/register_writer>
3780
3781 rotate() - L<Imager::Transformations/rotate>
3782
3783 rubthrough() - L<Imager::Transformations/rubthrough> - draw an image onto an
3784 image and use the alpha channel
3785
3786 scale() - L<Imager::Transformations/scale>
3787
3788 scaleX() - L<Imager::Transformations/scaleX>
3789
3790 scaleY() - L<Imager::Transformations/scaleY>
3791
3792 setcolors() - L<Imager::ImageTypes/setcolors> - set palette colors in
3793 a paletted image
3794
3795 set_file_limits() - L<Imager::Files/"Limiting the sizes of images you read">
3796
3797 setmask() - L<Imager::ImageTypes/setmask>
3798
3799 setpixel() - L<Imager::Draw/setpixel>
3800
3801 setscanline() - L<Imager::Draw/setscanline>
3802
3803 settag() - L<Imager::ImageTypes/settag>
3804
3805 string() - L<Imager::Draw/string> - draw text on an image
3806
3807 tags() -  L<Imager::ImageTypes/tags> - fetch image tags
3808
3809 to_paletted() -  L<Imager::ImageTypes/to_paletted>
3810
3811 to_rgb8() - L<Imager::ImageTypes/to_rgb8>
3812
3813 transform() - L<Imager::Engines/"transform">
3814
3815 transform2() - L<Imager::Engines/"transform2">
3816
3817 type() -  L<Imager::ImageTypes/type> - type of image (direct vs paletted)
3818
3819 unload_plugin() - L<Imager::Filters/unload_plugin>
3820
3821 virtual() - L<Imager::ImageTypes/virtual> - whether the image has it's own
3822 data
3823
3824 write() - L<Imager::Files> - write an image to a file
3825
3826 write_multi() - L<Imager::Files> - write multiple image to an image
3827 file.
3828
3829 =head1 CONCEPT INDEX
3830
3831 animated GIF - L<Imager::File/"Writing an animated GIF">
3832
3833 aspect ratio - L<Imager::ImageTypes/i_xres>,
3834 L<Imager::ImageTypes/i_yres>, L<Imager::ImageTypes/i_aspect_only>
3835
3836 blend - alpha blending one image onto another
3837 L<Imager::Transformations/rubthrough>
3838
3839 blur - L<Imager::Filters/guassian>, L<Imager::Filters/conv>
3840
3841 boxes, drawing - L<Imager::Draw/box>
3842
3843 changes between image - L<Imager::Filter/"Image Difference">
3844
3845 color - L<Imager::Color>
3846
3847 color names - L<Imager::Color>, L<Imager::Color::Table>
3848
3849 combine modes - L<Imager::Fill/combine>
3850
3851 compare images - L<Imager::Filter/"Image Difference">
3852
3853 contrast - L<Imager::Filter/contrast>, L<Imager::Filter/autolevels>
3854
3855 convolution - L<Imager::Filter/conv>
3856
3857 cropping - L<Imager::Transformations/crop>
3858
3859 C<diff> images - L<Imager::Filter/"Image Difference">
3860
3861 dpi - L<Imager::ImageTypes/i_xres>, 
3862 L<Imager::Cookbook/"Image spatial resolution">
3863
3864 drawing boxes - L<Imager::Draw/box>
3865
3866 drawing lines - L<Imager::Draw/line>
3867
3868 drawing text - L<Imager::Draw/string>, L<Imager::Draw/align_string>
3869
3870 error message - L<"Basic Overview">
3871
3872 files, font - L<Imager::Font>
3873
3874 files, image - L<Imager::Files>
3875
3876 filling, types of fill - L<Imager::Fill>
3877
3878 filling, boxes - L<Imager::Draw/box>
3879
3880 filling, flood fill - L<Imager::Draw/flood_fill>
3881
3882 flood fill - L<Imager::Draw/flood_fill>
3883
3884 fonts - L<Imager::Font>
3885
3886 fonts, drawing with - L<Imager::Draw/string>,
3887 L<Imager::Draw/align_string>, L<Imager::Font::Wrap>
3888
3889 fonts, metrics - L<Imager::Font/bounding_box>, L<Imager::Font::BBox>
3890
3891 fonts, multiple master - L<Imager::Font/"MULTIPLE MASTER FONTS">
3892
3893 fountain fill - L<Imager::Fill/"Fountain fills">,
3894 L<Imager::Filters/fountain>, L<Imager::Fountain>,
3895 L<Imager::Filters/gradgen>
3896
3897 GIF files - L<Imager::Files/"GIF">
3898
3899 GIF files, animated - L<Imager::File/"Writing an animated GIF">
3900
3901 gradient fill - L<Imager::Fill/"Fountain fills">,
3902 L<Imager::Filters/fountain>, L<Imager::Fountain>,
3903 L<Imager::Filters/gradgen>
3904
3905 guassian blur - L<Imager::Filter/guassian>
3906
3907 hatch fills - L<Imager::Fill/"Hatched fills">
3908
3909 invert image - L<Imager::Filter/hardinvert>
3910
3911 JPEG - L<Imager::Files/"JPEG">
3912
3913 limiting image sizes - L<Imager::Files/"Limiting the sizes of images you read">
3914
3915 lines, drawing - L<Imager::Draw/line>
3916
3917 matrix - L<Imager::Matrix2d>, 
3918 L<Imager::Transformations/"Matrix Transformations">,
3919 L<Imager::Font/transform>
3920
3921 metadata, image - L<Imager::ImageTypes/"Tags">
3922
3923 mosaic - L<Imager::Filter/mosaic>
3924
3925 noise, filter - L<Imager::Filter/noise>
3926
3927 noise, rendered - L<Imager::Filter/turbnoise>,
3928 L<Imager::Filter/radnoise>
3929
3930 paste - L<Imager::Transformations/paste>,
3931 L<Imager::Transformations/rubthrough>
3932
3933 pseudo-color image - L<Imager::ImageTypes/to_paletted>,
3934 L<Imager::ImageTypes/new>
3935
3936 posterize - L<Imager::Filter/postlevels>
3937
3938 png files - L<Imager::Files>, L<Imager::Files/"PNG">
3939
3940 pnm - L<Imager::Files/"PNM (Portable aNy Map)">
3941
3942 rectangles, drawing - L<Imager::Draw/box>
3943
3944 resizing an image - L<Imager::Transformations/scale>, 
3945 L<Imager::Transformations/crop>
3946
3947 saving an image - L<Imager::Files>
3948
3949 scaling - L<Imager::Transformations/scale>
3950
3951 sharpen - L<Imager::Filters/unsharpmask>, L<Imager::Filters/conv>
3952
3953 size, image - L<Imager::ImageTypes/getwidth>,
3954 L<Imager::ImageTypes/getheight>
3955
3956 size, text - L<Imager::Font/bounding_box>
3957
3958 tags, image metadata - L<Imager::ImageTypes/"Tags">
3959
3960 text, drawing - L<Imager::Draw/string>, L<Imager::Draw/align_string>,
3961 L<Imager::Font::Wrap>
3962
3963 text, wrapping text in an area - L<Imager::Font::Wrap>
3964
3965 text, measuring - L<Imager::Font/bounding_box>, L<Imager::Font::BBox>
3966
3967 tiles, color - L<Imager::Filter/mosaic>
3968
3969 unsharp mask - L<Imager::Filter/unsharpmask>
3970
3971 watermark - L<Imager::Filter/watermark>
3972
3973 writing an image to a file - L<Imager::Files>
3974
3975 =head1 SUPPORT
3976
3977 The best place to get help with Imager is the mailing list.
3978
3979 To subscribe send a message with C<subscribe> in the body to:
3980
3981    imager-devel+request@molar.is
3982
3983 or use the form at:
3984
3985 =over
3986
3987 L<http://www.molar.is/en/lists/imager-devel/>
3988
3989 =back
3990
3991 where you can also find the mailing list archive.
3992
3993 You can report bugs by pointing your browser at:
3994
3995 =over
3996
3997 L<https://rt.cpan.org/NoAuth/ReportBug.html?Queue=Imager>
3998
3999 =back
4000
4001 Please remember to include the versions of Imager, perl, supporting
4002 libraries, and any relevant code.  If you have specific images that
4003 cause the problems, please include those too.
4004
4005 =head1 BUGS
4006
4007 Bugs are listed individually for relevant pod pages.
4008
4009 =head1 AUTHOR
4010
4011 Arnar M. Hrafnkelsson and Tony Cook (tony@imager.perl.org) among
4012 others. See the README for a complete list.
4013
4014 =head1 SEE ALSO
4015
4016 L<perl>(1), L<Imager::ImageTypes>(3), L<Imager::Files>(3),
4017 L<Imager::Draw>(3), L<Imager::Color>(3), L<Imager::Fill>(3),
4018 L<Imager::Font>(3), L<Imager::Transformations>(3),
4019 L<Imager::Engines>(3), L<Imager::Filters>(3), L<Imager::Expr>(3),
4020 L<Imager::Matrix2d>(3), L<Imager::Fountain>(3)
4021
4022 L<http://imager.perl.org/>
4023
4024 L<Affix::Infix2Postfix>(3), L<Parse::RecDescent>(3)
4025
4026 Other perl imaging modules include:
4027
4028 L<GD>(3), L<Image::Magick>(3), L<Graphics::Magick>(3).
4029
4030 =cut