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