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