Gabriel Vasseur's patch, corrected just enough for it to compile.
[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.59';
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   if( $r < $l or $b < $t ) {
758     $self->_set_error("attempting to crop outside of the image");
759     return;
760   }
761   my $dst = $self->_sametype(xsize=>$r-$l, ysize=>$b-$t);
762
763   i_copyto($dst->{IMG},$self->{IMG},$l,$t,$r,$b,0,0);
764   return $dst;
765 }
766
767 sub _sametype {
768   my ($self, %opts) = @_;
769
770   $self->{IMG} or return $self->_set_error("Not a valid image");
771
772   my $x = $opts{xsize} || $self->getwidth;
773   my $y = $opts{ysize} || $self->getheight;
774   my $channels = $opts{channels} || $self->getchannels;
775   
776   my $out = Imager->new;
777   if ($channels == $self->getchannels) {
778     $out->{IMG} = i_sametype($self->{IMG}, $x, $y);
779   }
780   else {
781     $out->{IMG} = i_sametype_chans($self->{IMG}, $x, $y, $channels);
782   }
783   unless ($out->{IMG}) {
784     $self->{ERRSTR} = $self->_error_as_msg;
785     return;
786   }
787   
788   return $out;
789 }
790
791 # Sets an image to a certain size and channel number
792 # if there was previously data in the image it is discarded
793
794 sub img_set {
795   my $self=shift;
796
797   my %hsh=(xsize=>100, ysize=>100, channels=>3, bits=>8, type=>'direct', @_);
798
799   if (defined($self->{IMG})) {
800     # let IIM_DESTROY destroy it, it's possible this image is
801     # referenced from a virtual image (like masked)
802     #i_img_destroy($self->{IMG});
803     undef($self->{IMG});
804   }
805
806   if ($hsh{type} eq 'paletted' || $hsh{type} eq 'pseudo') {
807     $self->{IMG} = i_img_pal_new($hsh{xsize}, $hsh{ysize}, $hsh{channels},
808                                  $hsh{maxcolors} || 256);
809   }
810   elsif ($hsh{bits} eq 'double') {
811     $self->{IMG} = i_img_double_new($hsh{xsize}, $hsh{ysize}, $hsh{channels});
812   }
813   elsif ($hsh{bits} == 16) {
814     $self->{IMG} = i_img_16_new($hsh{xsize}, $hsh{ysize}, $hsh{channels});
815   }
816   else {
817     $self->{IMG}=Imager::ImgRaw::new($hsh{'xsize'}, $hsh{'ysize'},
818                                      $hsh{'channels'});
819   }
820
821   unless ($self->{IMG}) {
822     $self->{ERRSTR} = Imager->_error_as_msg();
823     return;
824   }
825
826   $self;
827 }
828
829 # created a masked version of the current image
830 sub masked {
831   my $self = shift;
832
833   $self or return undef;
834   my %opts = (left    => 0, 
835               top     => 0, 
836               right   => $self->getwidth, 
837               bottom  => $self->getheight,
838               @_);
839   my $mask = $opts{mask} ? $opts{mask}{IMG} : undef;
840
841   my $result = Imager->new;
842   $result->{IMG} = i_img_masked_new($self->{IMG}, $mask, $opts{left}, 
843                                     $opts{top}, $opts{right} - $opts{left},
844                                     $opts{bottom} - $opts{top});
845   # keep references to the mask and base images so they don't
846   # disappear on us
847   $result->{DEPENDS} = [ $self->{IMG}, $mask ];
848
849   $result;
850 }
851
852 # convert an RGB image into a paletted image
853 sub to_paletted {
854   my $self = shift;
855   my $opts;
856   if (@_ != 1 && !ref $_[0]) {
857     $opts = { @_ };
858   }
859   else {
860     $opts = shift;
861   }
862
863   unless (defined wantarray) {
864     my @caller = caller;
865     warn "to_paletted() called in void context - to_paletted() returns the converted image at $caller[1] line $caller[2]\n";
866     return;
867   }
868
869   my $result = Imager->new;
870   $result->{IMG} = i_img_to_pal($self->{IMG}, $opts);
871
872   #print "Type ", i_img_type($result->{IMG}), "\n";
873
874   if ($result->{IMG}) {
875     return $result;
876   }
877   else {
878     $self->{ERRSTR} = $self->_error_as_msg;
879     return;
880   }
881 }
882
883 # convert a paletted (or any image) to an 8-bit/channel RGB images
884 sub to_rgb8 {
885   my $self = shift;
886   my $result;
887
888   unless (defined wantarray) {
889     my @caller = caller;
890     warn "to_rgb8() called in void context - to_rgb8() returns the converted image at $caller[1] line $caller[2]\n";
891     return;
892   }
893
894   if ($self->{IMG}) {
895     $result = Imager->new;
896     $result->{IMG} = i_img_to_rgb($self->{IMG})
897       or undef $result;
898   }
899
900   return $result;
901 }
902
903 # convert a paletted (or any image) to an 8-bit/channel RGB images
904 sub to_rgb16 {
905   my $self = shift;
906   my $result;
907
908   unless (defined wantarray) {
909     my @caller = caller;
910     warn "to_rgb16() called in void context - to_rgb8() returns the converted image at $caller[1] line $caller[2]\n";
911     return;
912   }
913
914   if ($self->{IMG}) {
915     $result = Imager->new;
916     $result->{IMG} = i_img_to_rgb16($self->{IMG})
917       or undef $result;
918   }
919
920   return $result;
921 }
922
923 sub addcolors {
924   my $self = shift;
925   my %opts = (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_addcolors($self->{IMG}, @colors);
944 }
945
946 sub setcolors {
947   my $self = shift;
948   my %opts = (start=>0, colors=>[], @_);
949
950   unless ($self->{IMG}) {
951     $self->_set_error("empty input image");
952     return;
953   }
954
955   my @colors = @{$opts{colors}}
956     or return undef;
957
958   for my $color (@colors) {
959     $color = _color($color);
960     unless ($color) {
961       $self->_set_error($Imager::ERRSTR);
962       return;
963     }  
964   }
965
966   return i_setcolors($self->{IMG}, $opts{start}, @colors);
967 }
968
969 sub getcolors {
970   my $self = shift;
971   my %opts = @_;
972   if (!exists $opts{start} && !exists $opts{count}) {
973     # get them all
974     $opts{start} = 0;
975     $opts{count} = $self->colorcount;
976   }
977   elsif (!exists $opts{count}) {
978     $opts{count} = 1;
979   }
980   elsif (!exists $opts{start}) {
981     $opts{start} = 0;
982   }
983   
984   $self->{IMG} and 
985     return i_getcolors($self->{IMG}, $opts{start}, $opts{count});
986 }
987
988 sub colorcount {
989   i_colorcount($_[0]{IMG});
990 }
991
992 sub maxcolors {
993   i_maxcolors($_[0]{IMG});
994 }
995
996 sub findcolor {
997   my $self = shift;
998   my %opts = @_;
999   $opts{color} or return undef;
1000
1001   $self->{IMG} and i_findcolor($self->{IMG}, $opts{color});
1002 }
1003
1004 sub bits {
1005   my $self = shift;
1006   my $bits = $self->{IMG} && i_img_bits($self->{IMG});
1007   if ($bits && $bits == length(pack("d", 1)) * 8) {
1008     $bits = 'double';
1009   }
1010   $bits;
1011 }
1012
1013 sub type {
1014   my $self = shift;
1015   if ($self->{IMG}) {
1016     return i_img_type($self->{IMG}) ? "paletted" : "direct";
1017   }
1018 }
1019
1020 sub virtual {
1021   my $self = shift;
1022   $self->{IMG} and i_img_virtual($self->{IMG});
1023 }
1024
1025 sub tags {
1026   my ($self, %opts) = @_;
1027
1028   $self->{IMG} or return;
1029
1030   if (defined $opts{name}) {
1031     my @result;
1032     my $start = 0;
1033     my $found;
1034     while (defined($found = i_tags_find($self->{IMG}, $opts{name}, $start))) {
1035       push @result, (i_tags_get($self->{IMG}, $found))[1];
1036       $start = $found+1;
1037     }
1038     return wantarray ? @result : $result[0];
1039   }
1040   elsif (defined $opts{code}) {
1041     my @result;
1042     my $start = 0;
1043     my $found;
1044     while (defined($found = i_tags_findn($self->{IMG}, $opts{code}, $start))) {
1045       push @result, (i_tags_get($self->{IMG}, $found))[1];
1046       $start = $found+1;
1047     }
1048     return @result;
1049   }
1050   else {
1051     if (wantarray) {
1052       return map { [ i_tags_get($self->{IMG}, $_) ] } 0.. i_tags_count($self->{IMG})-1;
1053     }
1054     else {
1055       return i_tags_count($self->{IMG});
1056     }
1057   }
1058 }
1059
1060 sub addtag {
1061   my $self = shift;
1062   my %opts = @_;
1063
1064   return -1 unless $self->{IMG};
1065   if ($opts{name}) {
1066     if (defined $opts{value}) {
1067       if ($opts{value} =~ /^\d+$/) {
1068         # add as a number
1069         return i_tags_addn($self->{IMG}, $opts{name}, 0, $opts{value});
1070       }
1071       else {
1072         return i_tags_add($self->{IMG}, $opts{name}, 0, $opts{value}, 0);
1073       }
1074     }
1075     elsif (defined $opts{data}) {
1076       # force addition as a string
1077       return i_tags_add($self->{IMG}, $opts{name}, 0, $opts{data}, 0);
1078     }
1079     else {
1080       $self->{ERRSTR} = "No value supplied";
1081       return undef;
1082     }
1083   }
1084   elsif ($opts{code}) {
1085     if (defined $opts{value}) {
1086       if ($opts{value} =~ /^\d+$/) {
1087         # add as a number
1088         return i_tags_addn($self->{IMG}, $opts{code}, 0, $opts{value});
1089       }
1090       else {
1091         return i_tags_add($self->{IMG}, $opts{code}, 0, $opts{value}, 0);
1092       }
1093     }
1094     elsif (defined $opts{data}) {
1095       # force addition as a string
1096       return i_tags_add($self->{IMG}, $opts{code}, 0, $opts{data}, 0);
1097     }
1098     else {
1099       $self->{ERRSTR} = "No value supplied";
1100       return undef;
1101     }
1102   }
1103   else {
1104     return undef;
1105   }
1106 }
1107
1108 sub deltag {
1109   my $self = shift;
1110   my %opts = @_;
1111
1112   return 0 unless $self->{IMG};
1113
1114   if (defined $opts{'index'}) {
1115     return i_tags_delete($self->{IMG}, $opts{'index'});
1116   }
1117   elsif (defined $opts{name}) {
1118     return i_tags_delbyname($self->{IMG}, $opts{name});
1119   }
1120   elsif (defined $opts{code}) {
1121     return i_tags_delbycode($self->{IMG}, $opts{code});
1122   }
1123   else {
1124     $self->{ERRSTR} = "Need to supply index, name, or code parameter";
1125     return 0;
1126   }
1127 }
1128
1129 sub settag {
1130   my ($self, %opts) = @_;
1131
1132   if ($opts{name}) {
1133     $self->deltag(name=>$opts{name});
1134     return $self->addtag(name=>$opts{name}, value=>$opts{value});
1135   }
1136   elsif (defined $opts{code}) {
1137     $self->deltag(code=>$opts{code});
1138     return $self->addtag(code=>$opts{code}, value=>$opts{value});
1139   }
1140   else {
1141     return undef;
1142   }
1143 }
1144
1145
1146 sub _get_reader_io {
1147   my ($self, $input) = @_;
1148
1149   if ($input->{io}) {
1150     return $input->{io}, undef;
1151   }
1152   elsif ($input->{fd}) {
1153     return io_new_fd($input->{fd});
1154   }
1155   elsif ($input->{fh}) {
1156     my $fd = fileno($input->{fh});
1157     unless ($fd) {
1158       $self->_set_error("Handle in fh option not opened");
1159       return;
1160     }
1161     return io_new_fd($fd);
1162   }
1163   elsif ($input->{file}) {
1164     my $file = IO::File->new($input->{file}, "r");
1165     unless ($file) {
1166       $self->_set_error("Could not open $input->{file}: $!");
1167       return;
1168     }
1169     binmode $file;
1170     return (io_new_fd(fileno($file)), $file);
1171   }
1172   elsif ($input->{data}) {
1173     return io_new_buffer($input->{data});
1174   }
1175   elsif ($input->{callback} || $input->{readcb}) {
1176     if (!$input->{seekcb}) {
1177       $self->_set_error("Need a seekcb parameter");
1178     }
1179     if ($input->{maxbuffer}) {
1180       return io_new_cb($input->{writecb},
1181                        $input->{callback} || $input->{readcb},
1182                        $input->{seekcb}, $input->{closecb},
1183                        $input->{maxbuffer});
1184     }
1185     else {
1186       return io_new_cb($input->{writecb},
1187                        $input->{callback} || $input->{readcb},
1188                        $input->{seekcb}, $input->{closecb});
1189     }
1190   }
1191   else {
1192     $self->_set_error("file/fd/fh/data/callback parameter missing");
1193     return;
1194   }
1195 }
1196
1197 sub _get_writer_io {
1198   my ($self, $input, $type) = @_;
1199
1200   if ($input->{io}) {
1201     return $input->{io};
1202   }
1203   elsif ($input->{fd}) {
1204     return io_new_fd($input->{fd});
1205   }
1206   elsif ($input->{fh}) {
1207     my $fd = fileno($input->{fh});
1208     unless ($fd) {
1209       $self->_set_error("Handle in fh option not opened");
1210       return;
1211     }
1212     # flush it
1213     my $oldfh = select($input->{fh});
1214     # flush anything that's buffered, and make sure anything else is flushed
1215     $| = 1;
1216     select($oldfh);
1217     return io_new_fd($fd);
1218   }
1219   elsif ($input->{file}) {
1220     my $fh = new IO::File($input->{file},"w+");
1221     unless ($fh) { 
1222       $self->_set_error("Could not open file $input->{file}: $!");
1223       return;
1224     }
1225     binmode($fh) or die;
1226     return (io_new_fd(fileno($fh)), $fh);
1227   }
1228   elsif ($input->{data}) {
1229     return io_new_bufchain();
1230   }
1231   elsif ($input->{callback} || $input->{writecb}) {
1232     if ($input->{maxbuffer}) {
1233       return io_new_cb($input->{callback} || $input->{writecb},
1234                        $input->{readcb},
1235                        $input->{seekcb}, $input->{closecb},
1236                        $input->{maxbuffer});
1237     }
1238     else {
1239       return io_new_cb($input->{callback} || $input->{writecb},
1240                        $input->{readcb},
1241                        $input->{seekcb}, $input->{closecb});
1242     }
1243   }
1244   else {
1245     $self->_set_error("file/fd/fh/data/callback parameter missing");
1246     return;
1247   }
1248 }
1249
1250 # Read an image from file
1251
1252 sub read {
1253   my $self = shift;
1254   my %input=@_;
1255
1256   if (defined($self->{IMG})) {
1257     # let IIM_DESTROY do the destruction, since the image may be
1258     # referenced from elsewhere
1259     #i_img_destroy($self->{IMG});
1260     undef($self->{IMG});
1261   }
1262
1263   my ($IO, $fh) = $self->_get_reader_io(\%input) or return;
1264
1265   unless ($input{'type'}) {
1266     $input{'type'} = i_test_format_probe($IO, -1);
1267   }
1268
1269   unless ($input{'type'}) {
1270           $self->_set_error('type parameter missing and not possible to guess from extension'); 
1271     return undef;
1272   }
1273
1274   _reader_autoload($input{type});
1275
1276   if ($readers{$input{type}} && $readers{$input{type}}{single}) {
1277     return $readers{$input{type}}{single}->($self, $IO, %input);
1278   }
1279
1280   unless ($formats{$input{'type'}}) {
1281     $self->_set_error("format '$input{'type'}' not supported");
1282     return;
1283   }
1284
1285   # Setup data source
1286   if ( $input{'type'} eq 'jpeg' ) {
1287     ($self->{IMG},$self->{IPTCRAW}) = i_readjpeg_wiol( $IO );
1288     if ( !defined($self->{IMG}) ) {
1289       $self->{ERRSTR}=$self->_error_as_msg(); return undef;
1290     }
1291     $self->{DEBUG} && print "loading a jpeg file\n";
1292     return $self;
1293   }
1294
1295   my $allow_incomplete = $input{allow_incomplete};
1296   defined $allow_incomplete or $allow_incomplete = 0;
1297
1298   if ( $input{'type'} eq 'tiff' ) {
1299     my $page = $input{'page'};
1300     defined $page or $page = 0;
1301     $self->{IMG}=i_readtiff_wiol( $IO, $allow_incomplete, $page ); 
1302     if ( !defined($self->{IMG}) ) {
1303       $self->{ERRSTR}=$self->_error_as_msg(); return undef;
1304     }
1305     $self->{DEBUG} && print "loading a tiff file\n";
1306     return $self;
1307   }
1308
1309   if ( $input{'type'} eq 'pnm' ) {
1310     $self->{IMG}=i_readpnm_wiol( $IO, $allow_incomplete );
1311     if ( !defined($self->{IMG}) ) {
1312       $self->{ERRSTR}='unable to read pnm image: '._error_as_msg(); 
1313       return undef;
1314     }
1315     $self->{DEBUG} && print "loading a pnm file\n";
1316     return $self;
1317   }
1318
1319   if ( $input{'type'} eq 'png' ) {
1320     $self->{IMG}=i_readpng_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed
1321     if ( !defined($self->{IMG}) ) {
1322       $self->{ERRSTR} = $self->_error_as_msg();
1323       return undef;
1324     }
1325     $self->{DEBUG} && print "loading a png file\n";
1326   }
1327
1328   if ( $input{'type'} eq 'bmp' ) {
1329     $self->{IMG}=i_readbmp_wiol( $IO, $allow_incomplete );
1330     if ( !defined($self->{IMG}) ) {
1331       $self->{ERRSTR}=$self->_error_as_msg();
1332       return undef;
1333     }
1334     $self->{DEBUG} && print "loading a bmp file\n";
1335   }
1336
1337   if ( $input{'type'} eq 'gif' ) {
1338     if ($input{colors} && !ref($input{colors})) {
1339       # must be a reference to a scalar that accepts the colour map
1340       $self->{ERRSTR} = "option 'colors' must be a scalar reference";
1341       return undef;
1342     }
1343     if ($input{'gif_consolidate'}) {
1344       if ($input{colors}) {
1345         my $colors;
1346         ($self->{IMG}, $colors) =i_readgif_wiol( $IO );
1347         if ($colors) {
1348           ${ $input{colors} } = [ map { NC(@$_) } @$colors ];
1349         }
1350       }
1351       else {
1352         $self->{IMG} =i_readgif_wiol( $IO );
1353       }
1354     }
1355     else {
1356       my $page = $input{'page'};
1357       defined $page or $page = 0;
1358       $self->{IMG} = i_readgif_single_wiol( $IO, $page );
1359       if ($self->{IMG} && $input{colors}) {
1360         ${ $input{colors} } =
1361           [ i_getcolors($self->{IMG}, 0, i_colorcount($self->{IMG})) ];
1362       }
1363     }
1364
1365     if ( !defined($self->{IMG}) ) {
1366       $self->{ERRSTR}=$self->_error_as_msg();
1367       return undef;
1368     }
1369     $self->{DEBUG} && print "loading a gif file\n";
1370   }
1371
1372   if ( $input{'type'} eq 'tga' ) {
1373     $self->{IMG}=i_readtga_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed
1374     if ( !defined($self->{IMG}) ) {
1375       $self->{ERRSTR}=$self->_error_as_msg();
1376       return undef;
1377     }
1378     $self->{DEBUG} && print "loading a tga file\n";
1379   }
1380
1381   if ( $input{'type'} eq 'raw' ) {
1382     my %params=(datachannels=>3,storechannels=>3,interleave=>1,%input);
1383
1384     if ( !($params{xsize} && $params{ysize}) ) {
1385       $self->{ERRSTR}='missing xsize or ysize parameter for raw';
1386       return undef;
1387     }
1388
1389     $self->{IMG} = i_readraw_wiol( $IO,
1390                                    $params{xsize},
1391                                    $params{ysize},
1392                                    $params{datachannels},
1393                                    $params{storechannels},
1394                                    $params{interleave});
1395     if ( !defined($self->{IMG}) ) {
1396       $self->{ERRSTR}=$self->_error_as_msg();
1397       return undef;
1398     }
1399     $self->{DEBUG} && print "loading a raw file\n";
1400   }
1401
1402   return $self;
1403 }
1404
1405 sub register_reader {
1406   my ($class, %opts) = @_;
1407
1408   defined $opts{type}
1409     or die "register_reader called with no type parameter\n";
1410
1411   my $type = $opts{type};
1412
1413   defined $opts{single} || defined $opts{multiple}
1414     or die "register_reader called with no single or multiple parameter\n";
1415
1416   $readers{$type} = {  };
1417   if ($opts{single}) {
1418     $readers{$type}{single} = $opts{single};
1419   }
1420   if ($opts{multiple}) {
1421     $readers{$type}{multiple} = $opts{multiple};
1422   }
1423
1424   return 1;
1425 }
1426
1427 sub register_writer {
1428   my ($class, %opts) = @_;
1429
1430   defined $opts{type}
1431     or die "register_writer called with no type parameter\n";
1432
1433   my $type = $opts{type};
1434
1435   defined $opts{single} || defined $opts{multiple}
1436     or die "register_writer called with no single or multiple parameter\n";
1437
1438   $writers{$type} = {  };
1439   if ($opts{single}) {
1440     $writers{$type}{single} = $opts{single};
1441   }
1442   if ($opts{multiple}) {
1443     $writers{$type}{multiple} = $opts{multiple};
1444   }
1445
1446   return 1;
1447 }
1448
1449 # probes for an Imager::File::whatever module
1450 sub _reader_autoload {
1451   my $type = shift;
1452
1453   return if $formats{$type} || $readers{$type};
1454
1455   return unless $type =~ /^\w+$/;
1456
1457   my $file = "Imager/File/\U$type\E.pm";
1458
1459   unless ($attempted_to_load{$file}) {
1460     eval {
1461       ++$attempted_to_load{$file};
1462       require $file;
1463     };
1464     if ($@) {
1465       # try to get a reader specific module
1466       my $file = "Imager/File/\U$type\EReader.pm";
1467       unless ($attempted_to_load{$file}) {
1468         eval {
1469           ++$attempted_to_load{$file};
1470           require $file;
1471         };
1472       }
1473     }
1474   }
1475 }
1476
1477 # probes for an Imager::File::whatever module
1478 sub _writer_autoload {
1479   my $type = shift;
1480
1481   return if $formats{$type} || $readers{$type};
1482
1483   return unless $type =~ /^\w+$/;
1484
1485   my $file = "Imager/File/\U$type\E.pm";
1486
1487   unless ($attempted_to_load{$file}) {
1488     eval {
1489       ++$attempted_to_load{$file};
1490       require $file;
1491     };
1492     if ($@) {
1493       # try to get a writer specific module
1494       my $file = "Imager/File/\U$type\EWriter.pm";
1495       unless ($attempted_to_load{$file}) {
1496         eval {
1497           ++$attempted_to_load{$file};
1498           require $file;
1499         };
1500       }
1501     }
1502   }
1503 }
1504
1505 sub _fix_gif_positions {
1506   my ($opts, $opt, $msg, @imgs) = @_;
1507
1508   my $positions = $opts->{'gif_positions'};
1509   my $index = 0;
1510   for my $pos (@$positions) {
1511     my ($x, $y) = @$pos;
1512     my $img = $imgs[$index++];
1513     $img->settag(name=>'gif_left', value=>$x);
1514     $img->settag(name=>'gif_top', value=>$y) if defined $y;
1515   }
1516   $$msg .= "replaced with the gif_left and gif_top tags";
1517 }
1518
1519 my %obsolete_opts =
1520   (
1521    gif_each_palette=>'gif_local_map',
1522    interlace       => 'gif_interlace',
1523    gif_delays => 'gif_delay',
1524    gif_positions => \&_fix_gif_positions,
1525    gif_loop_count => 'gif_loop',
1526   );
1527
1528 sub _set_opts {
1529   my ($self, $opts, $prefix, @imgs) = @_;
1530
1531   for my $opt (keys %$opts) {
1532     my $tagname = $opt;
1533     if ($obsolete_opts{$opt}) {
1534       my $new = $obsolete_opts{$opt};
1535       my $msg = "Obsolete option $opt ";
1536       if (ref $new) {
1537         $new->($opts, $opt, \$msg, @imgs);
1538       }
1539       else {
1540         $msg .= "replaced with the $new tag ";
1541         $tagname = $new;
1542       }
1543       $msg .= "line ".(caller(2))[2]." of file ".(caller(2))[1];
1544       warn $msg if $warn_obsolete && $^W;
1545     }
1546     next unless $tagname =~ /^\Q$prefix/;
1547     my $value = $opts->{$opt};
1548     if (ref $value) {
1549       if (UNIVERSAL::isa($value, "Imager::Color")) {
1550         my $tag = sprintf("color(%d,%d,%d,%d)", $value->rgba);
1551         for my $img (@imgs) {
1552           $img->settag(name=>$tagname, value=>$tag);
1553         }
1554       }
1555       elsif (ref($value) eq 'ARRAY') {
1556         for my $i (0..$#$value) {
1557           my $val = $value->[$i];
1558           if (ref $val) {
1559             if (UNIVERSAL::isa($val, "Imager::Color")) {
1560               my $tag = sprintf("color(%d,%d,%d,%d)", $value->rgba);
1561               $i < @imgs and
1562                 $imgs[$i]->settag(name=>$tagname, value=>$tag);
1563             }
1564             else {
1565               $self->_set_error("Unknown reference type " . ref($value) . 
1566                                 " supplied in array for $opt");
1567               return;
1568             }
1569           }
1570           else {
1571             $i < @imgs
1572               and $imgs[$i]->settag(name=>$tagname, value=>$val);
1573           }
1574         }
1575       }
1576       else {
1577         $self->_set_error("Unknown reference type " . ref($value) . 
1578                           " supplied for $opt");
1579         return;
1580       }
1581     }
1582     else {
1583       # set it as a tag for every image
1584       for my $img (@imgs) {
1585         $img->settag(name=>$tagname, value=>$value);
1586       }
1587     }
1588   }
1589
1590   return 1;
1591 }
1592
1593 # Write an image to file
1594 sub write {
1595   my $self = shift;
1596   my %input=(jpegquality=>75,
1597              gifquant=>'mc',
1598              lmdither=>6.0,
1599              lmfixed=>[],
1600              idstring=>"",
1601              compress=>1,
1602              wierdpack=>0,
1603              fax_fine=>1, @_);
1604   my $rc;
1605
1606   $self->_set_opts(\%input, "i_", $self)
1607     or return undef;
1608
1609   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1610
1611   if (!$input{'type'} and $input{file}) { 
1612     $input{'type'}=$FORMATGUESS->($input{file});
1613   }
1614   if (!$input{'type'}) { 
1615     $self->{ERRSTR}='type parameter missing and not possible to guess from extension';
1616     return undef;
1617   }
1618
1619   _writer_autoload($input{type});
1620
1621   my ($IO, $fh);
1622   if ($writers{$input{type}} && $writers{$input{type}}{single}) {
1623     ($IO, $fh) = $self->_get_writer_io(\%input, $input{'type'})
1624       or return undef;
1625
1626     $writers{$input{type}}{single}->($self, $IO, %input)
1627       or return undef;
1628   }
1629   else {
1630     if (!$formats{$input{'type'}}) { 
1631       $self->{ERRSTR}='format not supported'; 
1632       return undef;
1633     }
1634     
1635     ($IO, $fh) = $self->_get_writer_io(\%input, $input{'type'})
1636       or return undef;
1637     
1638     if ($input{'type'} eq 'tiff') {
1639       $self->_set_opts(\%input, "tiff_", $self)
1640         or return undef;
1641       $self->_set_opts(\%input, "exif_", $self)
1642         or return undef;
1643       
1644       if (defined $input{class} && $input{class} eq 'fax') {
1645         if (!i_writetiff_wiol_faxable($self->{IMG}, $IO, $input{fax_fine})) {
1646           $self->{ERRSTR} = $self->_error_as_msg();
1647           return undef;
1648         }
1649       } else {
1650         if (!i_writetiff_wiol($self->{IMG}, $IO)) {
1651           $self->{ERRSTR} = $self->_error_as_msg();
1652           return undef;
1653         }
1654       }
1655     } elsif ( $input{'type'} eq 'pnm' ) {
1656       $self->_set_opts(\%input, "pnm_", $self)
1657         or return undef;
1658       if ( ! i_writeppm_wiol($self->{IMG},$IO) ) {
1659         $self->{ERRSTR} = $self->_error_as_msg();
1660         return undef;
1661       }
1662       $self->{DEBUG} && print "writing a pnm file\n";
1663     } elsif ( $input{'type'} eq 'raw' ) {
1664       $self->_set_opts(\%input, "raw_", $self)
1665         or return undef;
1666       if ( !i_writeraw_wiol($self->{IMG},$IO) ) {
1667         $self->{ERRSTR} = $self->_error_as_msg();
1668         return undef;
1669       }
1670       $self->{DEBUG} && print "writing a raw file\n";
1671     } elsif ( $input{'type'} eq 'png' ) {
1672       $self->_set_opts(\%input, "png_", $self)
1673         or return undef;
1674       if ( !i_writepng_wiol($self->{IMG}, $IO) ) {
1675         $self->{ERRSTR}='unable to write png image';
1676         return undef;
1677       }
1678       $self->{DEBUG} && print "writing a png file\n";
1679     } elsif ( $input{'type'} eq 'jpeg' ) {
1680       $self->_set_opts(\%input, "jpeg_", $self)
1681         or return undef;
1682       $self->_set_opts(\%input, "exif_", $self)
1683         or return undef;
1684       if ( !i_writejpeg_wiol($self->{IMG}, $IO, $input{jpegquality})) {
1685         $self->{ERRSTR} = $self->_error_as_msg();
1686         return undef;
1687       }
1688       $self->{DEBUG} && print "writing a jpeg file\n";
1689     } elsif ( $input{'type'} eq 'bmp' ) {
1690       $self->_set_opts(\%input, "bmp_", $self)
1691         or return undef;
1692       if ( !i_writebmp_wiol($self->{IMG}, $IO) ) {
1693         $self->{ERRSTR} = $self->_error_as_msg;
1694         return undef;
1695       }
1696       $self->{DEBUG} && print "writing a bmp file\n";
1697     } elsif ( $input{'type'} eq 'tga' ) {
1698       $self->_set_opts(\%input, "tga_", $self)
1699         or return undef;
1700       
1701       if ( !i_writetga_wiol($self->{IMG}, $IO, $input{wierdpack}, $input{compress}, $input{idstring}) ) {
1702         $self->{ERRSTR}=$self->_error_as_msg();
1703         return undef;
1704       }
1705       $self->{DEBUG} && print "writing a tga file\n";
1706     } elsif ( $input{'type'} eq 'gif' ) {
1707       $self->_set_opts(\%input, "gif_", $self)
1708         or return undef;
1709       # compatibility with the old interfaces
1710       if ($input{gifquant} eq 'lm') {
1711         $input{make_colors} = 'addi';
1712         $input{translate} = 'perturb';
1713         $input{perturb} = $input{lmdither};
1714       } elsif ($input{gifquant} eq 'gen') {
1715         # just pass options through
1716       } else {
1717         $input{make_colors} = 'webmap'; # ignored
1718         $input{translate} = 'giflib';
1719       }
1720       if (!i_writegif_wiol($IO, \%input, $self->{IMG})) {
1721         $self->{ERRSTR} = $self->_error_as_msg;
1722         return;
1723       }
1724     }
1725   }
1726
1727   if (exists $input{'data'}) {
1728     my $data = io_slurp($IO);
1729     if (!$data) {
1730       $self->{ERRSTR}='Could not slurp from buffer';
1731       return undef;
1732     }
1733     ${$input{data}} = $data;
1734   }
1735   return $self;
1736 }
1737
1738 sub write_multi {
1739   my ($class, $opts, @images) = @_;
1740
1741   my $type = $opts->{type};
1742
1743   if (!$type && $opts->{'file'}) {
1744     $type = $FORMATGUESS->($opts->{'file'});
1745   }
1746   unless ($type) {
1747     $class->_set_error('type parameter missing and not possible to guess from extension');
1748     return;
1749   }
1750   # translate to ImgRaw
1751   if (grep !UNIVERSAL::isa($_, 'Imager') || !$_->{IMG}, @images) {
1752     $class->_set_error('Usage: Imager->write_multi({ options }, @images)');
1753     return 0;
1754   }
1755   $class->_set_opts($opts, "i_", @images)
1756     or return;
1757   my @work = map $_->{IMG}, @images;
1758
1759   _writer_autoload($type);
1760
1761   my ($IO, $file);
1762   if ($writers{$type} && $writers{$type}{multiple}) {
1763     ($IO, $file) = $class->_get_writer_io($opts, $type)
1764       or return undef;
1765
1766     $writers{$type}{multiple}->($class, $IO, $opts, @images)
1767       or return undef;
1768   }
1769   else {
1770     if (!$formats{$type}) { 
1771       $class->_set_error("format $type not supported"); 
1772       return undef;
1773     }
1774     
1775     ($IO, $file) = $class->_get_writer_io($opts, $type)
1776       or return undef;
1777     
1778     if ($type eq 'gif') {
1779       $class->_set_opts($opts, "gif_", @images)
1780         or return;
1781       my $gif_delays = $opts->{gif_delays};
1782       local $opts->{gif_delays} = $gif_delays;
1783       if ($opts->{gif_delays} && !ref $opts->{gif_delays}) {
1784         # assume the caller wants the same delay for each frame
1785         $opts->{gif_delays} = [ ($gif_delays) x @images ];
1786       }
1787       unless (i_writegif_wiol($IO, $opts, @work)) {
1788         $class->_set_error($class->_error_as_msg());
1789         return undef;
1790       }
1791     }
1792     elsif ($type eq 'tiff') {
1793       $class->_set_opts($opts, "tiff_", @images)
1794         or return;
1795       $class->_set_opts($opts, "exif_", @images)
1796         or return;
1797       my $res;
1798       $opts->{fax_fine} = 1 unless exists $opts->{fax_fine};
1799       if ($opts->{'class'} && $opts->{'class'} eq 'fax') {
1800         $res = i_writetiff_multi_wiol_faxable($IO, $opts->{fax_fine}, @work);
1801       }
1802       else {
1803         $res = i_writetiff_multi_wiol($IO, @work);
1804       }
1805       unless ($res) {
1806         $class->_set_error($class->_error_as_msg());
1807         return undef;
1808       }
1809     }
1810     else {
1811       if (@images == 1) {
1812         unless ($images[0]->write(%$opts, io => $IO, type => $type)) {
1813           return 1;
1814         }
1815       }
1816       else {
1817         $ERRSTR = "Sorry, write_multi doesn't support $type yet";
1818         return 0;
1819       }
1820     }
1821   }
1822
1823   if (exists $opts->{'data'}) {
1824     my $data = io_slurp($IO);
1825     if (!$data) {
1826       Imager->_set_error('Could not slurp from buffer');
1827       return undef;
1828     }
1829     ${$opts->{data}} = $data;
1830   }
1831   return 1;
1832 }
1833
1834 # read multiple images from a file
1835 sub read_multi {
1836   my ($class, %opts) = @_;
1837
1838   my ($IO, $file) = $class->_get_reader_io(\%opts, $opts{'type'})
1839     or return;
1840
1841   my $type = $opts{'type'};
1842   unless ($type) {
1843     $type = i_test_format_probe($IO, -1);
1844   }
1845
1846   if ($opts{file} && !$type) {
1847     # guess the type 
1848     $type = $FORMATGUESS->($opts{file});
1849   }
1850
1851   unless ($type) {
1852     $ERRSTR = "No type parameter supplied and it couldn't be guessed";
1853     return;
1854   }
1855
1856   _reader_autoload($type);
1857
1858   if ($readers{$type} && $readers{$type}{multiple}) {
1859     return $readers{$type}{multiple}->($IO, %opts);
1860   }
1861
1862   if ($type eq 'gif') {
1863     my @imgs;
1864     @imgs = i_readgif_multi_wiol($IO);
1865     if (@imgs) {
1866       return map { 
1867         bless { IMG=>$_, DEBUG=>$DEBUG, ERRSTR=>undef }, 'Imager' 
1868       } @imgs;
1869     }
1870     else {
1871       $ERRSTR = _error_as_msg();
1872       return;
1873     }
1874   }
1875   elsif ($type eq 'tiff') {
1876     my @imgs = i_readtiff_multi_wiol($IO, -1);
1877     if (@imgs) {
1878       return map { 
1879         bless { IMG=>$_, DEBUG=>$DEBUG, ERRSTR=>undef }, 'Imager' 
1880       } @imgs;
1881     }
1882     else {
1883       $ERRSTR = _error_as_msg();
1884       return;
1885     }
1886   }
1887   else {
1888     my $img = Imager->new;
1889     if ($img->read(%opts, io => $IO, type => $type)) {
1890       return ( $img );
1891     }
1892   }
1893
1894   $ERRSTR = "Cannot read multiple images from $type files";
1895   return;
1896 }
1897
1898 # Destroy an Imager object
1899
1900 sub DESTROY {
1901   my $self=shift;
1902   #    delete $instances{$self};
1903   if (defined($self->{IMG})) {
1904     # the following is now handled by the XS DESTROY method for
1905     # Imager::ImgRaw object
1906     # Re-enabling this will break virtual images
1907     # tested for in t/t020masked.t
1908     # i_img_destroy($self->{IMG});
1909     undef($self->{IMG});
1910   } else {
1911 #    print "Destroy Called on an empty image!\n"; # why did I put this here??
1912   }
1913 }
1914
1915 # Perform an inplace filter of an image
1916 # that is the image will be overwritten with the data
1917
1918 sub filter {
1919   my $self=shift;
1920   my %input=@_;
1921   my %hsh;
1922   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1923
1924   if (!$input{'type'}) { $self->{ERRSTR}='type parameter missing'; return undef; }
1925
1926   if ( (grep { $_ eq $input{'type'} } keys %filters) != 1) {
1927     $self->{ERRSTR}='type parameter not matching any filter'; return undef;
1928   }
1929
1930   if ($filters{$input{'type'}}{names}) {
1931     my $names = $filters{$input{'type'}}{names};
1932     for my $name (keys %$names) {
1933       if (defined $input{$name} && exists $names->{$name}{$input{$name}}) {
1934         $input{$name} = $names->{$name}{$input{$name}};
1935       }
1936     }
1937   }
1938   if (defined($filters{$input{'type'}}{defaults})) {
1939     %hsh=( image => $self->{IMG},
1940            imager => $self,
1941            %{$filters{$input{'type'}}{defaults}},
1942            %input );
1943   } else {
1944     %hsh=( image => $self->{IMG},
1945            imager => $self,
1946            %input );
1947   }
1948
1949   my @cs=@{$filters{$input{'type'}}{callseq}};
1950
1951   for(@cs) {
1952     if (!defined($hsh{$_})) {
1953       $self->{ERRSTR}="missing parameter '$_' for filter ".$input{'type'}; return undef;
1954     }
1955   }
1956
1957   eval {
1958     local $SIG{__DIE__}; # we don't want this processed by confess, etc
1959     &{$filters{$input{'type'}}{callsub}}(%hsh);
1960   };
1961   if ($@) {
1962     chomp($self->{ERRSTR} = $@);
1963     return;
1964   }
1965
1966   my @b=keys %hsh;
1967
1968   $self->{DEBUG} && print "callseq is: @cs\n";
1969   $self->{DEBUG} && print "matching callseq is: @b\n";
1970
1971   return $self;
1972 }
1973
1974 sub register_filter {
1975   my $class = shift;
1976   my %hsh = ( defaults => {}, @_ );
1977
1978   defined $hsh{type}
1979     or die "register_filter() with no type\n";
1980   defined $hsh{callsub}
1981     or die "register_filter() with no callsub\n";
1982   defined $hsh{callseq}
1983     or die "register_filter() with no callseq\n";
1984
1985   exists $filters{$hsh{type}}
1986     and return;
1987
1988   $filters{$hsh{type}} = \%hsh;
1989
1990   return 1;
1991 }
1992
1993 # Scale an image to requested size and return the scaled version
1994
1995 sub scale {
1996   my $self=shift;
1997   my %opts=('type'=>'max',qtype=>'normal',@_);
1998   my $img = Imager->new();
1999   my $tmp = Imager->new();
2000   my ($x_scale, $y_scale);
2001
2002   unless (defined wantarray) {
2003     my @caller = caller;
2004     warn "scale() called in void context - scale() returns the scaled image at $caller[1] line $caller[2]\n";
2005     return;
2006   }
2007
2008   unless ($self->{IMG}) { 
2009     $self->_set_error('empty input image'); 
2010     return undef;
2011   }
2012
2013   if ($opts{'xscalefactor'} && $opts{'yscalefactor'}) {
2014     $x_scale = $opts{'xscalefactor'};
2015     $y_scale = $opts{'yscalefactor'};
2016   }
2017   elsif ($opts{'xscalefactor'}) {
2018     $x_scale = $opts{'xscalefactor'};
2019     $y_scale = $opts{'scalefactor'} || $x_scale;
2020   }
2021   elsif ($opts{'yscalefactor'}) {
2022     $y_scale = $opts{'yscalefactor'};
2023     $x_scale = $opts{'scalefactor'} || $y_scale;
2024   }
2025   else {
2026     $x_scale = $y_scale = $opts{'scalefactor'} || 0.5;
2027   }
2028
2029   # work out the scaling
2030   if ($opts{xpixels} and $opts{ypixels} and $opts{'type'}) {
2031     my ($xpix, $ypix)=( $opts{xpixels} / $self->getwidth() , 
2032                         $opts{ypixels} / $self->getheight() );
2033     if ($opts{'type'} eq 'min') { 
2034       $x_scale = $y_scale = _min($xpix,$ypix); 
2035     }
2036     elsif ($opts{'type'} eq 'max') {
2037       $x_scale = $y_scale = _max($xpix,$ypix);
2038     }
2039     elsif ($opts{'type'} eq 'nonprop' || $opts{'type'} eq 'non-proportional') {
2040       $x_scale = $xpix;
2041       $y_scale = $ypix;
2042     }
2043     else {
2044       $self->_set_error('invalid value for type parameter');
2045       return undef;
2046     }
2047   } elsif ($opts{xpixels}) { 
2048     $x_scale = $y_scale = $opts{xpixels} / $self->getwidth();
2049   }
2050   elsif ($opts{ypixels}) { 
2051     $x_scale = $y_scale = $opts{ypixels}/$self->getheight();
2052   }
2053   elsif ($opts{constrain} && ref $opts{constrain}
2054          && $opts{constrain}->can('constrain')) {
2055     # we've been passed an Image::Math::Constrain object or something
2056     # that looks like one
2057     my $scalefactor;
2058     (undef, undef, $scalefactor)
2059       = $opts{constrain}->constrain($self->getwidth, $self->getheight);
2060     unless ($scalefactor) {
2061       $self->_set_error('constrain method failed on constrain parameter');
2062       return undef;
2063     }
2064     $x_scale = $y_scale = $scalefactor;
2065   }
2066
2067   if ($opts{qtype} eq 'normal') {
2068     $tmp->{IMG} = i_scaleaxis($self->{IMG}, $x_scale, 0);
2069     if ( !defined($tmp->{IMG}) ) { 
2070       $self->{ERRSTR} = 'unable to scale image';
2071       return undef;
2072     }
2073     $img->{IMG}=i_scaleaxis($tmp->{IMG}, $y_scale, 1);
2074     if ( !defined($img->{IMG}) ) { 
2075       $self->{ERRSTR}='unable to scale image'; 
2076       return undef;
2077     }
2078
2079     return $img;
2080   }
2081   elsif ($opts{'qtype'} eq 'preview') {
2082     $img->{IMG} = i_scale_nn($self->{IMG}, $x_scale, $y_scale); 
2083     if ( !defined($img->{IMG}) ) { 
2084       $self->{ERRSTR}='unable to scale image'; 
2085       return undef;
2086     }
2087     return $img;
2088   }
2089   elsif ($opts{'qtype'} eq 'mixing') {
2090     my $new_width = int(0.5 + $self->getwidth * $x_scale);
2091     my $new_height = int(0.5 + $self->getheight * $y_scale);
2092     $new_width >= 1 or $new_width = 1;
2093     $new_height >= 1 or $new_height = 1;
2094     $img->{IMG} = i_scale_mixing($self->{IMG}, $new_width, $new_height);
2095     unless ($img->{IMG}) {
2096       $self->_set_error(Imager->_error_as_meg);
2097       return;
2098     }
2099     return $img;
2100   }
2101   else {
2102     $self->_set_error('invalid value for qtype parameter');
2103     return undef;
2104   }
2105 }
2106
2107 # Scales only along the X axis
2108
2109 sub scaleX {
2110   my $self = shift;
2111   my %opts = ( scalefactor=>0.5, @_ );
2112
2113   unless (defined wantarray) {
2114     my @caller = caller;
2115     warn "scaleX() called in void context - scaleX() returns the scaled image at $caller[1] line $caller[2]\n";
2116     return;
2117   }
2118
2119   unless ($self->{IMG}) { 
2120     $self->{ERRSTR} = 'empty input image';
2121     return undef;
2122   }
2123
2124   my $img = Imager->new();
2125
2126   my $scalefactor = $opts{scalefactor};
2127
2128   if ($opts{pixels}) { 
2129     $scalefactor = $opts{pixels} / $self->getwidth();
2130   }
2131
2132   unless ($self->{IMG}) { 
2133     $self->{ERRSTR}='empty input image'; 
2134     return undef;
2135   }
2136
2137   $img->{IMG} = i_scaleaxis($self->{IMG}, $scalefactor, 0);
2138
2139   if ( !defined($img->{IMG}) ) { 
2140     $self->{ERRSTR} = 'unable to scale image'; 
2141     return undef;
2142   }
2143
2144   return $img;
2145 }
2146
2147 # Scales only along the Y axis
2148
2149 sub scaleY {
2150   my $self = shift;
2151   my %opts = ( scalefactor => 0.5, @_ );
2152
2153   unless (defined wantarray) {
2154     my @caller = caller;
2155     warn "scaleY() called in void context - scaleY() returns the scaled image at $caller[1] line $caller[2]\n";
2156     return;
2157   }
2158
2159   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2160
2161   my $img = Imager->new();
2162
2163   my $scalefactor = $opts{scalefactor};
2164
2165   if ($opts{pixels}) { 
2166     $scalefactor = $opts{pixels} / $self->getheight();
2167   }
2168
2169   unless ($self->{IMG}) { 
2170     $self->{ERRSTR} = 'empty input image'; 
2171     return undef;
2172   }
2173   $img->{IMG}=i_scaleaxis($self->{IMG}, $scalefactor, 1);
2174
2175   if ( !defined($img->{IMG}) ) {
2176     $self->{ERRSTR} = 'unable to scale image';
2177     return undef;
2178   }
2179
2180   return $img;
2181 }
2182
2183 # Transform returns a spatial transformation of the input image
2184 # this moves pixels to a new location in the returned image.
2185 # NOTE - should make a utility function to check transforms for
2186 # stack overruns
2187
2188 sub transform {
2189   my $self=shift;
2190   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2191   my %opts=@_;
2192   my (@op,@ropx,@ropy,$iop,$or,@parm,$expr,@xt,@yt,@pt,$numre);
2193
2194 #  print Dumper(\%opts);
2195 #  xopcopdes
2196
2197   if ( $opts{'xexpr'} and $opts{'yexpr'} ) {
2198     if (!$I2P) {
2199       eval ("use Affix::Infix2Postfix;");
2200       print $@;
2201       if ( $@ ) {
2202         $self->{ERRSTR}='transform: expr given and Affix::Infix2Postfix is not avaliable.'; 
2203         return undef;
2204       }
2205       $I2P=Affix::Infix2Postfix->new('ops'=>[{op=>'+',trans=>'Add'},
2206                                              {op=>'-',trans=>'Sub'},
2207                                              {op=>'*',trans=>'Mult'},
2208                                              {op=>'/',trans=>'Div'},
2209                                              {op=>'-','type'=>'unary',trans=>'u-'},
2210                                              {op=>'**'},
2211                                              {op=>'func','type'=>'unary'}],
2212                                      'grouping'=>[qw( \( \) )],
2213                                      'func'=>[qw( sin cos )],
2214                                      'vars'=>[qw( x y )]
2215                                     );
2216     }
2217
2218     @xt=$I2P->translate($opts{'xexpr'});
2219     @yt=$I2P->translate($opts{'yexpr'});
2220
2221     $numre=$I2P->{'numre'};
2222     @pt=(0,0);
2223
2224     for(@xt) { if (/$numre/) { push(@pt,$_); push(@{$opts{'xopcodes'}},'Parm',$#pt); } else { push(@{$opts{'xopcodes'}},$_); } }
2225     for(@yt) { if (/$numre/) { push(@pt,$_); push(@{$opts{'yopcodes'}},'Parm',$#pt); } else { push(@{$opts{'yopcodes'}},$_); } }
2226     @{$opts{'parm'}}=@pt;
2227   }
2228
2229 #  print Dumper(\%opts);
2230
2231   if ( !exists $opts{'xopcodes'} or @{$opts{'xopcodes'}}==0) {
2232     $self->{ERRSTR}='transform: no xopcodes given.';
2233     return undef;
2234   }
2235
2236   @op=@{$opts{'xopcodes'}};
2237   for $iop (@op) { 
2238     if (!defined ($OPCODES{$iop}) and ($iop !~ /^\d+$/) ) {
2239       $self->{ERRSTR}="transform: illegal opcode '$_'.";
2240       return undef;
2241     }
2242     push(@ropx,(exists $OPCODES{$iop}) ? @{$OPCODES{$iop}} : $iop );
2243   }
2244
2245
2246 # yopcopdes
2247
2248   if ( !exists $opts{'yopcodes'} or @{$opts{'yopcodes'}}==0) {
2249     $self->{ERRSTR}='transform: no yopcodes given.';
2250     return undef;
2251   }
2252
2253   @op=@{$opts{'yopcodes'}};
2254   for $iop (@op) { 
2255     if (!defined ($OPCODES{$iop}) and ($iop !~ /^\d+$/) ) {
2256       $self->{ERRSTR}="transform: illegal opcode '$_'.";
2257       return undef;
2258     }
2259     push(@ropy,(exists $OPCODES{$iop}) ? @{$OPCODES{$iop}} : $iop );
2260   }
2261
2262 #parameters
2263
2264   if ( !exists $opts{'parm'}) {
2265     $self->{ERRSTR}='transform: no parameter arg given.';
2266     return undef;
2267   }
2268
2269 #  print Dumper(\@ropx);
2270 #  print Dumper(\@ropy);
2271 #  print Dumper(\@ropy);
2272
2273   my $img = Imager->new();
2274   $img->{IMG}=i_transform($self->{IMG},\@ropx,\@ropy,$opts{'parm'});
2275   if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='transform: failed'; return undef; }
2276   return $img;
2277 }
2278
2279
2280 sub transform2 {
2281   my ($opts, @imgs) = @_;
2282   
2283   require "Imager/Expr.pm";
2284
2285   $opts->{variables} = [ qw(x y) ];
2286   my ($width, $height) = @{$opts}{qw(width height)};
2287   if (@imgs) {
2288     $width ||= $imgs[0]->getwidth();
2289     $height ||= $imgs[0]->getheight();
2290     my $img_num = 1;
2291     for my $img (@imgs) {
2292       $opts->{constants}{"w$img_num"} = $img->getwidth();
2293       $opts->{constants}{"h$img_num"} = $img->getheight();
2294       $opts->{constants}{"cx$img_num"} = $img->getwidth()/2;
2295       $opts->{constants}{"cy$img_num"} = $img->getheight()/2;
2296       ++$img_num;
2297     }
2298   }
2299   if ($width) {
2300     $opts->{constants}{w} = $width;
2301     $opts->{constants}{cx} = $width/2;
2302   }
2303   else {
2304     $Imager::ERRSTR = "No width supplied";
2305     return;
2306   }
2307   if ($height) {
2308     $opts->{constants}{h} = $height;
2309     $opts->{constants}{cy} = $height/2;
2310   }
2311   else {
2312     $Imager::ERRSTR = "No height supplied";
2313     return;
2314   }
2315   my $code = Imager::Expr->new($opts);
2316   if (!$code) {
2317     $Imager::ERRSTR = Imager::Expr::error();
2318     return;
2319   }
2320   my $channels = $opts->{channels} || 3;
2321   unless ($channels >= 1 && $channels <= 4) {
2322     return Imager->_set_error("channels must be an integer between 1 and 4");
2323   }
2324
2325   my $img = Imager->new();
2326   $img->{IMG} = i_transform2($opts->{width}, $opts->{height}, 
2327                              $channels, $code->code(),
2328                              $code->nregs(), $code->cregs(),
2329                              [ map { $_->{IMG} } @imgs ]);
2330   if (!defined $img->{IMG}) {
2331     $Imager::ERRSTR = Imager->_error_as_msg();
2332     return;
2333   }
2334
2335   return $img;
2336 }
2337
2338 sub rubthrough {
2339   my $self=shift;
2340   my %opts=(tx => 0,ty => 0, @_);
2341
2342   unless ($self->{IMG}) { 
2343     $self->{ERRSTR}='empty input image'; 
2344     return undef;
2345   }
2346   unless ($opts{src} && $opts{src}->{IMG}) {
2347     $self->{ERRSTR}='empty input image for src'; 
2348     return undef;
2349   }
2350
2351   %opts = (src_minx => 0,
2352            src_miny => 0,
2353            src_maxx => $opts{src}->getwidth(),
2354            src_maxy => $opts{src}->getheight(),
2355            %opts);
2356
2357   unless (i_rubthru($self->{IMG}, $opts{src}->{IMG}, $opts{tx}, $opts{ty},
2358                     $opts{src_minx}, $opts{src_miny}, 
2359                     $opts{src_maxx}, $opts{src_maxy})) {
2360     $self->_set_error($self->_error_as_msg());
2361     return undef;
2362   }
2363   return $self;
2364 }
2365
2366
2367 sub flip {
2368   my $self  = shift;
2369   my %opts  = @_;
2370   my %xlate = (h=>0, v=>1, hv=>2, vh=>2);
2371   my $dir;
2372   return () unless defined $opts{'dir'} and defined $xlate{$opts{'dir'}};
2373   $dir = $xlate{$opts{'dir'}};
2374   return $self if i_flipxy($self->{IMG}, $dir);
2375   return ();
2376 }
2377
2378 sub rotate {
2379   my $self = shift;
2380   my %opts = @_;
2381
2382   unless (defined wantarray) {
2383     my @caller = caller;
2384     warn "rotate() called in void context - rotate() returns the rotated image at $caller[1] line $caller[2]\n";
2385     return;
2386   }
2387
2388   if (defined $opts{right}) {
2389     my $degrees = $opts{right};
2390     if ($degrees < 0) {
2391       $degrees += 360 * int(((-$degrees)+360)/360);
2392     }
2393     $degrees = $degrees % 360;
2394     if ($degrees == 0) {
2395       return $self->copy();
2396     }
2397     elsif ($degrees == 90 || $degrees == 180 || $degrees == 270) {
2398       my $result = Imager->new();
2399       if ($result->{IMG} = i_rotate90($self->{IMG}, $degrees)) {
2400         return $result;
2401       }
2402       else {
2403         $self->{ERRSTR} = $self->_error_as_msg();
2404         return undef;
2405       }
2406     }
2407     else {
2408       $self->{ERRSTR} = "Parameter 'right' must be a multiple of 90 degrees";
2409       return undef;
2410     }
2411   }
2412   elsif (defined $opts{radians} || defined $opts{degrees}) {
2413     my $amount = $opts{radians} || $opts{degrees} * 3.1415926535 / 180;
2414
2415     my $back = $opts{back};
2416     my $result = Imager->new;
2417     if ($back) {
2418       $back = _color($back);
2419       unless ($back) {
2420         $self->_set_error(Imager->errstr);
2421         return undef;
2422       }
2423
2424       $result->{IMG} = i_rotate_exact($self->{IMG}, $amount, $back);
2425     }
2426     else {
2427       $result->{IMG} = i_rotate_exact($self->{IMG}, $amount);
2428     }
2429     if ($result->{IMG}) {
2430       return $result;
2431     }
2432     else {
2433       $self->{ERRSTR} = $self->_error_as_msg();
2434       return undef;
2435     }
2436   }
2437   else {
2438     $self->{ERRSTR} = "Only the 'right', 'radians' and 'degrees' parameters are available";
2439     return undef;
2440   }
2441 }
2442
2443 sub matrix_transform {
2444   my $self = shift;
2445   my %opts = @_;
2446
2447   unless (defined wantarray) {
2448     my @caller = caller;
2449     warn "copy() called in void context - copy() returns the copied image at $caller[1] line $caller[2]\n";
2450     return;
2451   }
2452
2453   if ($opts{matrix}) {
2454     my $xsize = $opts{xsize} || $self->getwidth;
2455     my $ysize = $opts{ysize} || $self->getheight;
2456
2457     my $result = Imager->new;
2458     if ($opts{back}) {
2459       $result->{IMG} = i_matrix_transform($self->{IMG}, $xsize, $ysize, 
2460                                           $opts{matrix}, $opts{back})
2461         or return undef;
2462     }
2463     else {
2464       $result->{IMG} = i_matrix_transform($self->{IMG}, $xsize, $ysize, 
2465                                           $opts{matrix})
2466         or return undef;
2467     }
2468
2469     return $result;
2470   }
2471   else {
2472     $self->{ERRSTR} = "matrix parameter required";
2473     return undef;
2474   }
2475 }
2476
2477 # blame Leolo :)
2478 *yatf = \&matrix_transform;
2479
2480 # These two are supported for legacy code only
2481
2482 sub i_color_new {
2483   return Imager::Color->new(@_);
2484 }
2485
2486 sub i_color_set {
2487   return Imager::Color::set(@_);
2488 }
2489
2490 # Draws a box between the specified corner points.
2491 sub box {
2492   my $self=shift;
2493   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2494   my $dflcl=i_color_new(255,255,255,255);
2495   my %opts=(color=>$dflcl,xmin=>0,ymin=>0,xmax=>$self->getwidth()-1,ymax=>$self->getheight()-1,@_);
2496
2497   if (exists $opts{'box'}) { 
2498     $opts{'xmin'} = _min($opts{'box'}->[0],$opts{'box'}->[2]);
2499     $opts{'xmax'} = _max($opts{'box'}->[0],$opts{'box'}->[2]);
2500     $opts{'ymin'} = _min($opts{'box'}->[1],$opts{'box'}->[3]);
2501     $opts{'ymax'} = _max($opts{'box'}->[1],$opts{'box'}->[3]);
2502   }
2503
2504   if ($opts{filled}) { 
2505     my $color = _color($opts{'color'});
2506     unless ($color) { 
2507       $self->{ERRSTR} = $Imager::ERRSTR; 
2508       return; 
2509     }
2510     i_box_filled($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},
2511                  $opts{ymax}, $color); 
2512   }
2513   elsif ($opts{fill}) {
2514     unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
2515       # assume it's a hash ref
2516       require 'Imager/Fill.pm';
2517       unless ($opts{fill} = Imager::Fill->new(%{$opts{fill}})) {
2518         $self->{ERRSTR} = $Imager::ERRSTR;
2519         return undef;
2520       }
2521     }
2522     i_box_cfill($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},
2523                 $opts{ymax},$opts{fill}{fill});
2524   }
2525   else {
2526     my $color = _color($opts{'color'});
2527     unless ($color) { 
2528       $self->{ERRSTR} = $Imager::ERRSTR;
2529       return;
2530     }
2531     i_box($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},$opts{ymax},
2532           $color);
2533   }
2534   return $self;
2535 }
2536
2537 sub arc {
2538   my $self=shift;
2539   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2540   my $dflcl=i_color_new(255,255,255,255);
2541   my %opts=(color=>$dflcl,
2542             'r'=>_min($self->getwidth(),$self->getheight())/3,
2543             'x'=>$self->getwidth()/2,
2544             'y'=>$self->getheight()/2,
2545             'd1'=>0, 'd2'=>361, @_);
2546   if ($opts{aa}) {
2547     if ($opts{fill}) {
2548       unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
2549         # assume it's a hash ref
2550         require 'Imager/Fill.pm';
2551         unless ($opts{fill} = Imager::Fill->new(%{$opts{fill}})) {
2552           $self->{ERRSTR} = $Imager::ERRSTR;
2553           return;
2554         }
2555       }
2556       i_arc_aa_cfill($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},$opts{'d1'},
2557                      $opts{'d2'}, $opts{fill}{fill});
2558     }
2559     else {
2560       my $color = _color($opts{'color'});
2561       unless ($color) { 
2562         $self->{ERRSTR} = $Imager::ERRSTR; 
2563         return; 
2564       }
2565       if ($opts{d1} == 0 && $opts{d2} == 361 && $opts{aa}) {
2566         i_circle_aa($self->{IMG}, $opts{'x'}, $opts{'y'}, $opts{'r'}, 
2567                     $color);
2568       }
2569       else {
2570         i_arc_aa($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},
2571                  $opts{'d1'}, $opts{'d2'}, $color); 
2572       }
2573     }
2574   }
2575   else {
2576     if ($opts{fill}) {
2577       unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
2578         # assume it's a hash ref
2579         require 'Imager/Fill.pm';
2580         unless ($opts{fill} = Imager::Fill->new(%{$opts{fill}})) {
2581           $self->{ERRSTR} = $Imager::ERRSTR;
2582           return;
2583         }
2584       }
2585       i_arc_cfill($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},$opts{'d1'},
2586                   $opts{'d2'}, $opts{fill}{fill});
2587     }
2588     else {
2589       my $color = _color($opts{'color'});
2590       unless ($color) { 
2591         $self->{ERRSTR} = $Imager::ERRSTR; 
2592         return; 
2593       }
2594       i_arc($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},
2595             $opts{'d1'}, $opts{'d2'}, $color); 
2596     }
2597   }
2598
2599   return $self;
2600 }
2601
2602 # Draws a line from one point to the other
2603 # the endpoint is set if the endp parameter is set which it is by default.
2604 # to turn of the endpoint being set use endp=>0 when calling line.
2605
2606 sub line {
2607   my $self=shift;
2608   my $dflcl=i_color_new(0,0,0,0);
2609   my %opts=(color=>$dflcl,
2610             endp => 1,
2611             @_);
2612   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2613
2614   unless (exists $opts{x1} and exists $opts{y1}) { $self->{ERRSTR}='missing begining coord'; return undef; }
2615   unless (exists $opts{x2} and exists $opts{y2}) { $self->{ERRSTR}='missing ending coord'; return undef; }
2616
2617   my $color = _color($opts{'color'});
2618   unless ($color) {
2619     $self->{ERRSTR} = $Imager::ERRSTR;
2620     return;
2621   }
2622
2623   $opts{antialias} = $opts{aa} if defined $opts{aa};
2624   if ($opts{antialias}) {
2625     i_line_aa($self->{IMG},$opts{x1}, $opts{y1}, $opts{x2}, $opts{y2},
2626               $color, $opts{endp});
2627   } else {
2628     i_line($self->{IMG},$opts{x1}, $opts{y1}, $opts{x2}, $opts{y2},
2629            $color, $opts{endp});
2630   }
2631   return $self;
2632 }
2633
2634 # Draws a line between an ordered set of points - It more or less just transforms this
2635 # into a list of lines.
2636
2637 sub polyline {
2638   my $self=shift;
2639   my ($pt,$ls,@points);
2640   my $dflcl=i_color_new(0,0,0,0);
2641   my %opts=(color=>$dflcl,@_);
2642
2643   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2644
2645   if (exists($opts{points})) { @points=@{$opts{points}}; }
2646   if (!exists($opts{points}) and exists($opts{'x'}) and exists($opts{'y'}) ) {
2647     @points=map { [ $opts{'x'}->[$_],$opts{'y'}->[$_] ] } (0..(scalar @{$opts{'x'}}-1));
2648     }
2649
2650 #  print Dumper(\@points);
2651
2652   my $color = _color($opts{'color'});
2653   unless ($color) { 
2654     $self->{ERRSTR} = $Imager::ERRSTR; 
2655     return; 
2656   }
2657   $opts{antialias} = $opts{aa} if defined $opts{aa};
2658   if ($opts{antialias}) {
2659     for $pt(@points) {
2660       if (defined($ls)) { 
2661         i_line_aa($self->{IMG},$ls->[0],$ls->[1],$pt->[0],$pt->[1],$color, 1);
2662       }
2663       $ls=$pt;
2664     }
2665   } else {
2666     for $pt(@points) {
2667       if (defined($ls)) { 
2668         i_line($self->{IMG},$ls->[0],$ls->[1],$pt->[0],$pt->[1],$color,1);
2669       }
2670       $ls=$pt;
2671     }
2672   }
2673   return $self;
2674 }
2675
2676 sub polygon {
2677   my $self = shift;
2678   my ($pt,$ls,@points);
2679   my $dflcl = i_color_new(0,0,0,0);
2680   my %opts = (color=>$dflcl, @_);
2681
2682   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2683
2684   if (exists($opts{points})) {
2685     $opts{'x'} = [ map { $_->[0] } @{$opts{points}} ];
2686     $opts{'y'} = [ map { $_->[1] } @{$opts{points}} ];
2687   }
2688
2689   if (!exists $opts{'x'} or !exists $opts{'y'})  {
2690     $self->{ERRSTR} = 'no points array, or x and y arrays.'; return undef;
2691   }
2692
2693   if ($opts{'fill'}) {
2694     unless (UNIVERSAL::isa($opts{'fill'}, 'Imager::Fill')) {
2695       # assume it's a hash ref
2696       require 'Imager/Fill.pm';
2697       unless ($opts{'fill'} = Imager::Fill->new(%{$opts{'fill'}})) {
2698         $self->{ERRSTR} = $Imager::ERRSTR;
2699         return undef;
2700       }
2701     }
2702     i_poly_aa_cfill($self->{IMG}, $opts{'x'}, $opts{'y'}, 
2703                     $opts{'fill'}{'fill'});
2704   }
2705   else {
2706     my $color = _color($opts{'color'});
2707     unless ($color) { 
2708       $self->{ERRSTR} = $Imager::ERRSTR; 
2709       return; 
2710     }
2711     i_poly_aa($self->{IMG}, $opts{'x'}, $opts{'y'}, $color);
2712   }
2713
2714   return $self;
2715 }
2716
2717
2718 # this the multipoint bezier curve
2719 # this is here more for testing that actual usage since
2720 # this is not a good algorithm.  Usually the curve would be
2721 # broken into smaller segments and each done individually.
2722
2723 sub polybezier {
2724   my $self=shift;
2725   my ($pt,$ls,@points);
2726   my $dflcl=i_color_new(0,0,0,0);
2727   my %opts=(color=>$dflcl,@_);
2728
2729   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2730
2731   if (exists $opts{points}) {
2732     $opts{'x'}=map { $_->[0]; } @{$opts{'points'}};
2733     $opts{'y'}=map { $_->[1]; } @{$opts{'points'}};
2734   }
2735
2736   unless ( @{$opts{'x'}} and @{$opts{'x'}} == @{$opts{'y'}} ) {
2737     $self->{ERRSTR}='Missing or invalid points.';
2738     return;
2739   }
2740
2741   my $color = _color($opts{'color'});
2742   unless ($color) { 
2743     $self->{ERRSTR} = $Imager::ERRSTR; 
2744     return; 
2745   }
2746   i_bezier_multi($self->{IMG},$opts{'x'},$opts{'y'},$color);
2747   return $self;
2748 }
2749
2750 sub flood_fill {
2751   my $self = shift;
2752   my %opts = ( color=>Imager::Color->new(255, 255, 255), @_ );
2753   my $rc;
2754
2755   unless (exists $opts{'x'} && exists $opts{'y'}) {
2756     $self->{ERRSTR} = "missing seed x and y parameters";
2757     return undef;
2758   }
2759
2760   if ($opts{border}) {
2761     my $border = _color($opts{border});
2762     unless ($border) {
2763       $self->_set_error($Imager::ERRSTR);
2764       return;
2765     }
2766     if ($opts{fill}) {
2767       unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
2768         # assume it's a hash ref
2769         require Imager::Fill;
2770         unless ($opts{fill} = Imager::Fill->new(%{$opts{fill}})) {
2771           $self->{ERRSTR} = $Imager::ERRSTR;
2772           return;
2773         }
2774       }
2775       $rc = i_flood_cfill_border($self->{IMG}, $opts{'x'}, $opts{'y'}, 
2776                                  $opts{fill}{fill}, $border);
2777     }
2778     else {
2779       my $color = _color($opts{'color'});
2780       unless ($color) {
2781         $self->{ERRSTR} = $Imager::ERRSTR;
2782         return;
2783       }
2784       $rc = i_flood_fill_border($self->{IMG}, $opts{'x'}, $opts{'y'}, 
2785                                 $color, $border);
2786     }
2787     if ($rc) { 
2788       return $self; 
2789     } 
2790     else { 
2791       $self->{ERRSTR} = $self->_error_as_msg(); 
2792       return;
2793     }
2794   }
2795   else {
2796     if ($opts{fill}) {
2797       unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
2798         # assume it's a hash ref
2799         require 'Imager/Fill.pm';
2800         unless ($opts{fill} = Imager::Fill->new(%{$opts{fill}})) {
2801           $self->{ERRSTR} = $Imager::ERRSTR;
2802           return;
2803         }
2804       }
2805       $rc = i_flood_cfill($self->{IMG}, $opts{'x'}, $opts{'y'}, $opts{fill}{fill});
2806     }
2807     else {
2808       my $color = _color($opts{'color'});
2809       unless ($color) {
2810         $self->{ERRSTR} = $Imager::ERRSTR;
2811         return;
2812       }
2813       $rc = i_flood_fill($self->{IMG}, $opts{'x'}, $opts{'y'}, $color);
2814     }
2815     if ($rc) { 
2816       return $self; 
2817     } 
2818     else { 
2819       $self->{ERRSTR} = $self->_error_as_msg(); 
2820       return;
2821     }
2822   } 
2823 }
2824
2825 sub setpixel {
2826   my $self = shift;
2827
2828   my %opts = ( color=>$self->{fg} || NC(255, 255, 255), @_);
2829
2830   unless (exists $opts{'x'} && exists $opts{'y'}) {
2831     $self->{ERRSTR} = 'missing x and y parameters';
2832     return undef;
2833   }
2834
2835   my $x = $opts{'x'};
2836   my $y = $opts{'y'};
2837   my $color = _color($opts{color})
2838     or return undef;
2839   if (ref $x && ref $y) {
2840     unless (@$x == @$y) {
2841       $self->{ERRSTR} = 'length of x and y mismatch';
2842       return;
2843     }
2844     my $set = 0;
2845     if ($color->isa('Imager::Color')) {
2846       for my $i (0..$#{$opts{'x'}}) {
2847         i_ppix($self->{IMG}, $x->[$i], $y->[$i], $color)
2848           or ++$set;
2849       }
2850     }
2851     else {
2852       for my $i (0..$#{$opts{'x'}}) {
2853         i_ppixf($self->{IMG}, $x->[$i], $y->[$i], $color)
2854           or ++$set;
2855       }
2856     }
2857     $set or return;
2858     return $set;
2859   }
2860   else {
2861     if ($color->isa('Imager::Color')) {
2862       i_ppix($self->{IMG}, $x, $y, $color)
2863         and return;
2864     }
2865     else {
2866       i_ppixf($self->{IMG}, $x, $y, $color)
2867         and return;
2868     }
2869   }
2870
2871   $self;
2872 }
2873
2874 sub getpixel {
2875   my $self = shift;
2876
2877   my %opts = ( "type"=>'8bit', @_);
2878
2879   unless (exists $opts{'x'} && exists $opts{'y'}) {
2880     $self->{ERRSTR} = 'missing x and y parameters';
2881     return undef;
2882   }
2883
2884   my $x = $opts{'x'};
2885   my $y = $opts{'y'};
2886   if (ref $x && ref $y) {
2887     unless (@$x == @$y) {
2888       $self->{ERRSTR} = 'length of x and y mismatch';
2889       return undef;
2890     }
2891     my @result;
2892     if ($opts{"type"} eq '8bit') {
2893       for my $i (0..$#{$opts{'x'}}) {
2894         push(@result, i_get_pixel($self->{IMG}, $x->[$i], $y->[$i]));
2895       }
2896     }
2897     else {
2898       for my $i (0..$#{$opts{'x'}}) {
2899         push(@result, i_gpixf($self->{IMG}, $x->[$i], $y->[$i]));
2900       }
2901     }
2902     return wantarray ? @result : \@result;
2903   }
2904   else {
2905     if ($opts{"type"} eq '8bit') {
2906       return i_get_pixel($self->{IMG}, $x, $y);
2907     }
2908     else {
2909       return i_gpixf($self->{IMG}, $x, $y);
2910     }
2911   }
2912
2913   $self;
2914 }
2915
2916 sub getscanline {
2917   my $self = shift;
2918   my %opts = ( type => '8bit', x=>0, @_);
2919
2920   $self->_valid_image or return;
2921
2922   defined $opts{width} or $opts{width} = $self->getwidth - $opts{x};
2923
2924   unless (defined $opts{'y'}) {
2925     $self->_set_error("missing y parameter");
2926     return;
2927   }
2928
2929   if ($opts{type} eq '8bit') {
2930     return i_glin($self->{IMG}, $opts{x}, $opts{x}+$opts{width},
2931                   $opts{'y'});
2932   }
2933   elsif ($opts{type} eq 'float') {
2934     return i_glinf($self->{IMG}, $opts{x}, $opts{x}+$opts{width},
2935                   $opts{'y'});
2936   }
2937   elsif ($opts{type} eq 'index') {
2938     unless (i_img_type($self->{IMG})) {
2939       $self->_set_error("type => index only valid on paletted images");
2940       return;
2941     }
2942     return i_gpal($self->{IMG}, $opts{x}, $opts{x} + $opts{width},
2943                   $opts{'y'});
2944   }
2945   else {
2946     $self->_set_error("invalid type parameter - must be '8bit' or 'float'");
2947     return;
2948   }
2949 }
2950
2951 sub setscanline {
2952   my $self = shift;
2953   my %opts = ( x=>0, @_);
2954
2955   $self->_valid_image or return;
2956
2957   unless (defined $opts{'y'}) {
2958     $self->_set_error("missing y parameter");
2959     return;
2960   }
2961
2962   if (!$opts{type}) {
2963     if (ref $opts{pixels} && @{$opts{pixels}}) {
2964       # try to guess the type
2965       if ($opts{pixels}[0]->isa('Imager::Color')) {
2966         $opts{type} = '8bit';
2967       }
2968       elsif ($opts{pixels}[0]->isa('Imager::Color::Float')) {
2969         $opts{type} = 'float';
2970       }
2971       else {
2972         $self->_set_error("missing type parameter and could not guess from pixels");
2973         return;
2974       }
2975     }
2976     else {
2977       # default
2978       $opts{type} = '8bit';
2979     }
2980   }
2981
2982   if ($opts{type} eq '8bit') {
2983     if (ref $opts{pixels}) {
2984       return i_plin($self->{IMG}, $opts{x}, $opts{'y'}, @{$opts{pixels}});
2985     }
2986     else {
2987       return i_plin($self->{IMG}, $opts{x}, $opts{'y'}, $opts{pixels});
2988     }
2989   }
2990   elsif ($opts{type} eq 'float') {
2991     if (ref $opts{pixels}) {
2992       return i_plinf($self->{IMG}, $opts{x}, $opts{'y'}, @{$opts{pixels}});
2993     }
2994     else {
2995       return i_plinf($self->{IMG}, $opts{x}, $opts{'y'}, $opts{pixels});
2996     }
2997   }
2998   elsif ($opts{type} eq 'index') {
2999     if (ref $opts{pixels}) {
3000       return i_ppal($self->{IMG}, $opts{x}, $opts{'y'}, @{$opts{pixels}});
3001     }
3002     else {
3003       return i_ppal_p($self->{IMG}, $opts{x}, $opts{'y'}, $opts{pixels});
3004     }
3005   }
3006   else {
3007     $self->_set_error("invalid type parameter - must be '8bit' or 'float'");
3008     return;
3009   }
3010 }
3011
3012 sub getsamples {
3013   my $self = shift;
3014   my %opts = ( type => '8bit', x=>0, @_);
3015
3016   defined $opts{width} or $opts{width} = $self->getwidth - $opts{x};
3017
3018   unless (defined $opts{'y'}) {
3019     $self->_set_error("missing y parameter");
3020     return;
3021   }
3022   
3023   unless ($opts{channels}) {
3024     $opts{channels} = [ 0 .. $self->getchannels()-1 ];
3025   }
3026
3027   if ($opts{type} eq '8bit') {
3028     return i_gsamp($self->{IMG}, $opts{x}, $opts{x}+$opts{width},
3029                    $opts{y}, @{$opts{channels}});
3030   }
3031   elsif ($opts{type} eq 'float') {
3032     return i_gsampf($self->{IMG}, $opts{x}, $opts{x}+$opts{width},
3033                     $opts{y}, @{$opts{channels}});
3034   }
3035   else {
3036     $self->_set_error("invalid type parameter - must be '8bit' or 'float'");
3037     return;
3038   }
3039 }
3040
3041 # make an identity matrix of the given size
3042 sub _identity {
3043   my ($size) = @_;
3044
3045   my $matrix = [ map { [ (0) x $size ] } 1..$size ];
3046   for my $c (0 .. ($size-1)) {
3047     $matrix->[$c][$c] = 1;
3048   }
3049   return $matrix;
3050 }
3051
3052 # general function to convert an image
3053 sub convert {
3054   my ($self, %opts) = @_;
3055   my $matrix;
3056
3057   unless (defined wantarray) {
3058     my @caller = caller;
3059     warn "convert() called in void context - convert() returns the converted image at $caller[1] line $caller[2]\n";
3060     return;
3061   }
3062
3063   # the user can either specify a matrix or preset
3064   # the matrix overrides the preset
3065   if (!exists($opts{matrix})) {
3066     unless (exists($opts{preset})) {
3067       $self->{ERRSTR} = "convert() needs a matrix or preset";
3068       return;
3069     }
3070     else {
3071       if ($opts{preset} eq 'gray' || $opts{preset} eq 'grey') {
3072         # convert to greyscale, keeping the alpha channel if any
3073         if ($self->getchannels == 3) {
3074           $matrix = [ [ 0.222, 0.707, 0.071 ] ];
3075         }
3076         elsif ($self->getchannels == 4) {
3077           # preserve the alpha channel
3078           $matrix = [ [ 0.222, 0.707, 0.071, 0 ],
3079                       [ 0,     0,     0,     1 ] ];
3080         }
3081         else {
3082           # an identity
3083           $matrix = _identity($self->getchannels);
3084         }
3085       }
3086       elsif ($opts{preset} eq 'noalpha') {
3087         # strip the alpha channel
3088         if ($self->getchannels == 2 or $self->getchannels == 4) {
3089           $matrix = _identity($self->getchannels);
3090           pop(@$matrix); # lose the alpha entry
3091         }
3092         else {
3093           $matrix = _identity($self->getchannels);
3094         }
3095       }
3096       elsif ($opts{preset} eq 'red' || $opts{preset} eq 'channel0') {
3097         # extract channel 0
3098         $matrix = [ [ 1 ] ];
3099       }
3100       elsif ($opts{preset} eq 'green' || $opts{preset} eq 'channel1') {
3101         $matrix = [ [ 0, 1 ] ];
3102       }
3103       elsif ($opts{preset} eq 'blue' || $opts{preset} eq 'channel2') {
3104         $matrix = [ [ 0, 0, 1 ] ];
3105       }
3106       elsif ($opts{preset} eq 'alpha') {
3107         if ($self->getchannels == 2 or $self->getchannels == 4) {
3108           $matrix = [ [ (0) x ($self->getchannels-1), 1 ] ];
3109         }
3110         else {
3111           # the alpha is just 1 <shrug>
3112           $matrix = [ [ (0) x $self->getchannels, 1 ] ];
3113         }
3114       }
3115       elsif ($opts{preset} eq 'rgb') {
3116         if ($self->getchannels == 1) {
3117           $matrix = [ [ 1 ], [ 1 ], [ 1 ] ];
3118         }
3119         elsif ($self->getchannels == 2) {
3120           # preserve the alpha channel
3121           $matrix = [ [ 1, 0 ], [ 1, 0 ], [ 1, 0 ], [ 0, 1 ] ];
3122         }
3123         else {
3124           $matrix = _identity($self->getchannels);
3125         }
3126       }
3127       elsif ($opts{preset} eq 'addalpha') {
3128         if ($self->getchannels == 1) {
3129           $matrix = _identity(2);
3130         }
3131         elsif ($self->getchannels == 3) {
3132           $matrix = _identity(4);
3133         }
3134         else {
3135           $matrix = _identity($self->getchannels);
3136         }
3137       }
3138       else {
3139         $self->{ERRSTR} = "Unknown convert preset $opts{preset}";
3140         return undef;
3141       }
3142     }
3143   }
3144   else {
3145     $matrix = $opts{matrix};
3146   }
3147
3148   my $new = Imager->new;
3149   $new->{IMG} = i_convert($self->{IMG}, $matrix);
3150   unless ($new->{IMG}) {
3151     # most likely a bad matrix
3152     $self->{ERRSTR} = _error_as_msg();
3153     return undef;
3154   }
3155   return $new;
3156 }
3157
3158
3159 # general function to map an image through lookup tables
3160
3161 sub map {
3162   my ($self, %opts) = @_;
3163   my @chlist = qw( red green blue alpha );
3164
3165   if (!exists($opts{'maps'})) {
3166     # make maps from channel maps
3167     my $chnum;
3168     for $chnum (0..$#chlist) {
3169       if (exists $opts{$chlist[$chnum]}) {
3170         $opts{'maps'}[$chnum] = $opts{$chlist[$chnum]};
3171       } elsif (exists $opts{'all'}) {
3172         $opts{'maps'}[$chnum] = $opts{'all'};
3173       }
3174     }
3175   }
3176   if ($opts{'maps'} and $self->{IMG}) {
3177     i_map($self->{IMG}, $opts{'maps'} );
3178   }
3179   return $self;
3180 }
3181
3182 sub difference {
3183   my ($self, %opts) = @_;
3184
3185   defined $opts{mindist} or $opts{mindist} = 0;
3186
3187   defined $opts{other}
3188     or return $self->_set_error("No 'other' parameter supplied");
3189   defined $opts{other}{IMG}
3190     or return $self->_set_error("No image data in 'other' image");
3191
3192   $self->{IMG}
3193     or return $self->_set_error("No image data");
3194
3195   my $result = Imager->new;
3196   $result->{IMG} = i_diff_image($self->{IMG}, $opts{other}{IMG}, 
3197                                 $opts{mindist})
3198     or return $self->_set_error($self->_error_as_msg());
3199
3200   return $result;
3201 }
3202
3203 # destructive border - image is shrunk by one pixel all around
3204
3205 sub border {
3206   my ($self,%opts)=@_;
3207   my($tx,$ty)=($self->getwidth()-1,$self->getheight()-1);
3208   $self->polyline('x'=>[0,$tx,$tx,0,0],'y'=>[0,0,$ty,$ty,0],%opts);
3209 }
3210
3211
3212 # Get the width of an image
3213
3214 sub getwidth {
3215   my $self = shift;
3216   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
3217   return (i_img_info($self->{IMG}))[0];
3218 }
3219
3220 # Get the height of an image
3221
3222 sub getheight {
3223   my $self = shift;
3224   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
3225   return (i_img_info($self->{IMG}))[1];
3226 }
3227
3228 # Get number of channels in an image
3229
3230 sub getchannels {
3231   my $self = shift;
3232   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
3233   return i_img_getchannels($self->{IMG});
3234 }
3235
3236 # Get channel mask
3237
3238 sub getmask {
3239   my $self = shift;
3240   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
3241   return i_img_getmask($self->{IMG});
3242 }
3243
3244 # Set channel mask
3245
3246 sub setmask {
3247   my $self = shift;
3248   my %opts = @_;
3249   if (!defined($self->{IMG})) { 
3250     $self->{ERRSTR} = 'image is empty';
3251     return undef;
3252   }
3253   unless (defined $opts{mask}) {
3254     $self->_set_error("mask parameter required");
3255     return;
3256   }
3257   i_img_setmask( $self->{IMG} , $opts{mask} );
3258
3259   1;
3260 }
3261
3262 # Get number of colors in an image
3263
3264 sub getcolorcount {
3265   my $self=shift;
3266   my %opts=('maxcolors'=>2**30,@_);
3267   if (!defined($self->{IMG})) { $self->{ERRSTR}='image is empty'; return undef; }
3268   my $rc=i_count_colors($self->{IMG},$opts{'maxcolors'});
3269   return ($rc==-1? undef : $rc);
3270 }
3271
3272 # Returns a reference to a hash. The keys are colour named (packed) and the
3273 # values are the number of pixels in this colour.
3274 sub getcolorusagehash {
3275     my $self = shift;
3276     my $channels= $self->getchannels;
3277     # We don't want to look at the alpha channel, because some gifs using it
3278     # doesn't define it for every colour (but only for some)
3279     $channels -= 1 if $channels == 2 or $channels == 4;
3280     my %colour_use;
3281     my $height = $self->getheight;
3282     for my $y (0 .. $height - 1) {
3283         my $colours = $self->getsamples(y => $y, channels => [ 0 .. $channels - 1 ]);
3284         while (length $colours) {
3285             $colour_use{ substr($colours, 0, $channels, '') }++;
3286         }
3287     }
3288     return \%colour_use;
3289 }
3290
3291 # This will return a ordered array of the colour usage. Kind of the sorted
3292 # version of the values of the hash returned by getcolorusagehash.
3293 # You might want to add safety checks and change the names, etc...
3294 sub getcolorusage {
3295   my $self=shift;
3296   return get_anonymous_colour_usage ($self);
3297 }
3298
3299 # draw string to an image
3300
3301 sub string {
3302   my $self = shift;
3303   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
3304
3305   my %input=('x'=>0, 'y'=>0, @_);
3306   defined($input{string}) or $input{string} = $input{text};
3307
3308   unless(defined $input{string}) {
3309     $self->{ERRSTR}="missing required parameter 'string'";
3310     return;
3311   }
3312
3313   unless($input{font}) {
3314     $self->{ERRSTR}="missing required parameter 'font'";
3315     return;
3316   }
3317
3318   unless ($input{font}->draw(image=>$self, %input)) {
3319     return;
3320   }
3321
3322   return $self;
3323 }
3324
3325 sub align_string {
3326   my $self = shift;
3327
3328   my $img;
3329   if (ref $self) {
3330     unless ($self->{IMG}) { 
3331       $self->{ERRSTR}='empty input image'; 
3332       return;
3333     }
3334     $img = $self;
3335   }
3336   else {
3337     $img = undef;
3338   }
3339
3340   my %input=('x'=>0, 'y'=>0, @_);
3341   $input{string}||=$input{text};
3342
3343   unless(exists $input{string}) {
3344     $self->_set_error("missing required parameter 'string'");
3345     return;
3346   }
3347
3348   unless($input{font}) {
3349     $self->_set_error("missing required parameter 'font'");
3350     return;
3351   }
3352
3353   my @result;
3354   unless (@result = $input{font}->align(image=>$img, %input)) {
3355     return;
3356   }
3357
3358   return wantarray ? @result : $result[0];
3359 }
3360
3361 my @file_limit_names = qw/width height bytes/;
3362
3363 sub set_file_limits {
3364   shift;
3365
3366   my %opts = @_;
3367   my %values;
3368   
3369   if ($opts{reset}) {
3370     @values{@file_limit_names} = (0) x @file_limit_names;
3371   }
3372   else {
3373     @values{@file_limit_names} = i_get_image_file_limits();
3374   }
3375
3376   for my $key (keys %values) {
3377     defined $opts{$key} and $values{$key} = $opts{$key};
3378   }
3379
3380   i_set_image_file_limits($values{width}, $values{height}, $values{bytes});
3381 }
3382
3383 sub get_file_limits {
3384   i_get_image_file_limits();
3385 }
3386
3387 # Shortcuts that can be exported
3388
3389 sub newcolor { Imager::Color->new(@_); }
3390 sub newfont  { Imager::Font->new(@_); }
3391
3392 *NC=*newcolour=*newcolor;
3393 *NF=*newfont;
3394
3395 *open=\&read;
3396 *circle=\&arc;
3397
3398
3399 #### Utility routines
3400
3401 sub errstr { 
3402   ref $_[0] ? $_[0]->{ERRSTR} : $ERRSTR
3403 }
3404
3405 sub _set_error {
3406   my ($self, $msg) = @_;
3407
3408   if (ref $self) {
3409     $self->{ERRSTR} = $msg;
3410   }
3411   else {
3412     $ERRSTR = $msg;
3413   }
3414   return;
3415 }
3416
3417 # Default guess for the type of an image from extension
3418
3419 sub def_guess_type {
3420   my $name=lc(shift);
3421   my $ext;
3422   $ext=($name =~ m/\.([^\.]+)$/)[0];
3423   return 'tiff' if ($ext =~ m/^tiff?$/);
3424   return 'jpeg' if ($ext =~ m/^jpe?g$/);
3425   return 'pnm'  if ($ext =~ m/^p[pgb]m$/);
3426   return 'png'  if ($ext eq "png");
3427   return 'bmp'  if ($ext eq "bmp" || $ext eq "dib");
3428   return 'tga'  if ($ext eq "tga");
3429   return 'sgi'  if ($ext eq "rgb" || $ext eq "bw" || $ext eq "sgi" || $ext eq "rgba");
3430   return 'gif'  if ($ext eq "gif");
3431   return 'raw'  if ($ext eq "raw");
3432   return lc $ext; # best guess
3433   return ();
3434 }
3435
3436 # get the minimum of a list
3437
3438 sub _min {
3439   my $mx=shift;
3440   for(@_) { if ($_<$mx) { $mx=$_; }}
3441   return $mx;
3442 }
3443
3444 # get the maximum of a list
3445
3446 sub _max {
3447   my $mx=shift;
3448   for(@_) { if ($_>$mx) { $mx=$_; }}
3449   return $mx;
3450 }
3451
3452 # string stuff for iptc headers
3453
3454 sub _clean {
3455   my($str)=$_[0];
3456   $str = substr($str,3);
3457   $str =~ s/[\n\r]//g;
3458   $str =~ s/\s+/ /g;
3459   $str =~ s/^\s//;
3460   $str =~ s/\s$//;
3461   return $str;
3462 }
3463
3464 # A little hack to parse iptc headers.
3465
3466 sub parseiptc {
3467   my $self=shift;
3468   my(@sar,$item,@ar);
3469   my($caption,$photogr,$headln,$credit);
3470
3471   my $str=$self->{IPTCRAW};
3472
3473   defined $str
3474     or return;
3475
3476   @ar=split(/8BIM/,$str);
3477
3478   my $i=0;
3479   foreach (@ar) {
3480     if (/^\004\004/) {
3481       @sar=split(/\034\002/);
3482       foreach $item (@sar) {
3483         if ($item =~ m/^x/) {
3484           $caption = _clean($item);
3485           $i++;
3486         }
3487         if ($item =~ m/^P/) {
3488           $photogr = _clean($item);
3489           $i++;
3490         }
3491         if ($item =~ m/^i/) {
3492           $headln = _clean($item);
3493           $i++;
3494         }
3495         if ($item =~ m/^n/) {
3496           $credit = _clean($item);
3497           $i++;
3498         }
3499       }
3500     }
3501   }
3502   return (caption=>$caption,photogr=>$photogr,headln=>$headln,credit=>$credit);
3503 }
3504
3505 sub Inline {
3506   my ($lang) = @_;
3507
3508   $lang eq 'C'
3509     or die "Only C language supported";
3510
3511   require Imager::ExtUtils;
3512   return Imager::ExtUtils->inline_config;
3513 }
3514
3515 1;
3516 __END__
3517 # Below is the stub of documentation for your module. You better edit it!
3518
3519 =head1 NAME
3520
3521 Imager - Perl extension for Generating 24 bit Images
3522
3523 =head1 SYNOPSIS
3524
3525   # Thumbnail example
3526
3527   #!/usr/bin/perl -w
3528   use strict;
3529   use Imager;
3530
3531   die "Usage: thumbmake.pl filename\n" if !-f $ARGV[0];
3532   my $file = shift;
3533
3534   my $format;
3535
3536   my $img = Imager->new();
3537   # see Imager::Files for information on the read() method
3538   $img->read(file=>$file) or die $img->errstr();
3539
3540   $file =~ s/\.[^.]*$//;
3541
3542   # Create smaller version
3543   # documented in Imager::Transformations
3544   my $thumb = $img->scale(scalefactor=>.3);
3545
3546   # Autostretch individual channels
3547   $thumb->filter(type=>'autolevels');
3548
3549   # try to save in one of these formats
3550   SAVE:
3551
3552   for $format ( qw( png gif jpg tiff ppm ) ) {
3553     # Check if given format is supported
3554     if ($Imager::formats{$format}) {
3555       $file.="_low.$format";
3556       print "Storing image as: $file\n";
3557       # documented in Imager::Files
3558       $thumb->write(file=>$file) or
3559         die $thumb->errstr;
3560       last SAVE;
3561     }
3562   }
3563
3564 =head1 DESCRIPTION
3565
3566 Imager is a module for creating and altering images.  It can read and
3567 write various image formats, draw primitive shapes like lines,and
3568 polygons, blend multiple images together in various ways, scale, crop,
3569 render text and more.
3570
3571 =head2 Overview of documentation
3572
3573 =over
3574
3575 =item *
3576
3577 Imager - This document - Synopsis, Example, Table of Contents and
3578 Overview.
3579
3580 =item *
3581
3582 L<Imager::Tutorial> - a brief introduction to Imager.
3583
3584 =item *
3585
3586 L<Imager::Cookbook> - how to do various things with Imager.
3587
3588 =item *
3589
3590 L<Imager::ImageTypes> - Basics of constructing image objects with
3591 C<new()>: Direct type/virtual images, RGB(A)/paletted images,
3592 8/16/double bits/channel, color maps, channel masks, image tags, color
3593 quantization.  Also discusses basic image information methods.
3594
3595 =item *
3596
3597 L<Imager::Files> - IO interaction, reading/writing images, format
3598 specific tags.
3599
3600 =item *
3601
3602 L<Imager::Draw> - Drawing Primitives, lines, boxes, circles, arcs,
3603 flood fill.
3604
3605 =item *
3606
3607 L<Imager::Color> - Color specification.
3608
3609 =item *
3610
3611 L<Imager::Fill> - Fill pattern specification.
3612
3613 =item *
3614
3615 L<Imager::Font> - General font rendering, bounding boxes and font
3616 metrics.
3617
3618 =item *
3619
3620 L<Imager::Transformations> - Copying, scaling, cropping, flipping,
3621 blending, pasting, convert and map.
3622
3623 =item *
3624
3625 L<Imager::Engines> - Programmable transformations through
3626 C<transform()>, C<transform2()> and C<matrix_transform()>.
3627
3628 =item *
3629
3630 L<Imager::Filters> - Filters, sharpen, blur, noise, convolve etc. and
3631 filter plugins.
3632
3633 =item *
3634
3635 L<Imager::Expr> - Expressions for evaluation engine used by
3636 transform2().
3637
3638 =item *
3639
3640 L<Imager::Matrix2d> - Helper class for affine transformations.
3641
3642 =item *
3643
3644 L<Imager::Fountain> - Helper for making gradient profiles.
3645
3646 =item *
3647
3648 L<Imager::API> - using Imager's C API
3649
3650 =item *
3651
3652 L<Imager::APIRef> - API function reference
3653
3654 =item *
3655
3656 L<Imager::Inline> - using Imager's C API from Inline::C
3657
3658 =item *
3659
3660 L<Imager::ExtUtils> - tools to get access to Imager's C API.
3661
3662 =back
3663
3664 =head2 Basic Overview
3665
3666 An Image object is created with C<$img = Imager-E<gt>new()>.
3667 Examples:
3668
3669   $img=Imager->new();                         # create empty image
3670   $img->read(file=>'lena.png',type=>'png') or # read image from file
3671      die $img->errstr();                      # give an explanation
3672                                               # if something failed
3673
3674 or if you want to create an empty image:
3675
3676   $img=Imager->new(xsize=>400,ysize=>300,channels=>4);
3677
3678 This example creates a completely black image of width 400 and height
3679 300 and 4 channels.
3680
3681 =head1 ERROR HANDLING
3682
3683 In general a method will return false when it fails, if it does use the errstr() method to find out why:
3684
3685 =over
3686
3687 =item errstr
3688
3689 Returns the last error message in that context.
3690
3691 If the last error you received was from calling an object method, such
3692 as read, call errstr() as an object method to find out why:
3693
3694   my $image = Imager->new;
3695   $image->read(file => 'somefile.gif')
3696      or die $image->errstr;
3697
3698 If it was a class method then call errstr() as a class method:
3699
3700   my @imgs = Imager->read_multi(file => 'somefile.gif')
3701     or die Imager->errstr;
3702
3703 Note that in some cases object methods are implemented in terms of
3704 class methods so a failing object method may set both.
3705
3706 =back
3707
3708 The C<Imager-E<gt>new> method is described in detail in
3709 L<Imager::ImageTypes>.
3710
3711 =head1 METHOD INDEX
3712
3713 Where to find information on methods for Imager class objects.
3714
3715 addcolors() -  L<Imager::ImageTypes/addcolors>
3716
3717 addtag() -  L<Imager::ImageTypes/addtag> - add image tags
3718
3719 align_string() - L<Imager::Draw/align_string>
3720
3721 arc() - L<Imager::Draw/arc>
3722
3723 bits() - L<Imager::ImageTypes/bits> - number of bits per sample for the
3724 image
3725
3726 box() - L<Imager::Draw/box>
3727
3728 circle() - L<Imager::Draw/circle>
3729
3730 colorcount() - L<Imager::Draw/colorcount>
3731
3732 convert() - L<Imager::Transformations/"Color transformations"> -
3733 transform the color space
3734
3735 copy() - L<Imager::Transformations/copy>
3736
3737 crop() - L<Imager::Transformations/crop> - extract part of an image
3738
3739 def_guess_type() - L<Imager::Files/def_guess_type>
3740
3741 deltag() -  L<Imager::ImageTypes/deltag> - delete image tags
3742
3743 difference() - L<Imager::Filters/"Image Difference">
3744
3745 errstr() - L<"Basic Overview">
3746
3747 filter() - L<Imager::Filters>
3748
3749 findcolor() - L<Imager::ImageTypes/findcolor> - search the image palette, if it
3750 has one
3751
3752 flip() - L<Imager::Transformations/flip>
3753
3754 flood_fill() - L<Imager::Draw/flood_fill>
3755
3756 getchannels() -  L<Imager::ImageTypes/getchannels>
3757
3758 getcolorcount() -  L<Imager::ImageTypes/getcolorcount>
3759
3760 getcolors() - L<Imager::ImageTypes/getcolors> - get colors from the image
3761 palette, if it has one
3762
3763 get_file_limits() - L<Imager::Files/"Limiting the sizes of images you read">
3764
3765 getheight() - L<Imager::ImageTypes/getwidth>
3766
3767 getmask() - L<Imager::ImageTypes/getmask>
3768
3769 getpixel() - L<Imager::Draw/getpixel>
3770
3771 getsamples() - L<Imager::Draw/getsamples>
3772
3773 getscanline() - L<Imager::Draw/getscanline>
3774
3775 getwidth() - L<Imager::ImageTypes/getwidth>
3776
3777 img_set() - L<Imager::ImageTypes/img_set>
3778
3779 init() - L<Imager::ImageTypes/init>
3780
3781 line() - L<Imager::Draw/line>
3782
3783 load_plugin() - L<Imager::Filters/load_plugin>
3784
3785 map() - L<Imager::Transformations/"Color Mappings"> - remap color
3786 channel values
3787
3788 masked() -  L<Imager::ImageTypes/masked> - make a masked image
3789
3790 matrix_transform() - L<Imager::Engines/matrix_transform>
3791
3792 maxcolors() - L<Imager::ImageTypes/maxcolors>
3793
3794 NC() - L<Imager::Handy/NC>
3795
3796 new() - L<Imager::ImageTypes/new>
3797
3798 newcolor() - L<Imager::Handy/newcolor>
3799
3800 newcolour() - L<Imager::Handy/newcolour>
3801
3802 newfont() - L<Imager::Handy/newfont>
3803
3804 NF() - L<Imager::Handy/NF>
3805
3806 open() - L<Imager::Files> - an alias for read()
3807
3808 parseiptc() - L<Imager::Files/parseiptc> - parse IPTC data from a JPEG
3809 image
3810
3811 paste() - L<Imager::Transformations/paste> - draw an image onto an image
3812
3813 polygon() - L<Imager::Draw/polygon>
3814
3815 polyline() - L<Imager::Draw/polyline>
3816
3817 read() - L<Imager::Files> - read a single image from an image file
3818
3819 read_multi() - L<Imager::Files> - read multiple images from an image
3820 file
3821
3822 register_filter() - L<Imager::Filters/register_filter>
3823
3824 register_reader() - L<Imager::Filters/register_reader>
3825
3826 register_writer() - L<Imager::Filters/register_writer>
3827
3828 rotate() - L<Imager::Transformations/rotate>
3829
3830 rubthrough() - L<Imager::Transformations/rubthrough> - draw an image onto an
3831 image and use the alpha channel
3832
3833 scale() - L<Imager::Transformations/scale>
3834
3835 scaleX() - L<Imager::Transformations/scaleX>
3836
3837 scaleY() - L<Imager::Transformations/scaleY>
3838
3839 setcolors() - L<Imager::ImageTypes/setcolors> - set palette colors in
3840 a paletted image
3841
3842 set_file_limits() - L<Imager::Files/"Limiting the sizes of images you read">
3843
3844 setmask() - L<Imager::ImageTypes/setmask>
3845
3846 setpixel() - L<Imager::Draw/setpixel>
3847
3848 setscanline() - L<Imager::Draw/setscanline>
3849
3850 settag() - L<Imager::ImageTypes/settag>
3851
3852 string() - L<Imager::Draw/string> - draw text on an image
3853
3854 tags() -  L<Imager::ImageTypes/tags> - fetch image tags
3855
3856 to_paletted() -  L<Imager::ImageTypes/to_paletted>
3857
3858 to_rgb16() - L<Imager::ImageTypes/to_rgb16>
3859
3860 to_rgb8() - L<Imager::ImageTypes/to_rgb8>
3861
3862 transform() - L<Imager::Engines/"transform">
3863
3864 transform2() - L<Imager::Engines/"transform2">
3865
3866 type() -  L<Imager::ImageTypes/type> - type of image (direct vs paletted)
3867
3868 unload_plugin() - L<Imager::Filters/unload_plugin>
3869
3870 virtual() - L<Imager::ImageTypes/virtual> - whether the image has it's own
3871 data
3872
3873 write() - L<Imager::Files> - write an image to a file
3874
3875 write_multi() - L<Imager::Files> - write multiple image to an image
3876 file.
3877
3878 =head1 CONCEPT INDEX
3879
3880 animated GIF - L<Imager::File/"Writing an animated GIF">
3881
3882 aspect ratio - L<Imager::ImageTypes/i_xres>,
3883 L<Imager::ImageTypes/i_yres>, L<Imager::ImageTypes/i_aspect_only>
3884
3885 blend - alpha blending one image onto another
3886 L<Imager::Transformations/rubthrough>
3887
3888 blur - L<Imager::Filters/guassian>, L<Imager::Filters/conv>
3889
3890 boxes, drawing - L<Imager::Draw/box>
3891
3892 changes between image - L<Imager::Filter/"Image Difference">
3893
3894 color - L<Imager::Color>
3895
3896 color names - L<Imager::Color>, L<Imager::Color::Table>
3897
3898 combine modes - L<Imager::Fill/combine>
3899
3900 compare images - L<Imager::Filter/"Image Difference">
3901
3902 contrast - L<Imager::Filter/contrast>, L<Imager::Filter/autolevels>
3903
3904 convolution - L<Imager::Filter/conv>
3905
3906 cropping - L<Imager::Transformations/crop>
3907
3908 CUR files - L<Imager::Files/"ICO (Microsoft Windows Icon) and CUR (Microsoft Windows Cursor)">
3909
3910 C<diff> images - L<Imager::Filter/"Image Difference">
3911
3912 dpi - L<Imager::ImageTypes/i_xres>, 
3913 L<Imager::Cookbook/"Image spatial resolution">
3914
3915 drawing boxes - L<Imager::Draw/box>
3916
3917 drawing lines - L<Imager::Draw/line>
3918
3919 drawing text - L<Imager::Draw/string>, L<Imager::Draw/align_string>
3920
3921 error message - L<"Basic Overview">
3922
3923 files, font - L<Imager::Font>
3924
3925 files, image - L<Imager::Files>
3926
3927 filling, types of fill - L<Imager::Fill>
3928
3929 filling, boxes - L<Imager::Draw/box>
3930
3931 filling, flood fill - L<Imager::Draw/flood_fill>
3932
3933 flood fill - L<Imager::Draw/flood_fill>
3934
3935 fonts - L<Imager::Font>
3936
3937 fonts, drawing with - L<Imager::Draw/string>,
3938 L<Imager::Draw/align_string>, L<Imager::Font::Wrap>
3939
3940 fonts, metrics - L<Imager::Font/bounding_box>, L<Imager::Font::BBox>
3941
3942 fonts, multiple master - L<Imager::Font/"MULTIPLE MASTER FONTS">
3943
3944 fountain fill - L<Imager::Fill/"Fountain fills">,
3945 L<Imager::Filters/fountain>, L<Imager::Fountain>,
3946 L<Imager::Filters/gradgen>
3947
3948 GIF files - L<Imager::Files/"GIF">
3949
3950 GIF files, animated - L<Imager::File/"Writing an animated GIF">
3951
3952 gradient fill - L<Imager::Fill/"Fountain fills">,
3953 L<Imager::Filters/fountain>, L<Imager::Fountain>,
3954 L<Imager::Filters/gradgen>
3955
3956 guassian blur - L<Imager::Filter/guassian>
3957
3958 hatch fills - L<Imager::Fill/"Hatched fills">
3959
3960 ICO files - L<Imager::Files/"ICO (Microsoft Windows Icon) and CUR (Microsoft Windows Cursor)">
3961
3962 invert image - L<Imager::Filter/hardinvert>
3963
3964 JPEG - L<Imager::Files/"JPEG">
3965
3966 limiting image sizes - L<Imager::Files/"Limiting the sizes of images you read">
3967
3968 lines, drawing - L<Imager::Draw/line>
3969
3970 matrix - L<Imager::Matrix2d>, 
3971 L<Imager::Transformations/"Matrix Transformations">,
3972 L<Imager::Font/transform>
3973
3974 metadata, image - L<Imager::ImageTypes/"Tags">
3975
3976 mosaic - L<Imager::Filter/mosaic>
3977
3978 noise, filter - L<Imager::Filter/noise>
3979
3980 noise, rendered - L<Imager::Filter/turbnoise>,
3981 L<Imager::Filter/radnoise>
3982
3983 paste - L<Imager::Transformations/paste>,
3984 L<Imager::Transformations/rubthrough>
3985
3986 pseudo-color image - L<Imager::ImageTypes/to_paletted>,
3987 L<Imager::ImageTypes/new>
3988
3989 posterize - L<Imager::Filter/postlevels>
3990
3991 png files - L<Imager::Files>, L<Imager::Files/"PNG">
3992
3993 pnm - L<Imager::Files/"PNM (Portable aNy Map)">
3994
3995 rectangles, drawing - L<Imager::Draw/box>
3996
3997 resizing an image - L<Imager::Transformations/scale>, 
3998 L<Imager::Transformations/crop>
3999
4000 RGB (SGI) files - L<Imager::Files/"SGI (RGB, BW)">
4001
4002 saving an image - L<Imager::Files>
4003
4004 scaling - L<Imager::Transformations/scale>
4005
4006 SGI files - L<Imager::Files/"SGI (RGB, BW)">
4007
4008 sharpen - L<Imager::Filters/unsharpmask>, L<Imager::Filters/conv>
4009
4010 size, image - L<Imager::ImageTypes/getwidth>,
4011 L<Imager::ImageTypes/getheight>
4012
4013 size, text - L<Imager::Font/bounding_box>
4014
4015 tags, image metadata - L<Imager::ImageTypes/"Tags">
4016
4017 text, drawing - L<Imager::Draw/string>, L<Imager::Draw/align_string>,
4018 L<Imager::Font::Wrap>
4019
4020 text, wrapping text in an area - L<Imager::Font::Wrap>
4021
4022 text, measuring - L<Imager::Font/bounding_box>, L<Imager::Font::BBox>
4023
4024 tiles, color - L<Imager::Filter/mosaic>
4025
4026 unsharp mask - L<Imager::Filter/unsharpmask>
4027
4028 watermark - L<Imager::Filter/watermark>
4029
4030 writing an image to a file - L<Imager::Files>
4031
4032 =head1 SUPPORT
4033
4034 The best place to get help with Imager is the mailing list.
4035
4036 To subscribe send a message with C<subscribe> in the body to:
4037
4038    imager-devel+request@molar.is
4039
4040 or use the form at:
4041
4042 =over
4043
4044 L<http://www.molar.is/en/lists/imager-devel/>
4045
4046 =back
4047
4048 where you can also find the mailing list archive.
4049
4050 You can report bugs by pointing your browser at:
4051
4052 =over
4053
4054 L<https://rt.cpan.org/NoAuth/ReportBug.html?Queue=Imager>
4055
4056 =back
4057
4058 Please remember to include the versions of Imager, perl, supporting
4059 libraries, and any relevant code.  If you have specific images that
4060 cause the problems, please include those too.
4061
4062 If you don't want to publish your email address on a mailing list you
4063 can use CPAN::Forum:
4064
4065   http://www.cpanforum.com/dist/Imager
4066
4067 You will need to register to post.
4068
4069 =head1 CONTRIBUTING TO IMAGER
4070
4071 =head2 Feedback
4072
4073 I like feedback.
4074
4075 If you like or dislike Imager, you can add a public review of Imager
4076 at CPAN Ratings:
4077
4078   http://cpanratings.perl.org/dist/Imager
4079
4080 This requires a Bitcard Account (http://www.bitcard.org).
4081
4082 You can also send email to the maintainer below.
4083
4084 If you send me a bug report via email, it will be copied to RT.
4085
4086 =head2 Patches
4087
4088 I accept patches, preferably against the main branch in subversion.
4089 You should include an explanation of the reason for why the patch is
4090 needed or useful.
4091
4092 Your patch should include regression tests where possible, otherwise
4093 it will be delayed until I get a chance to write them.
4094
4095 =head1 AUTHOR
4096
4097 Tony Cook <tony@imager.perl.org> is the current maintainer for Imager.
4098
4099 Arnar M. Hrafnkelsson is the original author of Imager.
4100
4101 Many others have contributed to Imager, please see the README for a
4102 complete list.
4103
4104 =head1 SEE ALSO
4105
4106 L<perl>(1), L<Imager::ImageTypes>(3), L<Imager::Files>(3),
4107 L<Imager::Draw>(3), L<Imager::Color>(3), L<Imager::Fill>(3),
4108 L<Imager::Font>(3), L<Imager::Transformations>(3),
4109 L<Imager::Engines>(3), L<Imager::Filters>(3), L<Imager::Expr>(3),
4110 L<Imager::Matrix2d>(3), L<Imager::Fountain>(3)
4111
4112 L<http://imager.perl.org/>
4113
4114 L<Affix::Infix2Postfix>(3), L<Parse::RecDescent>(3)
4115
4116 Other perl imaging modules include:
4117
4118 L<GD>(3), L<Image::Magick>(3), L<Graphics::Magick>(3).
4119
4120 =cut