[RT #65863] mostly eliminate i_has_format
[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.81';
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     i_box_filled($raw, $xmin, $ymin,$xmax, $ymax, $color);
2685   }
2686   elsif ($opts{fill}) {
2687     unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
2688       # assume it's a hash ref
2689       require 'Imager/Fill.pm';
2690       unless ($opts{fill} = Imager::Fill->new(%{$opts{fill}})) {
2691         $self->{ERRSTR} = $Imager::ERRSTR;
2692         return undef;
2693       }
2694     }
2695     i_box_cfill($raw, $xmin, $ymin, $xmax, $ymax, $opts{fill}{fill});
2696   }
2697   else {
2698     my $color = $opts{'color'};
2699     if (defined $color) {
2700       unless (_is_color_object($color)) {
2701         $color = _color($color);
2702         unless ($color) { 
2703           $self->{ERRSTR} = $Imager::ERRSTR;
2704           return;
2705         }
2706       }
2707     }
2708     else {
2709       $color = i_color_new(255, 255, 255, 255);
2710     }
2711     unless ($color) { 
2712       $self->{ERRSTR} = $Imager::ERRSTR;
2713       return;
2714     }
2715     i_box($raw, $xmin, $ymin, $xmax, $ymax, $color);
2716   }
2717
2718   return $self;
2719 }
2720
2721 sub arc {
2722   my $self=shift;
2723   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2724   my $dflcl= [ 255, 255, 255, 255];
2725   my $good = 1;
2726   my %opts=
2727     (
2728      color=>$dflcl,
2729      'r'=>_min($self->getwidth(),$self->getheight())/3,
2730      'x'=>$self->getwidth()/2,
2731      'y'=>$self->getheight()/2,
2732      'd1'=>0, 'd2'=>361, 
2733      filled => 1,
2734      @_,
2735     );
2736   if ($opts{aa}) {
2737     if ($opts{fill}) {
2738       unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
2739         # assume it's a hash ref
2740         require 'Imager/Fill.pm';
2741         unless ($opts{fill} = Imager::Fill->new(%{$opts{fill}})) {
2742           $self->{ERRSTR} = $Imager::ERRSTR;
2743           return;
2744         }
2745       }
2746       i_arc_aa_cfill($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},$opts{'d1'},
2747                      $opts{'d2'}, $opts{fill}{fill});
2748     }
2749     elsif ($opts{filled}) {
2750       my $color = _color($opts{'color'});
2751       unless ($color) { 
2752         $self->{ERRSTR} = $Imager::ERRSTR; 
2753         return; 
2754       }
2755       if ($opts{d1} == 0 && $opts{d2} == 361 && $opts{aa}) {
2756         i_circle_aa($self->{IMG}, $opts{'x'}, $opts{'y'}, $opts{'r'}, 
2757                     $color);
2758       }
2759       else {
2760         i_arc_aa($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},
2761                  $opts{'d1'}, $opts{'d2'}, $color); 
2762       }
2763     }
2764     else {
2765       my $color = _color($opts{'color'});
2766       if ($opts{d2} - $opts{d1} >= 360) {
2767         $good = i_circle_out_aa($self->{IMG}, $opts{'x'}, $opts{'y'}, $opts{'r'}, $color);
2768       }
2769       else {
2770         $good = i_arc_out_aa($self->{IMG}, $opts{'x'}, $opts{'y'}, $opts{'r'}, $opts{'d1'}, $opts{'d2'}, $color);
2771       }
2772     }
2773   }
2774   else {
2775     if ($opts{fill}) {
2776       unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
2777         # assume it's a hash ref
2778         require 'Imager/Fill.pm';
2779         unless ($opts{fill} = Imager::Fill->new(%{$opts{fill}})) {
2780           $self->{ERRSTR} = $Imager::ERRSTR;
2781           return;
2782         }
2783       }
2784       i_arc_cfill($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},$opts{'d1'},
2785                   $opts{'d2'}, $opts{fill}{fill});
2786     }
2787     else {
2788       my $color = _color($opts{'color'});
2789       unless ($color) { 
2790         $self->{ERRSTR} = $Imager::ERRSTR; 
2791         return;
2792       }
2793       if ($opts{filled}) {
2794         i_arc($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},
2795               $opts{'d1'}, $opts{'d2'}, $color); 
2796       }
2797       else {
2798         if ($opts{d1} == 0 && $opts{d2} == 361) {
2799           $good = i_circle_out($self->{IMG}, $opts{x}, $opts{y}, $opts{r}, $color);
2800         }
2801         else {
2802           $good = i_arc_out($self->{IMG}, $opts{x}, $opts{y}, $opts{r}, $opts{d1}, $opts{d2}, $color);
2803         }
2804       }
2805     }
2806   }
2807   unless ($good) {
2808     $self->_set_error($self->_error_as_msg);
2809     return;
2810   }
2811
2812   return $self;
2813 }
2814
2815 # Draws a line from one point to the other
2816 # the endpoint is set if the endp parameter is set which it is by default.
2817 # to turn of the endpoint being set use endp=>0 when calling line.
2818
2819 sub line {
2820   my $self=shift;
2821   my $dflcl=i_color_new(0,0,0,0);
2822   my %opts=(color=>$dflcl,
2823             endp => 1,
2824             @_);
2825   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2826
2827   unless (exists $opts{x1} and exists $opts{y1}) { $self->{ERRSTR}='missing begining coord'; return undef; }
2828   unless (exists $opts{x2} and exists $opts{y2}) { $self->{ERRSTR}='missing ending coord'; return undef; }
2829
2830   my $color = _color($opts{'color'});
2831   unless ($color) {
2832     $self->{ERRSTR} = $Imager::ERRSTR;
2833     return;
2834   }
2835
2836   $opts{antialias} = $opts{aa} if defined $opts{aa};
2837   if ($opts{antialias}) {
2838     i_line_aa($self->{IMG},$opts{x1}, $opts{y1}, $opts{x2}, $opts{y2},
2839               $color, $opts{endp});
2840   } else {
2841     i_line($self->{IMG},$opts{x1}, $opts{y1}, $opts{x2}, $opts{y2},
2842            $color, $opts{endp});
2843   }
2844   return $self;
2845 }
2846
2847 # Draws a line between an ordered set of points - It more or less just transforms this
2848 # into a list of lines.
2849
2850 sub polyline {
2851   my $self=shift;
2852   my ($pt,$ls,@points);
2853   my $dflcl=i_color_new(0,0,0,0);
2854   my %opts=(color=>$dflcl,@_);
2855
2856   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2857
2858   if (exists($opts{points})) { @points=@{$opts{points}}; }
2859   if (!exists($opts{points}) and exists($opts{'x'}) and exists($opts{'y'}) ) {
2860     @points=map { [ $opts{'x'}->[$_],$opts{'y'}->[$_] ] } (0..(scalar @{$opts{'x'}}-1));
2861     }
2862
2863 #  print Dumper(\@points);
2864
2865   my $color = _color($opts{'color'});
2866   unless ($color) { 
2867     $self->{ERRSTR} = $Imager::ERRSTR; 
2868     return; 
2869   }
2870   $opts{antialias} = $opts{aa} if defined $opts{aa};
2871   if ($opts{antialias}) {
2872     for $pt(@points) {
2873       if (defined($ls)) { 
2874         i_line_aa($self->{IMG},$ls->[0],$ls->[1],$pt->[0],$pt->[1],$color, 1);
2875       }
2876       $ls=$pt;
2877     }
2878   } else {
2879     for $pt(@points) {
2880       if (defined($ls)) { 
2881         i_line($self->{IMG},$ls->[0],$ls->[1],$pt->[0],$pt->[1],$color,1);
2882       }
2883       $ls=$pt;
2884     }
2885   }
2886   return $self;
2887 }
2888
2889 sub polygon {
2890   my $self = shift;
2891   my ($pt,$ls,@points);
2892   my $dflcl = i_color_new(0,0,0,0);
2893   my %opts = (color=>$dflcl, @_);
2894
2895   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2896
2897   if (exists($opts{points})) {
2898     $opts{'x'} = [ map { $_->[0] } @{$opts{points}} ];
2899     $opts{'y'} = [ map { $_->[1] } @{$opts{points}} ];
2900   }
2901
2902   if (!exists $opts{'x'} or !exists $opts{'y'})  {
2903     $self->{ERRSTR} = 'no points array, or x and y arrays.'; return undef;
2904   }
2905
2906   if ($opts{'fill'}) {
2907     unless (UNIVERSAL::isa($opts{'fill'}, 'Imager::Fill')) {
2908       # assume it's a hash ref
2909       require 'Imager/Fill.pm';
2910       unless ($opts{'fill'} = Imager::Fill->new(%{$opts{'fill'}})) {
2911         $self->{ERRSTR} = $Imager::ERRSTR;
2912         return undef;
2913       }
2914     }
2915     i_poly_aa_cfill($self->{IMG}, $opts{'x'}, $opts{'y'}, 
2916                     $opts{'fill'}{'fill'});
2917   }
2918   else {
2919     my $color = _color($opts{'color'});
2920     unless ($color) { 
2921       $self->{ERRSTR} = $Imager::ERRSTR; 
2922       return; 
2923     }
2924     i_poly_aa($self->{IMG}, $opts{'x'}, $opts{'y'}, $color);
2925   }
2926
2927   return $self;
2928 }
2929
2930
2931 # this the multipoint bezier curve
2932 # this is here more for testing that actual usage since
2933 # this is not a good algorithm.  Usually the curve would be
2934 # broken into smaller segments and each done individually.
2935
2936 sub polybezier {
2937   my $self=shift;
2938   my ($pt,$ls,@points);
2939   my $dflcl=i_color_new(0,0,0,0);
2940   my %opts=(color=>$dflcl,@_);
2941
2942   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2943
2944   if (exists $opts{points}) {
2945     $opts{'x'}=map { $_->[0]; } @{$opts{'points'}};
2946     $opts{'y'}=map { $_->[1]; } @{$opts{'points'}};
2947   }
2948
2949   unless ( @{$opts{'x'}} and @{$opts{'x'}} == @{$opts{'y'}} ) {
2950     $self->{ERRSTR}='Missing or invalid points.';
2951     return;
2952   }
2953
2954   my $color = _color($opts{'color'});
2955   unless ($color) { 
2956     $self->{ERRSTR} = $Imager::ERRSTR; 
2957     return; 
2958   }
2959   i_bezier_multi($self->{IMG},$opts{'x'},$opts{'y'},$color);
2960   return $self;
2961 }
2962
2963 sub flood_fill {
2964   my $self = shift;
2965   my %opts = ( color=>Imager::Color->new(255, 255, 255), @_ );
2966   my $rc;
2967
2968   unless (exists $opts{'x'} && exists $opts{'y'}) {
2969     $self->{ERRSTR} = "missing seed x and y parameters";
2970     return undef;
2971   }
2972
2973   if ($opts{border}) {
2974     my $border = _color($opts{border});
2975     unless ($border) {
2976       $self->_set_error($Imager::ERRSTR);
2977       return;
2978     }
2979     if ($opts{fill}) {
2980       unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
2981         # assume it's a hash ref
2982         require Imager::Fill;
2983         unless ($opts{fill} = Imager::Fill->new(%{$opts{fill}})) {
2984           $self->{ERRSTR} = $Imager::ERRSTR;
2985           return;
2986         }
2987       }
2988       $rc = i_flood_cfill_border($self->{IMG}, $opts{'x'}, $opts{'y'}, 
2989                                  $opts{fill}{fill}, $border);
2990     }
2991     else {
2992       my $color = _color($opts{'color'});
2993       unless ($color) {
2994         $self->{ERRSTR} = $Imager::ERRSTR;
2995         return;
2996       }
2997       $rc = i_flood_fill_border($self->{IMG}, $opts{'x'}, $opts{'y'}, 
2998                                 $color, $border);
2999     }
3000     if ($rc) { 
3001       return $self; 
3002     } 
3003     else { 
3004       $self->{ERRSTR} = $self->_error_as_msg(); 
3005       return;
3006     }
3007   }
3008   else {
3009     if ($opts{fill}) {
3010       unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
3011         # assume it's a hash ref
3012         require 'Imager/Fill.pm';
3013         unless ($opts{fill} = Imager::Fill->new(%{$opts{fill}})) {
3014           $self->{ERRSTR} = $Imager::ERRSTR;
3015           return;
3016         }
3017       }
3018       $rc = i_flood_cfill($self->{IMG}, $opts{'x'}, $opts{'y'}, $opts{fill}{fill});
3019     }
3020     else {
3021       my $color = _color($opts{'color'});
3022       unless ($color) {
3023         $self->{ERRSTR} = $Imager::ERRSTR;
3024         return;
3025       }
3026       $rc = i_flood_fill($self->{IMG}, $opts{'x'}, $opts{'y'}, $color);
3027     }
3028     if ($rc) { 
3029       return $self; 
3030     } 
3031     else { 
3032       $self->{ERRSTR} = $self->_error_as_msg(); 
3033       return;
3034     }
3035   } 
3036 }
3037
3038 sub setpixel {
3039   my ($self, %opts) = @_;
3040
3041   my $color = $opts{color};
3042   unless (defined $color) {
3043     $color = $self->{fg};
3044     defined $color or $color = NC(255, 255, 255);
3045   }
3046
3047   unless (ref $color && UNIVERSAL::isa($color, "Imager::Color")) {
3048     $color = _color($color)
3049       or return undef;
3050   }
3051
3052   unless (exists $opts{'x'} && exists $opts{'y'}) {
3053     $self->{ERRSTR} = 'missing x and y parameters';
3054     return undef;
3055   }
3056
3057   my $x = $opts{'x'};
3058   my $y = $opts{'y'};
3059   if (ref $x && ref $y) {
3060     unless (@$x == @$y) {
3061       $self->{ERRSTR} = 'length of x and y mismatch';
3062       return;
3063     }
3064     my $set = 0;
3065     if ($color->isa('Imager::Color')) {
3066       for my $i (0..$#{$opts{'x'}}) {
3067         i_ppix($self->{IMG}, $x->[$i], $y->[$i], $color)
3068           or ++$set;
3069       }
3070     }
3071     else {
3072       for my $i (0..$#{$opts{'x'}}) {
3073         i_ppixf($self->{IMG}, $x->[$i], $y->[$i], $color)
3074           or ++$set;
3075       }
3076     }
3077     $set or return;
3078     return $set;
3079   }
3080   else {
3081     if ($color->isa('Imager::Color')) {
3082       i_ppix($self->{IMG}, $x, $y, $color)
3083         and return;
3084     }
3085     else {
3086       i_ppixf($self->{IMG}, $x, $y, $color)
3087         and return;
3088     }
3089   }
3090
3091   $self;
3092 }
3093
3094 sub getpixel {
3095   my $self = shift;
3096
3097   my %opts = ( "type"=>'8bit', @_);
3098
3099   unless (exists $opts{'x'} && exists $opts{'y'}) {
3100     $self->{ERRSTR} = 'missing x and y parameters';
3101     return undef;
3102   }
3103
3104   my $x = $opts{'x'};
3105   my $y = $opts{'y'};
3106   if (ref $x && ref $y) {
3107     unless (@$x == @$y) {
3108       $self->{ERRSTR} = 'length of x and y mismatch';
3109       return undef;
3110     }
3111     my @result;
3112     if ($opts{"type"} eq '8bit') {
3113       for my $i (0..$#{$opts{'x'}}) {
3114         push(@result, i_get_pixel($self->{IMG}, $x->[$i], $y->[$i]));
3115       }
3116     }
3117     else {
3118       for my $i (0..$#{$opts{'x'}}) {
3119         push(@result, i_gpixf($self->{IMG}, $x->[$i], $y->[$i]));
3120       }
3121     }
3122     return wantarray ? @result : \@result;
3123   }
3124   else {
3125     if ($opts{"type"} eq '8bit') {
3126       return i_get_pixel($self->{IMG}, $x, $y);
3127     }
3128     else {
3129       return i_gpixf($self->{IMG}, $x, $y);
3130     }
3131   }
3132
3133   $self;
3134 }
3135
3136 sub getscanline {
3137   my $self = shift;
3138   my %opts = ( type => '8bit', x=>0, @_);
3139
3140   $self->_valid_image or return;
3141
3142   defined $opts{width} or $opts{width} = $self->getwidth - $opts{x};
3143
3144   unless (defined $opts{'y'}) {
3145     $self->_set_error("missing y parameter");
3146     return;
3147   }
3148
3149   if ($opts{type} eq '8bit') {
3150     return i_glin($self->{IMG}, $opts{x}, $opts{x}+$opts{width},
3151                   $opts{'y'});
3152   }
3153   elsif ($opts{type} eq 'float') {
3154     return i_glinf($self->{IMG}, $opts{x}, $opts{x}+$opts{width},
3155                   $opts{'y'});
3156   }
3157   elsif ($opts{type} eq 'index') {
3158     unless (i_img_type($self->{IMG})) {
3159       $self->_set_error("type => index only valid on paletted images");
3160       return;
3161     }
3162     return i_gpal($self->{IMG}, $opts{x}, $opts{x} + $opts{width},
3163                   $opts{'y'});
3164   }
3165   else {
3166     $self->_set_error("invalid type parameter - must be '8bit' or 'float'");
3167     return;
3168   }
3169 }
3170
3171 sub setscanline {
3172   my $self = shift;
3173   my %opts = ( x=>0, @_);
3174
3175   $self->_valid_image or return;
3176
3177   unless (defined $opts{'y'}) {
3178     $self->_set_error("missing y parameter");
3179     return;
3180   }
3181
3182   if (!$opts{type}) {
3183     if (ref $opts{pixels} && @{$opts{pixels}}) {
3184       # try to guess the type
3185       if ($opts{pixels}[0]->isa('Imager::Color')) {
3186         $opts{type} = '8bit';
3187       }
3188       elsif ($opts{pixels}[0]->isa('Imager::Color::Float')) {
3189         $opts{type} = 'float';
3190       }
3191       else {
3192         $self->_set_error("missing type parameter and could not guess from pixels");
3193         return;
3194       }
3195     }
3196     else {
3197       # default
3198       $opts{type} = '8bit';
3199     }
3200   }
3201
3202   if ($opts{type} eq '8bit') {
3203     if (ref $opts{pixels}) {
3204       return i_plin($self->{IMG}, $opts{x}, $opts{'y'}, @{$opts{pixels}});
3205     }
3206     else {
3207       return i_plin($self->{IMG}, $opts{x}, $opts{'y'}, $opts{pixels});
3208     }
3209   }
3210   elsif ($opts{type} eq 'float') {
3211     if (ref $opts{pixels}) {
3212       return i_plinf($self->{IMG}, $opts{x}, $opts{'y'}, @{$opts{pixels}});
3213     }
3214     else {
3215       return i_plinf($self->{IMG}, $opts{x}, $opts{'y'}, $opts{pixels});
3216     }
3217   }
3218   elsif ($opts{type} eq 'index') {
3219     if (ref $opts{pixels}) {
3220       return i_ppal($self->{IMG}, $opts{x}, $opts{'y'}, @{$opts{pixels}});
3221     }
3222     else {
3223       return i_ppal_p($self->{IMG}, $opts{x}, $opts{'y'}, $opts{pixels});
3224     }
3225   }
3226   else {
3227     $self->_set_error("invalid type parameter - must be '8bit' or 'float'");
3228     return;
3229   }
3230 }
3231
3232 sub getsamples {
3233   my $self = shift;
3234   my %opts = ( type => '8bit', x=>0, offset => 0, @_);
3235
3236   defined $opts{width} or $opts{width} = $self->getwidth - $opts{x};
3237
3238   unless (defined $opts{'y'}) {
3239     $self->_set_error("missing y parameter");
3240     return;
3241   }
3242   
3243   unless ($opts{channels}) {
3244     $opts{channels} = [ 0 .. $self->getchannels()-1 ];
3245   }
3246
3247   if ($opts{target}) {
3248     my $target = $opts{target};
3249     my $offset = $opts{offset};
3250     if ($opts{type} eq '8bit') {
3251       my @samples = i_gsamp($self->{IMG}, $opts{x}, $opts{x}+$opts{width},
3252                             $opts{y}, @{$opts{channels}})
3253         or return;
3254       @{$target}{$offset .. $offset + @samples - 1} = @samples;
3255       return scalar(@samples);
3256     }
3257     elsif ($opts{type} eq 'float') {
3258       my @samples = i_gsampf($self->{IMG}, $opts{x}, $opts{x}+$opts{width},
3259                              $opts{y}, @{$opts{channels}});
3260       @{$target}{$offset .. $offset + @samples - 1} = @samples;
3261       return scalar(@samples);
3262     }
3263     elsif ($opts{type} =~ /^(\d+)bit$/) {
3264       my $bits = $1;
3265
3266       my @data;
3267       my $count = i_gsamp_bits($self->{IMG}, $opts{x}, $opts{x}+$opts{width}, 
3268                                $opts{y}, $bits, $target, 
3269                                $offset, @{$opts{channels}});
3270       unless (defined $count) {
3271         $self->_set_error(Imager->_error_as_msg);
3272         return;
3273       }
3274
3275       return $count;
3276     }
3277     else {
3278       $self->_set_error("invalid type parameter - must be '8bit' or 'float'");
3279       return;
3280     }
3281   }
3282   else {
3283     if ($opts{type} eq '8bit') {
3284       return i_gsamp($self->{IMG}, $opts{x}, $opts{x}+$opts{width},
3285                      $opts{y}, @{$opts{channels}});
3286     }
3287     elsif ($opts{type} eq 'float') {
3288       return i_gsampf($self->{IMG}, $opts{x}, $opts{x}+$opts{width},
3289                       $opts{y}, @{$opts{channels}});
3290     }
3291     elsif ($opts{type} =~ /^(\d+)bit$/) {
3292       my $bits = $1;
3293
3294       my @data;
3295       i_gsamp_bits($self->{IMG}, $opts{x}, $opts{x}+$opts{width}, 
3296                    $opts{y}, $bits, \@data, 0, @{$opts{channels}})
3297         or return;
3298       return @data;
3299     }
3300     else {
3301       $self->_set_error("invalid type parameter - must be '8bit' or 'float'");
3302       return;
3303     }
3304   }
3305 }
3306
3307 sub setsamples {
3308   my $self = shift;
3309   my %opts = ( x => 0, offset => 0, @_ );
3310
3311   unless ($self->{IMG}) {
3312     $self->_set_error('setsamples: empty input image');
3313     return;
3314   }
3315
3316   unless(defined $opts{data} && ref $opts{data}) {
3317     $self->_set_error('setsamples: data parameter missing or invalid');
3318     return;
3319   }
3320
3321   unless ($opts{channels}) {
3322     $opts{channels} = [ 0 .. $self->getchannels()-1 ];
3323   }
3324
3325   unless ($opts{type} && $opts{type} =~ /^(\d+)bit$/) {
3326     $self->_set_error('setsamples: type parameter missing or invalid');
3327     return;
3328   }
3329   my $bits = $1;
3330
3331   unless (defined $opts{width}) {
3332     $opts{width} = $self->getwidth() - $opts{x};
3333   }
3334
3335   my $count = i_psamp_bits($self->{IMG}, $opts{x}, $opts{y}, $bits,
3336                            $opts{channels}, $opts{data}, $opts{offset}, 
3337                            $opts{width});
3338   unless (defined $count) {
3339     $self->_set_error(Imager->_error_as_msg);
3340     return;
3341   }
3342
3343   return $count;
3344 }
3345
3346 # make an identity matrix of the given size
3347 sub _identity {
3348   my ($size) = @_;
3349
3350   my $matrix = [ map { [ (0) x $size ] } 1..$size ];
3351   for my $c (0 .. ($size-1)) {
3352     $matrix->[$c][$c] = 1;
3353   }
3354   return $matrix;
3355 }
3356
3357 # general function to convert an image
3358 sub convert {
3359   my ($self, %opts) = @_;
3360   my $matrix;
3361
3362   unless (defined wantarray) {
3363     my @caller = caller;
3364     warn "convert() called in void context - convert() returns the converted image at $caller[1] line $caller[2]\n";
3365     return;
3366   }
3367
3368   # the user can either specify a matrix or preset
3369   # the matrix overrides the preset
3370   if (!exists($opts{matrix})) {
3371     unless (exists($opts{preset})) {
3372       $self->{ERRSTR} = "convert() needs a matrix or preset";
3373       return;
3374     }
3375     else {
3376       if ($opts{preset} eq 'gray' || $opts{preset} eq 'grey') {
3377         # convert to greyscale, keeping the alpha channel if any
3378         if ($self->getchannels == 3) {
3379           $matrix = [ [ 0.222, 0.707, 0.071 ] ];
3380         }
3381         elsif ($self->getchannels == 4) {
3382           # preserve the alpha channel
3383           $matrix = [ [ 0.222, 0.707, 0.071, 0 ],
3384                       [ 0,     0,     0,     1 ] ];
3385         }
3386         else {
3387           # an identity
3388           $matrix = _identity($self->getchannels);
3389         }
3390       }
3391       elsif ($opts{preset} eq 'noalpha') {
3392         # strip the alpha channel
3393         if ($self->getchannels == 2 or $self->getchannels == 4) {
3394           $matrix = _identity($self->getchannels);
3395           pop(@$matrix); # lose the alpha entry
3396         }
3397         else {
3398           $matrix = _identity($self->getchannels);
3399         }
3400       }
3401       elsif ($opts{preset} eq 'red' || $opts{preset} eq 'channel0') {
3402         # extract channel 0
3403         $matrix = [ [ 1 ] ];
3404       }
3405       elsif ($opts{preset} eq 'green' || $opts{preset} eq 'channel1') {
3406         $matrix = [ [ 0, 1 ] ];
3407       }
3408       elsif ($opts{preset} eq 'blue' || $opts{preset} eq 'channel2') {
3409         $matrix = [ [ 0, 0, 1 ] ];
3410       }
3411       elsif ($opts{preset} eq 'alpha') {
3412         if ($self->getchannels == 2 or $self->getchannels == 4) {
3413           $matrix = [ [ (0) x ($self->getchannels-1), 1 ] ];
3414         }
3415         else {
3416           # the alpha is just 1 <shrug>
3417           $matrix = [ [ (0) x $self->getchannels, 1 ] ];
3418         }
3419       }
3420       elsif ($opts{preset} eq 'rgb') {
3421         if ($self->getchannels == 1) {
3422           $matrix = [ [ 1 ], [ 1 ], [ 1 ] ];
3423         }
3424         elsif ($self->getchannels == 2) {
3425           # preserve the alpha channel
3426           $matrix = [ [ 1, 0 ], [ 1, 0 ], [ 1, 0 ], [ 0, 1 ] ];
3427         }
3428         else {
3429           $matrix = _identity($self->getchannels);
3430         }
3431       }
3432       elsif ($opts{preset} eq 'addalpha') {
3433         if ($self->getchannels == 1) {
3434           $matrix = _identity(2);
3435         }
3436         elsif ($self->getchannels == 3) {
3437           $matrix = _identity(4);
3438         }
3439         else {
3440           $matrix = _identity($self->getchannels);
3441         }
3442       }
3443       else {
3444         $self->{ERRSTR} = "Unknown convert preset $opts{preset}";
3445         return undef;
3446       }
3447     }
3448   }
3449   else {
3450     $matrix = $opts{matrix};
3451   }
3452
3453   my $new = Imager->new;
3454   $new->{IMG} = i_convert($self->{IMG}, $matrix);
3455   unless ($new->{IMG}) {
3456     # most likely a bad matrix
3457     $self->{ERRSTR} = _error_as_msg();
3458     return undef;
3459   }
3460   return $new;
3461 }
3462
3463 # combine channels from multiple input images, a class method
3464 sub combine {
3465   my ($class, %opts) = @_;
3466
3467   my $src = delete $opts{src};
3468   unless ($src) {
3469     $class->_set_error("src parameter missing");
3470     return;
3471   }
3472   my @imgs;
3473   my $index = 0;
3474   for my $img (@$src) {
3475     unless (eval { $img->isa("Imager") }) {
3476       $class->_set_error("src must contain image objects");
3477       return;
3478     }
3479     unless ($img->{IMG}) {
3480       $class->_set_error("empty input image");
3481       return;
3482     }
3483     push @imgs, $img->{IMG};
3484   }
3485   my $result;
3486   if (my $channels = delete $opts{channels}) {
3487     $result = i_combine(\@imgs, $channels);
3488   }
3489   else {
3490     $result = i_combine(\@imgs);
3491   }
3492   unless ($result) {
3493     $class->_set_error($class->_error_as_msg);
3494     return;
3495   }
3496
3497   my $img = $class->new;
3498   $img->{IMG} = $result;
3499
3500   return $img;
3501 }
3502
3503
3504 # general function to map an image through lookup tables
3505
3506 sub map {
3507   my ($self, %opts) = @_;
3508   my @chlist = qw( red green blue alpha );
3509
3510   if (!exists($opts{'maps'})) {
3511     # make maps from channel maps
3512     my $chnum;
3513     for $chnum (0..$#chlist) {
3514       if (exists $opts{$chlist[$chnum]}) {
3515         $opts{'maps'}[$chnum] = $opts{$chlist[$chnum]};
3516       } elsif (exists $opts{'all'}) {
3517         $opts{'maps'}[$chnum] = $opts{'all'};
3518       }
3519     }
3520   }
3521   if ($opts{'maps'} and $self->{IMG}) {
3522     i_map($self->{IMG}, $opts{'maps'} );
3523   }
3524   return $self;
3525 }
3526
3527 sub difference {
3528   my ($self, %opts) = @_;
3529
3530   defined $opts{mindist} or $opts{mindist} = 0;
3531
3532   defined $opts{other}
3533     or return $self->_set_error("No 'other' parameter supplied");
3534   defined $opts{other}{IMG}
3535     or return $self->_set_error("No image data in 'other' image");
3536
3537   $self->{IMG}
3538     or return $self->_set_error("No image data");
3539
3540   my $result = Imager->new;
3541   $result->{IMG} = i_diff_image($self->{IMG}, $opts{other}{IMG}, 
3542                                 $opts{mindist})
3543     or return $self->_set_error($self->_error_as_msg());
3544
3545   return $result;
3546 }
3547
3548 # destructive border - image is shrunk by one pixel all around
3549
3550 sub border {
3551   my ($self,%opts)=@_;
3552   my($tx,$ty)=($self->getwidth()-1,$self->getheight()-1);
3553   $self->polyline('x'=>[0,$tx,$tx,0,0],'y'=>[0,0,$ty,$ty,0],%opts);
3554 }
3555
3556
3557 # Get the width of an image
3558
3559 sub getwidth {
3560   my $self = shift;
3561
3562   if (my $raw = $self->{IMG}) {
3563     return i_img_get_width($raw);
3564   }
3565   else {
3566     $self->{ERRSTR} = 'image is empty'; return undef;
3567   }
3568 }
3569
3570 # Get the height of an image
3571
3572 sub getheight {
3573   my $self = shift;
3574
3575   if (my $raw = $self->{IMG}) {
3576     return i_img_get_height($raw);
3577   }
3578   else {
3579     $self->{ERRSTR} = 'image is empty'; return undef;
3580   }
3581 }
3582
3583 # Get number of channels in an image
3584
3585 sub getchannels {
3586   my $self = shift;
3587   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
3588   return i_img_getchannels($self->{IMG});
3589 }
3590
3591 # Get channel mask
3592
3593 sub getmask {
3594   my $self = shift;
3595   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
3596   return i_img_getmask($self->{IMG});
3597 }
3598
3599 # Set channel mask
3600
3601 sub setmask {
3602   my $self = shift;
3603   my %opts = @_;
3604   if (!defined($self->{IMG})) { 
3605     $self->{ERRSTR} = 'image is empty';
3606     return undef;
3607   }
3608   unless (defined $opts{mask}) {
3609     $self->_set_error("mask parameter required");
3610     return;
3611   }
3612   i_img_setmask( $self->{IMG} , $opts{mask} );
3613
3614   1;
3615 }
3616
3617 # Get number of colors in an image
3618
3619 sub getcolorcount {
3620   my $self=shift;
3621   my %opts=('maxcolors'=>2**30,@_);
3622   if (!defined($self->{IMG})) { $self->{ERRSTR}='image is empty'; return undef; }
3623   my $rc=i_count_colors($self->{IMG},$opts{'maxcolors'});
3624   return ($rc==-1? undef : $rc);
3625 }
3626
3627 # Returns a reference to a hash. The keys are colour named (packed) and the
3628 # values are the number of pixels in this colour.
3629 sub getcolorusagehash {
3630   my $self = shift;
3631   
3632   my %opts = ( maxcolors => 2**30, @_ );
3633   my $max_colors = $opts{maxcolors};
3634   unless (defined $max_colors && $max_colors > 0) {
3635     $self->_set_error('maxcolors must be a positive integer');
3636     return;
3637   }
3638
3639   unless (defined $self->{IMG}) {
3640     $self->_set_error('empty input image'); 
3641     return;
3642   }
3643
3644   my $channels= $self->getchannels;
3645   # We don't want to look at the alpha channel, because some gifs using it
3646   # doesn't define it for every colour (but only for some)
3647   $channels -= 1 if $channels == 2 or $channels == 4;
3648   my %color_use;
3649   my $height = $self->getheight;
3650   for my $y (0 .. $height - 1) {
3651     my $colors = $self->getsamples('y' => $y, channels => [ 0 .. $channels - 1 ]);
3652     while (length $colors) {
3653       $color_use{ substr($colors, 0, $channels, '') }++;
3654     }
3655     keys %color_use > $max_colors
3656       and return;
3657   }
3658   return \%color_use;
3659 }
3660
3661 # This will return a ordered array of the colour usage. Kind of the sorted
3662 # version of the values of the hash returned by getcolorusagehash.
3663 # You might want to add safety checks and change the names, etc...
3664 sub getcolorusage {
3665   my $self = shift;
3666
3667   my %opts = ( maxcolors => 2**30, @_ );
3668   my $max_colors = $opts{maxcolors};
3669   unless (defined $max_colors && $max_colors > 0) {
3670     $self->_set_error('maxcolors must be a positive integer');
3671     return;
3672   }
3673
3674   unless (defined $self->{IMG}) {
3675     $self->_set_error('empty input image'); 
3676     return undef;
3677   }
3678
3679   return i_get_anonymous_color_histo($self->{IMG}, $max_colors);
3680 }
3681
3682 # draw string to an image
3683
3684 sub string {
3685   my $self = shift;
3686   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
3687
3688   my %input=('x'=>0, 'y'=>0, @_);
3689   defined($input{string}) or $input{string} = $input{text};
3690
3691   unless(defined $input{string}) {
3692     $self->{ERRSTR}="missing required parameter 'string'";
3693     return;
3694   }
3695
3696   unless($input{font}) {
3697     $self->{ERRSTR}="missing required parameter 'font'";
3698     return;
3699   }
3700
3701   unless ($input{font}->draw(image=>$self, %input)) {
3702     return;
3703   }
3704
3705   return $self;
3706 }
3707
3708 sub align_string {
3709   my $self = shift;
3710
3711   my $img;
3712   if (ref $self) {
3713     unless ($self->{IMG}) { 
3714       $self->{ERRSTR}='empty input image'; 
3715       return;
3716     }
3717     $img = $self;
3718   }
3719   else {
3720     $img = undef;
3721   }
3722
3723   my %input=('x'=>0, 'y'=>0, @_);
3724   defined $input{string}
3725     or $input{string} = $input{text};
3726
3727   unless(exists $input{string}) {
3728     $self->_set_error("missing required parameter 'string'");
3729     return;
3730   }
3731
3732   unless($input{font}) {
3733     $self->_set_error("missing required parameter 'font'");
3734     return;
3735   }
3736
3737   my @result;
3738   unless (@result = $input{font}->align(image=>$img, %input)) {
3739     return;
3740   }
3741
3742   return wantarray ? @result : $result[0];
3743 }
3744
3745 my @file_limit_names = qw/width height bytes/;
3746
3747 sub set_file_limits {
3748   shift;
3749
3750   my %opts = @_;
3751   my %values;
3752   
3753   if ($opts{reset}) {
3754     @values{@file_limit_names} = (0) x @file_limit_names;
3755   }
3756   else {
3757     @values{@file_limit_names} = i_get_image_file_limits();
3758   }
3759
3760   for my $key (keys %values) {
3761     defined $opts{$key} and $values{$key} = $opts{$key};
3762   }
3763
3764   i_set_image_file_limits($values{width}, $values{height}, $values{bytes});
3765 }
3766
3767 sub get_file_limits {
3768   i_get_image_file_limits();
3769 }
3770
3771 # Shortcuts that can be exported
3772
3773 sub newcolor { Imager::Color->new(@_); }
3774 sub newfont  { Imager::Font->new(@_); }
3775 sub NCF {
3776   require Imager::Color::Float;
3777   return Imager::Color::Float->new(@_);
3778 }
3779
3780 *NC=*newcolour=*newcolor;
3781 *NF=*newfont;
3782
3783 *open=\&read;
3784 *circle=\&arc;
3785
3786
3787 #### Utility routines
3788
3789 sub errstr { 
3790   ref $_[0] ? $_[0]->{ERRSTR} : $ERRSTR
3791 }
3792
3793 sub _set_error {
3794   my ($self, $msg) = @_;
3795
3796   if (ref $self) {
3797     $self->{ERRSTR} = $msg;
3798   }
3799   else {
3800     $ERRSTR = $msg;
3801   }
3802   return;
3803 }
3804
3805 # Default guess for the type of an image from extension
3806
3807 sub def_guess_type {
3808   my $name=lc(shift);
3809   my $ext;
3810   $ext=($name =~ m/\.([^\.]+)$/)[0];
3811   return 'tiff' if ($ext =~ m/^tiff?$/);
3812   return 'jpeg' if ($ext =~ m/^jpe?g$/);
3813   return 'pnm'  if ($ext =~ m/^p[pgb]m$/);
3814   return 'png'  if ($ext eq "png");
3815   return 'bmp'  if ($ext eq "bmp" || $ext eq "dib");
3816   return 'tga'  if ($ext eq "tga");
3817   return 'sgi'  if ($ext eq "rgb" || $ext eq "bw" || $ext eq "sgi" || $ext eq "rgba");
3818   return 'gif'  if ($ext eq "gif");
3819   return 'raw'  if ($ext eq "raw");
3820   return lc $ext; # best guess
3821   return ();
3822 }
3823
3824 sub combines {
3825   return @combine_types;
3826 }
3827
3828 # get the minimum of a list
3829
3830 sub _min {
3831   my $mx=shift;
3832   for(@_) { if ($_<$mx) { $mx=$_; }}
3833   return $mx;
3834 }
3835
3836 # get the maximum of a list
3837
3838 sub _max {
3839   my $mx=shift;
3840   for(@_) { if ($_>$mx) { $mx=$_; }}
3841   return $mx;
3842 }
3843
3844 # string stuff for iptc headers
3845
3846 sub _clean {
3847   my($str)=$_[0];
3848   $str = substr($str,3);
3849   $str =~ s/[\n\r]//g;
3850   $str =~ s/\s+/ /g;
3851   $str =~ s/^\s//;
3852   $str =~ s/\s$//;
3853   return $str;
3854 }
3855
3856 # A little hack to parse iptc headers.
3857
3858 sub parseiptc {
3859   my $self=shift;
3860   my(@sar,$item,@ar);
3861   my($caption,$photogr,$headln,$credit);
3862
3863   my $str=$self->{IPTCRAW};
3864
3865   defined $str
3866     or return;
3867
3868   @ar=split(/8BIM/,$str);
3869
3870   my $i=0;
3871   foreach (@ar) {
3872     if (/^\004\004/) {
3873       @sar=split(/\034\002/);
3874       foreach $item (@sar) {
3875         if ($item =~ m/^x/) {
3876           $caption = _clean($item);
3877           $i++;
3878         }
3879         if ($item =~ m/^P/) {
3880           $photogr = _clean($item);
3881           $i++;
3882         }
3883         if ($item =~ m/^i/) {
3884           $headln = _clean($item);
3885           $i++;
3886         }
3887         if ($item =~ m/^n/) {
3888           $credit = _clean($item);
3889           $i++;
3890         }
3891       }
3892     }
3893   }
3894   return (caption=>$caption,photogr=>$photogr,headln=>$headln,credit=>$credit);
3895 }
3896
3897 sub Inline {
3898   my ($lang) = @_;
3899
3900   $lang eq 'C'
3901     or die "Only C language supported";
3902
3903   require Imager::ExtUtils;
3904   return Imager::ExtUtils->inline_config;
3905 }
3906
3907 # threads shouldn't try to close raw Imager objects
3908 sub Imager::ImgRaw::CLONE_SKIP { 1 }
3909
3910 sub preload {
3911   # this serves two purposes:
3912   # - a class method to load the file support modules included with Image
3913   #   (or were included, once the library dependent modules are split out)
3914   # - something for Module::ScanDeps to analyze
3915   # https://rt.cpan.org/Ticket/Display.html?id=6566
3916   local $@;
3917   eval { require Imager::File::GIF };
3918   eval { require Imager::File::JPEG };
3919   eval { require Imager::File::PNG };
3920   eval { require Imager::File::SGI };
3921   eval { require Imager::File::TIFF };
3922   eval { require Imager::File::ICO };
3923   eval { require Imager::Font::W32 };
3924   eval { require Imager::Font::FT2 };
3925   eval { require Imager::Font::T1 };
3926 }
3927
3928 # backward compatibility for %formats
3929 package Imager::FORMATS;
3930 use strict;
3931 use constant IX_FORMATS => 0;
3932 use constant IX_LIST => 1;
3933 use constant IX_INDEX => 2;
3934 use constant IX_CLASSES => 3;
3935
3936 sub TIEHASH {
3937   my ($class, $formats, $classes) = @_;
3938
3939   return bless [ $formats, [ ], 0, $classes ], $class;
3940 }
3941
3942 sub _check {
3943   my ($self, $key) = @_;
3944
3945   (my $file = $self->[IX_CLASSES]{$key} . ".pm") =~ s(::)(/)g;
3946   my $value;
3947   if (eval { require $file; 1 }) {
3948     $value = 1;
3949   }
3950   else {
3951     $value = undef;
3952   }
3953   $self->[IX_FORMATS]{$key} = $value;
3954
3955   return $value;
3956 }
3957
3958 sub FETCH {
3959   my ($self, $key) = @_;
3960
3961   exists $self->[IX_FORMATS]{$key} and return $self->[IX_FORMATS]{$key};
3962
3963   $self->[IX_CLASSES]{$key} or return undef;
3964
3965   return $self->_check($key);
3966 }
3967
3968 sub STORE {
3969   die "%Imager::formats is not user monifiable";
3970 }
3971
3972 sub DELETE {
3973   die "%Imager::formats is not user monifiable";
3974 }
3975
3976 sub CLEAR {
3977   die "%Imager::formats is not user monifiable";
3978 }
3979
3980 sub EXISTS {
3981   my ($self, $key) = @_;
3982
3983   if (exists $self->[IX_FORMATS]{$key}) {
3984     my $value = $self->[IX_FORMATS]{$key}
3985       or return;
3986     return 1;
3987   }
3988
3989   $self->_check($key) or return 1==0;
3990
3991   return 1==1;
3992 }
3993
3994 sub FIRSTKEY {
3995   my ($self) = @_;
3996
3997   unless (@{$self->[IX_LIST]}) {
3998     # full populate it
3999     @{$self->[IX_LIST]} = grep $self->[IX_FORMATS]{$_},
4000       keys %{$self->[IX_FORMATS]};
4001
4002     for my $key (keys %{$self->[IX_CLASSES]}) {
4003       $self->[IX_FORMATS]{$key} and next;
4004       $self->_check($key)
4005         and push @{$self->[IX_LIST]}, $key;
4006     }
4007   }
4008
4009   @{$self->[IX_LIST]} or return;
4010   $self->[IX_INDEX] = 1;
4011   return $self->[IX_LIST][0];
4012 }
4013
4014 sub NEXTKEY {
4015   my ($self) = @_;
4016
4017   $self->[IX_INDEX] < @{$self->[IX_LIST]}
4018     or return;
4019
4020   return $self->[IX_LIST][$self->[IX_INDEX]++];
4021 }
4022
4023 sub SCALAR {
4024   my ($self) = @_;
4025
4026   return scalar @{$self->[IX_LIST]};
4027 }
4028
4029 1;
4030 __END__
4031 # Below is the stub of documentation for your module. You better edit it!
4032
4033 =head1 NAME
4034
4035 Imager - Perl extension for Generating 24 bit Images
4036
4037 =head1 SYNOPSIS
4038
4039   # Thumbnail example
4040
4041   #!/usr/bin/perl -w
4042   use strict;
4043   use Imager;
4044
4045   die "Usage: thumbmake.pl filename\n" if !-f $ARGV[0];
4046   my $file = shift;
4047
4048   my $format;
4049
4050   # see Imager::Files for information on the read() method
4051   my $img = Imager->new(file=>$file)
4052     or die Imager->errstr();
4053
4054   $file =~ s/\.[^.]*$//;
4055
4056   # Create smaller version
4057   # documented in Imager::Transformations
4058   my $thumb = $img->scale(scalefactor=>.3);
4059
4060   # Autostretch individual channels
4061   $thumb->filter(type=>'autolevels');
4062
4063   # try to save in one of these formats
4064   SAVE:
4065
4066   for $format ( qw( png gif jpeg tiff ppm ) ) {
4067     # Check if given format is supported
4068     if ($Imager::formats{$format}) {
4069       $file.="_low.$format";
4070       print "Storing image as: $file\n";
4071       # documented in Imager::Files
4072       $thumb->write(file=>$file) or
4073         die $thumb->errstr;
4074       last SAVE;
4075     }
4076   }
4077
4078 =head1 DESCRIPTION
4079
4080 Imager is a module for creating and altering images.  It can read and
4081 write various image formats, draw primitive shapes like lines,and
4082 polygons, blend multiple images together in various ways, scale, crop,
4083 render text and more.
4084
4085 =head2 Overview of documentation
4086
4087 =over
4088
4089 =item *
4090
4091 Imager - This document - Synopsis, Example, Table of Contents and
4092 Overview.
4093
4094 =item *
4095
4096 L<Imager::Tutorial> - a brief introduction to Imager.
4097
4098 =item *
4099
4100 L<Imager::Cookbook> - how to do various things with Imager.
4101
4102 =item *
4103
4104 L<Imager::ImageTypes> - Basics of constructing image objects with
4105 C<new()>: Direct type/virtual images, RGB(A)/paletted images,
4106 8/16/double bits/channel, color maps, channel masks, image tags, color
4107 quantization.  Also discusses basic image information methods.
4108
4109 =item *
4110
4111 L<Imager::Files> - IO interaction, reading/writing images, format
4112 specific tags.
4113
4114 =item *
4115
4116 L<Imager::Draw> - Drawing Primitives, lines, boxes, circles, arcs,
4117 flood fill.
4118
4119 =item *
4120
4121 L<Imager::Color> - Color specification.
4122
4123 =item *
4124
4125 L<Imager::Fill> - Fill pattern specification.
4126
4127 =item *
4128
4129 L<Imager::Font> - General font rendering, bounding boxes and font
4130 metrics.
4131
4132 =item *
4133
4134 L<Imager::Transformations> - Copying, scaling, cropping, flipping,
4135 blending, pasting, convert and map.
4136
4137 =item *
4138
4139 L<Imager::Engines> - Programmable transformations through
4140 C<transform()>, C<transform2()> and C<matrix_transform()>.
4141
4142 =item *
4143
4144 L<Imager::Filters> - Filters, sharpen, blur, noise, convolve etc. and
4145 filter plug-ins.
4146
4147 =item *
4148
4149 L<Imager::Expr> - Expressions for evaluation engine used by
4150 transform2().
4151
4152 =item *
4153
4154 L<Imager::Matrix2d> - Helper class for affine transformations.
4155
4156 =item *
4157
4158 L<Imager::Fountain> - Helper for making gradient profiles.
4159
4160 =item *
4161
4162 L<Imager::API> - using Imager's C API
4163
4164 =item *
4165
4166 L<Imager::APIRef> - API function reference
4167
4168 =item *
4169
4170 L<Imager::Inline> - using Imager's C API from Inline::C
4171
4172 =item *
4173
4174 L<Imager::ExtUtils> - tools to get access to Imager's C API.
4175
4176 =back
4177
4178 =head2 Basic Overview
4179
4180 An Image object is created with C<$img = Imager-E<gt>new()>.
4181 Examples:
4182
4183   $img=Imager->new();                         # create empty image
4184   $img->read(file=>'lena.png',type=>'png') or # read image from file
4185      die $img->errstr();                      # give an explanation
4186                                               # if something failed
4187
4188 or if you want to create an empty image:
4189
4190   $img=Imager->new(xsize=>400,ysize=>300,channels=>4);
4191
4192 This example creates a completely black image of width 400 and height
4193 300 and 4 channels.
4194
4195 =head1 ERROR HANDLING
4196
4197 In general a method will return false when it fails, if it does use
4198 the C<errstr()> method to find out why:
4199
4200 =over
4201
4202 =item C<errstr>
4203
4204 Returns the last error message in that context.
4205
4206 If the last error you received was from calling an object method, such
4207 as read, call errstr() as an object method to find out why:
4208
4209   my $image = Imager->new;
4210   $image->read(file => 'somefile.gif')
4211      or die $image->errstr;
4212
4213 If it was a class method then call errstr() as a class method:
4214
4215   my @imgs = Imager->read_multi(file => 'somefile.gif')
4216     or die Imager->errstr;
4217
4218 Note that in some cases object methods are implemented in terms of
4219 class methods so a failing object method may set both.
4220
4221 =back
4222
4223 The C<Imager-E<gt>new> method is described in detail in
4224 L<Imager::ImageTypes>.
4225
4226 =head1 METHOD INDEX
4227
4228 Where to find information on methods for Imager class objects.
4229
4230 addcolors() - L<Imager::ImageTypes/addcolors> - add colors to a
4231 paletted image
4232
4233 addtag() -  L<Imager::ImageTypes/addtag> - add image tags
4234
4235 align_string() - L<Imager::Draw/align_string> - draw text aligned on a
4236 point
4237
4238 arc() - L<Imager::Draw/arc> - draw a filled arc
4239
4240 bits() - L<Imager::ImageTypes/bits> - number of bits per sample for the
4241 image
4242
4243 box() - L<Imager::Draw/box> - draw a filled or outline box.
4244
4245 circle() - L<Imager::Draw/circle> - draw a filled circle
4246
4247 colorcount() - L<Imager::Draw/colorcount> - the number of colors in an
4248 image's palette (paletted images only)
4249
4250 combine() - L<Imager::Transformations/combine> - combine channels from one or
4251 more images.
4252
4253 combines() - L<Imager::Draw/combines> - return a list of the different
4254 combine type keywords
4255
4256 compose() - L<Imager::Transformations/compose> - compose one image
4257 over another.
4258
4259 convert() - L<Imager::Transformations/"Color transformations"> -
4260 transform the color space
4261
4262 copy() - L<Imager::Transformations/copy> - make a duplicate of an
4263 image
4264
4265 crop() - L<Imager::Transformations/crop> - extract part of an image
4266
4267 def_guess_type() - L<Imager::Files/def_guess_type> - default function
4268 used to guess the output file format based on the output file name
4269
4270 deltag() -  L<Imager::ImageTypes/deltag> - delete image tags
4271
4272 difference() - L<Imager::Filters/"Image Difference"> - produce a
4273 difference images from two input images.
4274
4275 errstr() - L<"Basic Overview"> - the error from the last failed
4276 operation.
4277
4278 filter() - L<Imager::Filters> - image filtering
4279
4280 findcolor() - L<Imager::ImageTypes/findcolor> - search the image
4281 palette, if it has one
4282
4283 flip() - L<Imager::Transformations/flip> - flip an image, vertically,
4284 horizontally
4285
4286 flood_fill() - L<Imager::Draw/flood_fill> - fill an enclosed or same
4287 color area
4288
4289 getchannels() - L<Imager::ImageTypes/getchannels> - the number of
4290 samples per pixel for an image
4291
4292 getcolorcount() - L<Imager::ImageTypes/getcolorcount> - the number of
4293 different colors used by an image (works for direct color images)
4294
4295 getcolors() - L<Imager::ImageTypes/getcolors> - get colors from the image
4296 palette, if it has one
4297
4298 getcolorusage() - L<Imager::ImageTypes/getcolorusage>
4299
4300 getcolorusagehash() - L<Imager::ImageTypes/getcolorusagehash>
4301
4302 get_file_limits() - L<Imager::Files/"Limiting the sizes of images you read">
4303
4304 getheight() - L<Imager::ImageTypes/getwidth> - height of the image in
4305 pixels
4306
4307 getmask() - L<Imager::ImageTypes/getmask> - write mask for the image
4308
4309 getpixel() - L<Imager::Draw/getpixel> - retrieve one or more pixel
4310 colors
4311
4312 getsamples() - L<Imager::Draw/getsamples> - retrieve samples from a
4313 row or partial row of pixels.
4314
4315 getscanline() - L<Imager::Draw/getscanline> - retrieve colors for a
4316 row or partial row of pixels.
4317
4318 getwidth() - L<Imager::ImageTypes/getwidth> - width of the image in
4319 pixels.
4320
4321 img_set() - L<Imager::ImageTypes/img_set> - re-use an Imager object
4322 for a new image.
4323
4324 init() - L<Imager::ImageTypes/init>
4325
4326 is_bilevel() - L<Imager::ImageTypes/is_bilevel> - returns whether
4327 image write functions should write the image in their bilevel (blank
4328 and white, no gray levels) format
4329
4330 line() - L<Imager::Draw/line> - draw an interval
4331
4332 load_plugin() - L<Imager::Filters/load_plugin>
4333
4334 map() - L<Imager::Transformations/"Color Mappings"> - remap color
4335 channel values
4336
4337 masked() -  L<Imager::ImageTypes/masked> - make a masked image
4338
4339 matrix_transform() - L<Imager::Engines/matrix_transform>
4340
4341 maxcolors() - L<Imager::ImageTypes/maxcolors>
4342
4343 NC() - L<Imager::Handy/NC>
4344
4345 NCF() - L<Imager::Handy/NCF>
4346
4347 new() - L<Imager::ImageTypes/new>
4348
4349 newcolor() - L<Imager::Handy/newcolor>
4350
4351 newcolour() - L<Imager::Handy/newcolour>
4352
4353 newfont() - L<Imager::Handy/newfont>
4354
4355 NF() - L<Imager::Handy/NF>
4356
4357 open() - L<Imager::Files> - an alias for read()
4358
4359 =for stopwords IPTC
4360
4361 parseiptc() - L<Imager::Files/parseiptc> - parse IPTC data from a JPEG
4362 image
4363
4364 paste() - L<Imager::Transformations/paste> - draw an image onto an image
4365
4366 polygon() - L<Imager::Draw/polygon>
4367
4368 polyline() - L<Imager::Draw/polyline>
4369
4370 preload() - L<Imager::Files/preload>
4371
4372 read() - L<Imager::Files> - read a single image from an image file
4373
4374 read_multi() - L<Imager::Files> - read multiple images from an image
4375 file
4376
4377 read_types() - L<Imager::Files/read_types> - list image types Imager
4378 can read.
4379
4380 register_filter() - L<Imager::Filters/register_filter>
4381
4382 register_reader() - L<Imager::Files/register_reader>
4383
4384 register_writer() - L<Imager::Files/register_writer>
4385
4386 rotate() - L<Imager::Transformations/rotate>
4387
4388 rubthrough() - L<Imager::Transformations/rubthrough> - draw an image onto an
4389 image and use the alpha channel
4390
4391 scale() - L<Imager::Transformations/scale>
4392
4393 scale_calculate() - L<Imager::Transformations/scale_calculate>
4394
4395 scaleX() - L<Imager::Transformations/scaleX>
4396
4397 scaleY() - L<Imager::Transformations/scaleY>
4398
4399 setcolors() - L<Imager::ImageTypes/setcolors> - set palette colors in
4400 a paletted image
4401
4402 set_file_limits() - L<Imager::Files/"Limiting the sizes of images you read">
4403
4404 setmask() - L<Imager::ImageTypes/setmask>
4405
4406 setpixel() - L<Imager::Draw/setpixel>
4407
4408 setsamples() - L<Imager::Draw/setsamples>
4409
4410 setscanline() - L<Imager::Draw/setscanline>
4411
4412 settag() - L<Imager::ImageTypes/settag>
4413
4414 string() - L<Imager::Draw/string> - draw text on an image
4415
4416 tags() -  L<Imager::ImageTypes/tags> - fetch image tags
4417
4418 to_paletted() -  L<Imager::ImageTypes/to_paletted>
4419
4420 to_rgb16() - L<Imager::ImageTypes/to_rgb16>
4421
4422 to_rgb8() - L<Imager::ImageTypes/to_rgb8>
4423
4424 transform() - L<Imager::Engines/"transform">
4425
4426 transform2() - L<Imager::Engines/"transform2">
4427
4428 type() -  L<Imager::ImageTypes/type> - type of image (direct vs paletted)
4429
4430 unload_plugin() - L<Imager::Filters/unload_plugin>
4431
4432 virtual() - L<Imager::ImageTypes/virtual> - whether the image has it's own
4433 data
4434
4435 write() - L<Imager::Files> - write an image to a file
4436
4437 write_multi() - L<Imager::Files> - write multiple image to an image
4438 file.
4439
4440 write_types() - L<Imager::Files/read_types> - list image types Imager
4441 can write.
4442
4443 =head1 CONCEPT INDEX
4444
4445 animated GIF - L<Imager::Files/"Writing an animated GIF">
4446
4447 aspect ratio - L<Imager::ImageTypes/i_xres>,
4448 L<Imager::ImageTypes/i_yres>, L<Imager::ImageTypes/i_aspect_only>
4449
4450 blend - alpha blending one image onto another
4451 L<Imager::Transformations/rubthrough>
4452
4453 blur - L<Imager::Filters/guassian>, L<Imager::Filters/conv>
4454
4455 boxes, drawing - L<Imager::Draw/box>
4456
4457 changes between image - L<Imager::Filters/"Image Difference">
4458
4459 channels, combine into one image - L<Imager::Transformations/combine>
4460
4461 color - L<Imager::Color>
4462
4463 color names - L<Imager::Color>, L<Imager::Color::Table>
4464
4465 combine modes - L<Imager::Draw/"Combine Types">
4466
4467 compare images - L<Imager::Filters/"Image Difference">
4468
4469 contrast - L<Imager::Filters/contrast>, L<Imager::Filters/autolevels>
4470
4471 convolution - L<Imager::Filters/conv>
4472
4473 cropping - L<Imager::Transformations/crop>
4474
4475 CUR files - L<Imager::Files/"ICO (Microsoft Windows Icon) and CUR (Microsoft Windows Cursor)">
4476
4477 C<diff> images - L<Imager::Filters/"Image Difference">
4478
4479 dpi - L<Imager::ImageTypes/i_xres>, 
4480 L<Imager::Cookbook/"Image spatial resolution">
4481
4482 drawing boxes - L<Imager::Draw/box>
4483
4484 drawing lines - L<Imager::Draw/line>
4485
4486 drawing text - L<Imager::Draw/string>, L<Imager::Draw/align_string>
4487
4488 error message - L<"ERROR HANDLING">
4489
4490 files, font - L<Imager::Font>
4491
4492 files, image - L<Imager::Files>
4493
4494 filling, types of fill - L<Imager::Fill>
4495
4496 filling, boxes - L<Imager::Draw/box>
4497
4498 filling, flood fill - L<Imager::Draw/flood_fill>
4499
4500 flood fill - L<Imager::Draw/flood_fill>
4501
4502 fonts - L<Imager::Font>
4503
4504 fonts, drawing with - L<Imager::Draw/string>,
4505 L<Imager::Draw/align_string>, L<Imager::Font::Wrap>
4506
4507 fonts, metrics - L<Imager::Font/bounding_box>, L<Imager::Font::BBox>
4508
4509 fonts, multiple master - L<Imager::Font/"MULTIPLE MASTER FONTS">
4510
4511 fountain fill - L<Imager::Fill/"Fountain fills">,
4512 L<Imager::Filters/fountain>, L<Imager::Fountain>,
4513 L<Imager::Filters/gradgen>
4514
4515 GIF files - L<Imager::Files/"GIF">
4516
4517 GIF files, animated - L<Imager::File/"Writing an animated GIF">
4518
4519 gradient fill - L<Imager::Fill/"Fountain fills">,
4520 L<Imager::Filters/fountain>, L<Imager::Fountain>,
4521 L<Imager::Filters/gradgen>
4522
4523 gray scale, convert image to - L<Imager::Transformations/convert>
4524
4525 guassian blur - L<Imager::Filters/guassian>
4526
4527 hatch fills - L<Imager::Fill/"Hatched fills">
4528
4529 ICO files - L<Imager::Files/"ICO (Microsoft Windows Icon) and CUR (Microsoft Windows Cursor)">
4530
4531 invert image - L<Imager::Filters/hardinvert>,
4532 L<Imager::Filters/hardinvertall>
4533
4534 JPEG - L<Imager::Files/"JPEG">
4535
4536 limiting image sizes - L<Imager::Files/"Limiting the sizes of images you read">
4537
4538 lines, drawing - L<Imager::Draw/line>
4539
4540 matrix - L<Imager::Matrix2d>, 
4541 L<Imager::Transformations/"Matrix Transformations">,
4542 L<Imager::Font/transform>
4543
4544 metadata, image - L<Imager::ImageTypes/"Tags">
4545
4546 mosaic - L<Imager::Filters/mosaic>
4547
4548 noise, filter - L<Imager::Filters/noise>
4549
4550 noise, rendered - L<Imager::Filters/turbnoise>,
4551 L<Imager::Filters/radnoise>
4552
4553 paste - L<Imager::Transformations/paste>,
4554 L<Imager::Transformations/rubthrough>
4555
4556 pseudo-color image - L<Imager::ImageTypes/to_paletted>,
4557 L<Imager::ImageTypes/new>
4558
4559 =for stopwords posterize
4560
4561 posterize - L<Imager::Filters/postlevels>
4562
4563 PNG files - L<Imager::Files>, L<Imager::Files/"PNG">
4564
4565 PNM - L<Imager::Files/"PNM (Portable aNy Map)">
4566
4567 rectangles, drawing - L<Imager::Draw/box>
4568
4569 resizing an image - L<Imager::Transformations/scale>, 
4570 L<Imager::Transformations/crop>
4571
4572 RGB (SGI) files - L<Imager::Files/"SGI (RGB, BW)">
4573
4574 saving an image - L<Imager::Files>
4575
4576 scaling - L<Imager::Transformations/scale>
4577
4578 SGI files - L<Imager::Files/"SGI (RGB, BW)">
4579
4580 sharpen - L<Imager::Filters/unsharpmask>, L<Imager::Filters/conv>
4581
4582 size, image - L<Imager::ImageTypes/getwidth>,
4583 L<Imager::ImageTypes/getheight>
4584
4585 size, text - L<Imager::Font/bounding_box>
4586
4587 tags, image metadata - L<Imager::ImageTypes/"Tags">
4588
4589 text, drawing - L<Imager::Draw/string>, L<Imager::Draw/align_string>,
4590 L<Imager::Font::Wrap>
4591
4592 text, wrapping text in an area - L<Imager::Font::Wrap>
4593
4594 text, measuring - L<Imager::Font/bounding_box>, L<Imager::Font::BBox>
4595
4596 tiles, color - L<Imager::Filters/mosaic>
4597
4598 transparent images - L<Imager::ImageTypes>,
4599 L<Imager::Cookbook/"Transparent PNG">
4600
4601 =for stopwords unsharp
4602
4603 unsharp mask - L<Imager::Filters/unsharpmask>
4604
4605 watermark - L<Imager::Filters/watermark>
4606
4607 writing an image to a file - L<Imager::Files>
4608
4609 =head1 THREADS
4610
4611 Imager doesn't support perl threads.
4612
4613 Imager has limited code to prevent double frees if you create images,
4614 colors etc, and then create a thread, but has no code to prevent two
4615 threads entering Imager's error handling code, and none is likely to
4616 be added.
4617
4618 =head1 SUPPORT
4619
4620 The best place to get help with Imager is the mailing list.
4621
4622 To subscribe send a message with C<subscribe> in the body to:
4623
4624    imager-devel+request@molar.is
4625
4626 or use the form at:
4627
4628 =over
4629
4630 L<http://www.molar.is/en/lists/imager-devel/>
4631
4632 =back
4633
4634 where you can also find the mailing list archive.
4635
4636 You can report bugs by pointing your browser at:
4637
4638 =over
4639
4640 L<https://rt.cpan.org/NoAuth/ReportBug.html?Queue=Imager>
4641
4642 =back
4643
4644 or by sending an email to:
4645
4646 =over
4647
4648 bug-Imager@rt.cpan.org
4649
4650 =back
4651
4652 Please remember to include the versions of Imager, perl, supporting
4653 libraries, and any relevant code.  If you have specific images that
4654 cause the problems, please include those too.
4655
4656 If you don't want to publish your email address on a mailing list you
4657 can use CPAN::Forum:
4658
4659   http://www.cpanforum.com/dist/Imager
4660
4661 You will need to register to post.
4662
4663 =head1 CONTRIBUTING TO IMAGER
4664
4665 =head2 Feedback
4666
4667 I like feedback.
4668
4669 If you like or dislike Imager, you can add a public review of Imager
4670 at CPAN Ratings:
4671
4672   http://cpanratings.perl.org/dist/Imager
4673
4674 =for stopwords Bitcard
4675
4676 This requires a Bitcard account (http://www.bitcard.org).
4677
4678 You can also send email to the maintainer below.
4679
4680 If you send me a bug report via email, it will be copied to Request
4681 Tracker.
4682
4683 =head2 Patches
4684
4685 I accept patches, preferably against the main branch in subversion.
4686 You should include an explanation of the reason for why the patch is
4687 needed or useful.
4688
4689 Your patch should include regression tests where possible, otherwise
4690 it will be delayed until I get a chance to write them.
4691
4692 =head1 AUTHOR
4693
4694 Tony Cook <tony@imager.perl.org> is the current maintainer for Imager.
4695
4696 Arnar M. Hrafnkelsson is the original author of Imager.
4697
4698 Many others have contributed to Imager, please see the C<README> for a
4699 complete list.
4700
4701 =head1 LICENSE
4702
4703 Imager is licensed under the same terms as perl itself.
4704
4705 =for stopwords
4706 makeblendedfont Fontforge
4707
4708 A test font, FT2/fontfiles/MMOne.pfb, contains a Postscript operator
4709 definition copyrighted by Adobe.  See F<adobe.txt> in the source for
4710 license information.
4711
4712 =head1 SEE ALSO
4713
4714 L<perl>(1), L<Imager::ImageTypes>(3), L<Imager::Files>(3),
4715 L<Imager::Draw>(3), L<Imager::Color>(3), L<Imager::Fill>(3),
4716 L<Imager::Font>(3), L<Imager::Transformations>(3),
4717 L<Imager::Engines>(3), L<Imager::Filters>(3), L<Imager::Expr>(3),
4718 L<Imager::Matrix2d>(3), L<Imager::Fountain>(3)
4719
4720 L<http://imager.perl.org/>
4721
4722 L<Affix::Infix2Postfix>(3), L<Parse::RecDescent>(3)
4723
4724 Other perl imaging modules include:
4725
4726 L<GD>(3), L<Image::Magick>(3), L<Graphics::Magick>(3).
4727
4728 =cut