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