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