note licensing of the makeblended font code in MMOne.pfb
[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.78';
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 # combine channels from multiple input images, a class method
3470 sub combine {
3471   my ($class, %opts) = @_;
3472
3473   my $src = delete $opts{src};
3474   unless ($src) {
3475     $class->_set_error("src parameter missing");
3476     return;
3477   }
3478   my @imgs;
3479   my $index = 0;
3480   for my $img (@$src) {
3481     unless (eval { $img->isa("Imager") }) {
3482       $class->_set_error("src must contain image objects");
3483       return;
3484     }
3485     unless ($img->{IMG}) {
3486       $class->_set_error("empty input image");
3487       return;
3488     }
3489     push @imgs, $img->{IMG};
3490   }
3491   my $result;
3492   if (my $channels = delete $opts{channels}) {
3493     $result = i_combine(\@imgs, $channels);
3494   }
3495   else {
3496     $result = i_combine(\@imgs);
3497   }
3498   unless ($result) {
3499     $class->_set_error($class->_error_as_msg);
3500     return;
3501   }
3502
3503   my $img = $class->new;
3504   $img->{IMG} = $result;
3505
3506   return $img;
3507 }
3508
3509
3510 # general function to map an image through lookup tables
3511
3512 sub map {
3513   my ($self, %opts) = @_;
3514   my @chlist = qw( red green blue alpha );
3515
3516   if (!exists($opts{'maps'})) {
3517     # make maps from channel maps
3518     my $chnum;
3519     for $chnum (0..$#chlist) {
3520       if (exists $opts{$chlist[$chnum]}) {
3521         $opts{'maps'}[$chnum] = $opts{$chlist[$chnum]};
3522       } elsif (exists $opts{'all'}) {
3523         $opts{'maps'}[$chnum] = $opts{'all'};
3524       }
3525     }
3526   }
3527   if ($opts{'maps'} and $self->{IMG}) {
3528     i_map($self->{IMG}, $opts{'maps'} );
3529   }
3530   return $self;
3531 }
3532
3533 sub difference {
3534   my ($self, %opts) = @_;
3535
3536   defined $opts{mindist} or $opts{mindist} = 0;
3537
3538   defined $opts{other}
3539     or return $self->_set_error("No 'other' parameter supplied");
3540   defined $opts{other}{IMG}
3541     or return $self->_set_error("No image data in 'other' image");
3542
3543   $self->{IMG}
3544     or return $self->_set_error("No image data");
3545
3546   my $result = Imager->new;
3547   $result->{IMG} = i_diff_image($self->{IMG}, $opts{other}{IMG}, 
3548                                 $opts{mindist})
3549     or return $self->_set_error($self->_error_as_msg());
3550
3551   return $result;
3552 }
3553
3554 # destructive border - image is shrunk by one pixel all around
3555
3556 sub border {
3557   my ($self,%opts)=@_;
3558   my($tx,$ty)=($self->getwidth()-1,$self->getheight()-1);
3559   $self->polyline('x'=>[0,$tx,$tx,0,0],'y'=>[0,0,$ty,$ty,0],%opts);
3560 }
3561
3562
3563 # Get the width of an image
3564
3565 sub getwidth {
3566   my $self = shift;
3567
3568   if (my $raw = $self->{IMG}) {
3569     return i_img_get_width($raw);
3570   }
3571   else {
3572     $self->{ERRSTR} = 'image is empty'; return undef;
3573   }
3574 }
3575
3576 # Get the height of an image
3577
3578 sub getheight {
3579   my $self = shift;
3580
3581   if (my $raw = $self->{IMG}) {
3582     return i_img_get_height($raw);
3583   }
3584   else {
3585     $self->{ERRSTR} = 'image is empty'; return undef;
3586   }
3587 }
3588
3589 # Get number of channels in an image
3590
3591 sub getchannels {
3592   my $self = shift;
3593   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
3594   return i_img_getchannels($self->{IMG});
3595 }
3596
3597 # Get channel mask
3598
3599 sub getmask {
3600   my $self = shift;
3601   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
3602   return i_img_getmask($self->{IMG});
3603 }
3604
3605 # Set channel mask
3606
3607 sub setmask {
3608   my $self = shift;
3609   my %opts = @_;
3610   if (!defined($self->{IMG})) { 
3611     $self->{ERRSTR} = 'image is empty';
3612     return undef;
3613   }
3614   unless (defined $opts{mask}) {
3615     $self->_set_error("mask parameter required");
3616     return;
3617   }
3618   i_img_setmask( $self->{IMG} , $opts{mask} );
3619
3620   1;
3621 }
3622
3623 # Get number of colors in an image
3624
3625 sub getcolorcount {
3626   my $self=shift;
3627   my %opts=('maxcolors'=>2**30,@_);
3628   if (!defined($self->{IMG})) { $self->{ERRSTR}='image is empty'; return undef; }
3629   my $rc=i_count_colors($self->{IMG},$opts{'maxcolors'});
3630   return ($rc==-1? undef : $rc);
3631 }
3632
3633 # Returns a reference to a hash. The keys are colour named (packed) and the
3634 # values are the number of pixels in this colour.
3635 sub getcolorusagehash {
3636   my $self = shift;
3637   
3638   my %opts = ( maxcolors => 2**30, @_ );
3639   my $max_colors = $opts{maxcolors};
3640   unless (defined $max_colors && $max_colors > 0) {
3641     $self->_set_error('maxcolors must be a positive integer');
3642     return;
3643   }
3644
3645   unless (defined $self->{IMG}) {
3646     $self->_set_error('empty input image'); 
3647     return;
3648   }
3649
3650   my $channels= $self->getchannels;
3651   # We don't want to look at the alpha channel, because some gifs using it
3652   # doesn't define it for every colour (but only for some)
3653   $channels -= 1 if $channels == 2 or $channels == 4;
3654   my %color_use;
3655   my $height = $self->getheight;
3656   for my $y (0 .. $height - 1) {
3657     my $colors = $self->getsamples('y' => $y, channels => [ 0 .. $channels - 1 ]);
3658     while (length $colors) {
3659       $color_use{ substr($colors, 0, $channels, '') }++;
3660     }
3661     keys %color_use > $max_colors
3662       and return;
3663   }
3664   return \%color_use;
3665 }
3666
3667 # This will return a ordered array of the colour usage. Kind of the sorted
3668 # version of the values of the hash returned by getcolorusagehash.
3669 # You might want to add safety checks and change the names, etc...
3670 sub getcolorusage {
3671   my $self = shift;
3672
3673   my %opts = ( maxcolors => 2**30, @_ );
3674   my $max_colors = $opts{maxcolors};
3675   unless (defined $max_colors && $max_colors > 0) {
3676     $self->_set_error('maxcolors must be a positive integer');
3677     return;
3678   }
3679
3680   unless (defined $self->{IMG}) {
3681     $self->_set_error('empty input image'); 
3682     return undef;
3683   }
3684
3685   return i_get_anonymous_color_histo($self->{IMG}, $max_colors);
3686 }
3687
3688 # draw string to an image
3689
3690 sub string {
3691   my $self = shift;
3692   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
3693
3694   my %input=('x'=>0, 'y'=>0, @_);
3695   defined($input{string}) or $input{string} = $input{text};
3696
3697   unless(defined $input{string}) {
3698     $self->{ERRSTR}="missing required parameter 'string'";
3699     return;
3700   }
3701
3702   unless($input{font}) {
3703     $self->{ERRSTR}="missing required parameter 'font'";
3704     return;
3705   }
3706
3707   unless ($input{font}->draw(image=>$self, %input)) {
3708     return;
3709   }
3710
3711   return $self;
3712 }
3713
3714 sub align_string {
3715   my $self = shift;
3716
3717   my $img;
3718   if (ref $self) {
3719     unless ($self->{IMG}) { 
3720       $self->{ERRSTR}='empty input image'; 
3721       return;
3722     }
3723     $img = $self;
3724   }
3725   else {
3726     $img = undef;
3727   }
3728
3729   my %input=('x'=>0, 'y'=>0, @_);
3730   defined $input{string}
3731     or $input{string} = $input{text};
3732
3733   unless(exists $input{string}) {
3734     $self->_set_error("missing required parameter 'string'");
3735     return;
3736   }
3737
3738   unless($input{font}) {
3739     $self->_set_error("missing required parameter 'font'");
3740     return;
3741   }
3742
3743   my @result;
3744   unless (@result = $input{font}->align(image=>$img, %input)) {
3745     return;
3746   }
3747
3748   return wantarray ? @result : $result[0];
3749 }
3750
3751 my @file_limit_names = qw/width height bytes/;
3752
3753 sub set_file_limits {
3754   shift;
3755
3756   my %opts = @_;
3757   my %values;
3758   
3759   if ($opts{reset}) {
3760     @values{@file_limit_names} = (0) x @file_limit_names;
3761   }
3762   else {
3763     @values{@file_limit_names} = i_get_image_file_limits();
3764   }
3765
3766   for my $key (keys %values) {
3767     defined $opts{$key} and $values{$key} = $opts{$key};
3768   }
3769
3770   i_set_image_file_limits($values{width}, $values{height}, $values{bytes});
3771 }
3772
3773 sub get_file_limits {
3774   i_get_image_file_limits();
3775 }
3776
3777 # Shortcuts that can be exported
3778
3779 sub newcolor { Imager::Color->new(@_); }
3780 sub newfont  { Imager::Font->new(@_); }
3781 sub NCF {
3782   require Imager::Color::Float;
3783   return Imager::Color::Float->new(@_);
3784 }
3785
3786 *NC=*newcolour=*newcolor;
3787 *NF=*newfont;
3788
3789 *open=\&read;
3790 *circle=\&arc;
3791
3792
3793 #### Utility routines
3794
3795 sub errstr { 
3796   ref $_[0] ? $_[0]->{ERRSTR} : $ERRSTR
3797 }
3798
3799 sub _set_error {
3800   my ($self, $msg) = @_;
3801
3802   if (ref $self) {
3803     $self->{ERRSTR} = $msg;
3804   }
3805   else {
3806     $ERRSTR = $msg;
3807   }
3808   return;
3809 }
3810
3811 # Default guess for the type of an image from extension
3812
3813 sub def_guess_type {
3814   my $name=lc(shift);
3815   my $ext;
3816   $ext=($name =~ m/\.([^\.]+)$/)[0];
3817   return 'tiff' if ($ext =~ m/^tiff?$/);
3818   return 'jpeg' if ($ext =~ m/^jpe?g$/);
3819   return 'pnm'  if ($ext =~ m/^p[pgb]m$/);
3820   return 'png'  if ($ext eq "png");
3821   return 'bmp'  if ($ext eq "bmp" || $ext eq "dib");
3822   return 'tga'  if ($ext eq "tga");
3823   return 'sgi'  if ($ext eq "rgb" || $ext eq "bw" || $ext eq "sgi" || $ext eq "rgba");
3824   return 'gif'  if ($ext eq "gif");
3825   return 'raw'  if ($ext eq "raw");
3826   return lc $ext; # best guess
3827   return ();
3828 }
3829
3830 sub combines {
3831   return @combine_types;
3832 }
3833
3834 # get the minimum of a list
3835
3836 sub _min {
3837   my $mx=shift;
3838   for(@_) { if ($_<$mx) { $mx=$_; }}
3839   return $mx;
3840 }
3841
3842 # get the maximum of a list
3843
3844 sub _max {
3845   my $mx=shift;
3846   for(@_) { if ($_>$mx) { $mx=$_; }}
3847   return $mx;
3848 }
3849
3850 # string stuff for iptc headers
3851
3852 sub _clean {
3853   my($str)=$_[0];
3854   $str = substr($str,3);
3855   $str =~ s/[\n\r]//g;
3856   $str =~ s/\s+/ /g;
3857   $str =~ s/^\s//;
3858   $str =~ s/\s$//;
3859   return $str;
3860 }
3861
3862 # A little hack to parse iptc headers.
3863
3864 sub parseiptc {
3865   my $self=shift;
3866   my(@sar,$item,@ar);
3867   my($caption,$photogr,$headln,$credit);
3868
3869   my $str=$self->{IPTCRAW};
3870
3871   defined $str
3872     or return;
3873
3874   @ar=split(/8BIM/,$str);
3875
3876   my $i=0;
3877   foreach (@ar) {
3878     if (/^\004\004/) {
3879       @sar=split(/\034\002/);
3880       foreach $item (@sar) {
3881         if ($item =~ m/^x/) {
3882           $caption = _clean($item);
3883           $i++;
3884         }
3885         if ($item =~ m/^P/) {
3886           $photogr = _clean($item);
3887           $i++;
3888         }
3889         if ($item =~ m/^i/) {
3890           $headln = _clean($item);
3891           $i++;
3892         }
3893         if ($item =~ m/^n/) {
3894           $credit = _clean($item);
3895           $i++;
3896         }
3897       }
3898     }
3899   }
3900   return (caption=>$caption,photogr=>$photogr,headln=>$headln,credit=>$credit);
3901 }
3902
3903 sub Inline {
3904   my ($lang) = @_;
3905
3906   $lang eq 'C'
3907     or die "Only C language supported";
3908
3909   require Imager::ExtUtils;
3910   return Imager::ExtUtils->inline_config;
3911 }
3912
3913 # threads shouldn't try to close raw Imager objects
3914 sub Imager::ImgRaw::CLONE_SKIP { 1 }
3915
3916 # backward compatibility for %formats
3917 package Imager::FORMATS;
3918 use strict;
3919 use constant IX_FORMATS => 0;
3920 use constant IX_LIST => 1;
3921 use constant IX_INDEX => 2;
3922 use constant IX_CLASSES => 3;
3923
3924 sub TIEHASH {
3925   my ($class, $formats, $classes) = @_;
3926
3927   return bless [ $formats, [ ], 0, $classes ], $class;
3928 }
3929
3930 sub _check {
3931   my ($self, $key) = @_;
3932
3933   (my $file = $self->[IX_CLASSES]{$key} . ".pm") =~ s(::)(/)g;
3934   my $value;
3935   if (eval { require $file; 1 }) {
3936     $value = 1;
3937   }
3938   else {
3939     $value = undef;
3940   }
3941   $self->[IX_FORMATS]{$key} = $value;
3942
3943   return $value;
3944 }
3945
3946 sub FETCH {
3947   my ($self, $key) = @_;
3948
3949   exists $self->[IX_FORMATS]{$key} and return $self->[IX_FORMATS]{$key};
3950
3951   $self->[IX_CLASSES]{$key} or return undef;
3952
3953   return $self->_check($key);
3954 }
3955
3956 sub STORE {
3957   die "%Imager::formats is not user monifiable";
3958 }
3959
3960 sub DELETE {
3961   die "%Imager::formats is not user monifiable";
3962 }
3963
3964 sub CLEAR {
3965   die "%Imager::formats is not user monifiable";
3966 }
3967
3968 sub EXISTS {
3969   my ($self, $key) = @_;
3970
3971   if (exists $self->[IX_FORMATS]{$key}) {
3972     my $value = $self->[IX_FORMATS]{$key}
3973       or return;
3974     return 1;
3975   }
3976
3977   $self->_check($key) or return 1==0;
3978
3979   return 1==1;
3980 }
3981
3982 sub FIRSTKEY {
3983   my ($self) = @_;
3984
3985   unless (@{$self->[IX_LIST]}) {
3986     # full populate it
3987     @{$self->[IX_LIST]} = grep $self->[IX_FORMATS]{$_},
3988       keys %{$self->[IX_FORMATS]};
3989
3990     for my $key (keys %{$self->[IX_CLASSES]}) {
3991       $self->[IX_FORMATS]{$key} and next;
3992       $self->_check($key)
3993         and push @{$self->[IX_LIST]}, $key;
3994     }
3995   }
3996
3997   @{$self->[IX_LIST]} or return;
3998   $self->[IX_INDEX] = 1;
3999   return $self->[IX_LIST][0];
4000 }
4001
4002 sub NEXTKEY {
4003   my ($self) = @_;
4004
4005   $self->[IX_INDEX] < @{$self->[IX_LIST]}
4006     or return;
4007
4008   return $self->[IX_LIST][$self->[IX_INDEX]++];
4009 }
4010
4011 sub SCALAR {
4012   my ($self) = @_;
4013
4014   return scalar @{$self->[IX_LIST]};
4015 }
4016
4017 1;
4018 __END__
4019 # Below is the stub of documentation for your module. You better edit it!
4020
4021 =head1 NAME
4022
4023 Imager - Perl extension for Generating 24 bit Images
4024
4025 =head1 SYNOPSIS
4026
4027   # Thumbnail example
4028
4029   #!/usr/bin/perl -w
4030   use strict;
4031   use Imager;
4032
4033   die "Usage: thumbmake.pl filename\n" if !-f $ARGV[0];
4034   my $file = shift;
4035
4036   my $format;
4037
4038   # see Imager::Files for information on the read() method
4039   my $im = Imager->new(file=>$file)
4040     or die Imager->errstr();
4041
4042   $file =~ s/\.[^.]*$//;
4043
4044   # Create smaller version
4045   # documented in Imager::Transformations
4046   my $thumb = $img->scale(scalefactor=>.3);
4047
4048   # Autostretch individual channels
4049   $thumb->filter(type=>'autolevels');
4050
4051   # try to save in one of these formats
4052   SAVE:
4053
4054   for $format ( qw( png gif jpeg tiff ppm ) ) {
4055     # Check if given format is supported
4056     if ($Imager::formats{$format}) {
4057       $file.="_low.$format";
4058       print "Storing image as: $file\n";
4059       # documented in Imager::Files
4060       $thumb->write(file=>$file) or
4061         die $thumb->errstr;
4062       last SAVE;
4063     }
4064   }
4065
4066 =head1 DESCRIPTION
4067
4068 Imager is a module for creating and altering images.  It can read and
4069 write various image formats, draw primitive shapes like lines,and
4070 polygons, blend multiple images together in various ways, scale, crop,
4071 render text and more.
4072
4073 =head2 Overview of documentation
4074
4075 =over
4076
4077 =item *
4078
4079 Imager - This document - Synopsis, Example, Table of Contents and
4080 Overview.
4081
4082 =item *
4083
4084 L<Imager::Tutorial> - a brief introduction to Imager.
4085
4086 =item *
4087
4088 L<Imager::Cookbook> - how to do various things with Imager.
4089
4090 =item *
4091
4092 L<Imager::ImageTypes> - Basics of constructing image objects with
4093 C<new()>: Direct type/virtual images, RGB(A)/paletted images,
4094 8/16/double bits/channel, color maps, channel masks, image tags, color
4095 quantization.  Also discusses basic image information methods.
4096
4097 =item *
4098
4099 L<Imager::Files> - IO interaction, reading/writing images, format
4100 specific tags.
4101
4102 =item *
4103
4104 L<Imager::Draw> - Drawing Primitives, lines, boxes, circles, arcs,
4105 flood fill.
4106
4107 =item *
4108
4109 L<Imager::Color> - Color specification.
4110
4111 =item *
4112
4113 L<Imager::Fill> - Fill pattern specification.
4114
4115 =item *
4116
4117 L<Imager::Font> - General font rendering, bounding boxes and font
4118 metrics.
4119
4120 =item *
4121
4122 L<Imager::Transformations> - Copying, scaling, cropping, flipping,
4123 blending, pasting, convert and map.
4124
4125 =item *
4126
4127 L<Imager::Engines> - Programmable transformations through
4128 C<transform()>, C<transform2()> and C<matrix_transform()>.
4129
4130 =item *
4131
4132 L<Imager::Filters> - Filters, sharpen, blur, noise, convolve etc. and
4133 filter plug-ins.
4134
4135 =item *
4136
4137 L<Imager::Expr> - Expressions for evaluation engine used by
4138 transform2().
4139
4140 =item *
4141
4142 L<Imager::Matrix2d> - Helper class for affine transformations.
4143
4144 =item *
4145
4146 L<Imager::Fountain> - Helper for making gradient profiles.
4147
4148 =item *
4149
4150 L<Imager::API> - using Imager's C API
4151
4152 =item *
4153
4154 L<Imager::APIRef> - API function reference
4155
4156 =item *
4157
4158 L<Imager::Inline> - using Imager's C API from Inline::C
4159
4160 =item *
4161
4162 L<Imager::ExtUtils> - tools to get access to Imager's C API.
4163
4164 =back
4165
4166 =head2 Basic Overview
4167
4168 An Image object is created with C<$img = Imager-E<gt>new()>.
4169 Examples:
4170
4171   $img=Imager->new();                         # create empty image
4172   $img->read(file=>'lena.png',type=>'png') or # read image from file
4173      die $img->errstr();                      # give an explanation
4174                                               # if something failed
4175
4176 or if you want to create an empty image:
4177
4178   $img=Imager->new(xsize=>400,ysize=>300,channels=>4);
4179
4180 This example creates a completely black image of width 400 and height
4181 300 and 4 channels.
4182
4183 =head1 ERROR HANDLING
4184
4185 In general a method will return false when it fails, if it does use
4186 the C<errstr()> method to find out why:
4187
4188 =over
4189
4190 =item C<errstr>
4191
4192 Returns the last error message in that context.
4193
4194 If the last error you received was from calling an object method, such
4195 as read, call errstr() as an object method to find out why:
4196
4197   my $image = Imager->new;
4198   $image->read(file => 'somefile.gif')
4199      or die $image->errstr;
4200
4201 If it was a class method then call errstr() as a class method:
4202
4203   my @imgs = Imager->read_multi(file => 'somefile.gif')
4204     or die Imager->errstr;
4205
4206 Note that in some cases object methods are implemented in terms of
4207 class methods so a failing object method may set both.
4208
4209 =back
4210
4211 The C<Imager-E<gt>new> method is described in detail in
4212 L<Imager::ImageTypes>.
4213
4214 =head1 METHOD INDEX
4215
4216 Where to find information on methods for Imager class objects.
4217
4218 addcolors() - L<Imager::ImageTypes/addcolors> - add colors to a
4219 paletted image
4220
4221 addtag() -  L<Imager::ImageTypes/addtag> - add image tags
4222
4223 align_string() - L<Imager::Draw/align_string> - draw text aligned on a
4224 point
4225
4226 arc() - L<Imager::Draw/arc> - draw a filled arc
4227
4228 bits() - L<Imager::ImageTypes/bits> - number of bits per sample for the
4229 image
4230
4231 box() - L<Imager::Draw/box> - draw a filled or outline box.
4232
4233 circle() - L<Imager::Draw/circle> - draw a filled circle
4234
4235 colorcount() - L<Imager::Draw/colorcount> - the number of colors in an
4236 image's palette (paletted images only)
4237
4238 combine() - L<Imager::Transformations/combine> - combine channels from one or
4239 more images.
4240
4241 combines() - L<Imager::Draw/combines> - return a list of the different
4242 combine type keywords
4243
4244 compose() - L<Imager::Transformations/compose> - compose one image
4245 over another.
4246
4247 convert() - L<Imager::Transformations/"Color transformations"> -
4248 transform the color space
4249
4250 copy() - L<Imager::Transformations/copy> - make a duplicate of an
4251 image
4252
4253 crop() - L<Imager::Transformations/crop> - extract part of an image
4254
4255 def_guess_type() - L<Imager::Files/def_guess_type> - default function
4256 used to guess the output file format based on the output file name
4257
4258 deltag() -  L<Imager::ImageTypes/deltag> - delete image tags
4259
4260 difference() - L<Imager::Filters/"Image Difference"> - produce a
4261 difference images from two input images.
4262
4263 errstr() - L<"Basic Overview"> - the error from the last failed
4264 operation.
4265
4266 filter() - L<Imager::Filters> - image filtering
4267
4268 findcolor() - L<Imager::ImageTypes/findcolor> - search the image
4269 palette, if it has one
4270
4271 flip() - L<Imager::Transformations/flip> - flip an image, vertically,
4272 horizontally
4273
4274 flood_fill() - L<Imager::Draw/flood_fill> - fill an enclosed or same
4275 color area
4276
4277 getchannels() - L<Imager::ImageTypes/getchannels> - the number of
4278 samples per pixel for an image
4279
4280 getcolorcount() - L<Imager::ImageTypes/getcolorcount> - the number of
4281 different colors used by an image (works for direct color images)
4282
4283 getcolors() - L<Imager::ImageTypes/getcolors> - get colors from the image
4284 palette, if it has one
4285
4286 getcolorusage() - L<Imager::ImageTypes/getcolorusage>
4287
4288 getcolorusagehash() - L<Imager::ImageTypes/getcolorusagehash>
4289
4290 get_file_limits() - L<Imager::Files/"Limiting the sizes of images you read">
4291
4292 getheight() - L<Imager::ImageTypes/getwidth> - height of the image in
4293 pixels
4294
4295 getmask() - L<Imager::ImageTypes/getmask> - write mask for the image
4296
4297 getpixel() - L<Imager::Draw/getpixel> - retrieve one or more pixel
4298 colors
4299
4300 getsamples() - L<Imager::Draw/getsamples> - retrieve samples from a
4301 row or partial row of pixels.
4302
4303 getscanline() - L<Imager::Draw/getscanline> - retrieve colors for a
4304 row or partial row of pixels.
4305
4306 getwidth() - L<Imager::ImageTypes/getwidth> - width of the image in
4307 pixels.
4308
4309 img_set() - L<Imager::ImageTypes/img_set> - re-use an Imager object
4310 for a new image.
4311
4312 init() - L<Imager::ImageTypes/init>
4313
4314 is_bilevel() - L<Imager::ImageTypes/is_bilevel> - returns whether
4315 image write functions should write the image in their bilevel (blank
4316 and white, no gray levels) format
4317
4318 line() - L<Imager::Draw/line> - draw an interval
4319
4320 load_plugin() - L<Imager::Filters/load_plugin>
4321
4322 map() - L<Imager::Transformations/"Color Mappings"> - remap color
4323 channel values
4324
4325 masked() -  L<Imager::ImageTypes/masked> - make a masked image
4326
4327 matrix_transform() - L<Imager::Engines/matrix_transform>
4328
4329 maxcolors() - L<Imager::ImageTypes/maxcolors>
4330
4331 NC() - L<Imager::Handy/NC>
4332
4333 NCF() - L<Imager::Handy/NCF>
4334
4335 new() - L<Imager::ImageTypes/new>
4336
4337 newcolor() - L<Imager::Handy/newcolor>
4338
4339 newcolour() - L<Imager::Handy/newcolour>
4340
4341 newfont() - L<Imager::Handy/newfont>
4342
4343 NF() - L<Imager::Handy/NF>
4344
4345 open() - L<Imager::Files> - an alias for read()
4346
4347 =for stopwords IPTC
4348
4349 parseiptc() - L<Imager::Files/parseiptc> - parse IPTC data from a JPEG
4350 image
4351
4352 paste() - L<Imager::Transformations/paste> - draw an image onto an image
4353
4354 polygon() - L<Imager::Draw/polygon>
4355
4356 polyline() - L<Imager::Draw/polyline>
4357
4358 read() - L<Imager::Files> - read a single image from an image file
4359
4360 read_multi() - L<Imager::Files> - read multiple images from an image
4361 file
4362
4363 read_types() - L<Imager::Files/read_types> - list image types Imager
4364 can read.
4365
4366 register_filter() - L<Imager::Filters/register_filter>
4367
4368 register_reader() - L<Imager::Files/register_reader>
4369
4370 register_writer() - L<Imager::Files/register_writer>
4371
4372 rotate() - L<Imager::Transformations/rotate>
4373
4374 rubthrough() - L<Imager::Transformations/rubthrough> - draw an image onto an
4375 image and use the alpha channel
4376
4377 scale() - L<Imager::Transformations/scale>
4378
4379 scale_calculate() - L<Imager::Transformations/scale_calculate>
4380
4381 scaleX() - L<Imager::Transformations/scaleX>
4382
4383 scaleY() - L<Imager::Transformations/scaleY>
4384
4385 setcolors() - L<Imager::ImageTypes/setcolors> - set palette colors in
4386 a paletted image
4387
4388 set_file_limits() - L<Imager::Files/"Limiting the sizes of images you read">
4389
4390 setmask() - L<Imager::ImageTypes/setmask>
4391
4392 setpixel() - L<Imager::Draw/setpixel>
4393
4394 setsamples() - L<Imager::Draw/setsamples>
4395
4396 setscanline() - L<Imager::Draw/setscanline>
4397
4398 settag() - L<Imager::ImageTypes/settag>
4399
4400 string() - L<Imager::Draw/string> - draw text on an image
4401
4402 tags() -  L<Imager::ImageTypes/tags> - fetch image tags
4403
4404 to_paletted() -  L<Imager::ImageTypes/to_paletted>
4405
4406 to_rgb16() - L<Imager::ImageTypes/to_rgb16>
4407
4408 to_rgb8() - L<Imager::ImageTypes/to_rgb8>
4409
4410 transform() - L<Imager::Engines/"transform">
4411
4412 transform2() - L<Imager::Engines/"transform2">
4413
4414 type() -  L<Imager::ImageTypes/type> - type of image (direct vs paletted)
4415
4416 unload_plugin() - L<Imager::Filters/unload_plugin>
4417
4418 virtual() - L<Imager::ImageTypes/virtual> - whether the image has it's own
4419 data
4420
4421 write() - L<Imager::Files> - write an image to a file
4422
4423 write_multi() - L<Imager::Files> - write multiple image to an image
4424 file.
4425
4426 write_types() - L<Imager::Files/read_types> - list image types Imager
4427 can write.
4428
4429 =head1 CONCEPT INDEX
4430
4431 animated GIF - L<Imager::Files/"Writing an animated GIF">
4432
4433 aspect ratio - L<Imager::ImageTypes/i_xres>,
4434 L<Imager::ImageTypes/i_yres>, L<Imager::ImageTypes/i_aspect_only>
4435
4436 blend - alpha blending one image onto another
4437 L<Imager::Transformations/rubthrough>
4438
4439 blur - L<Imager::Filters/guassian>, L<Imager::Filters/conv>
4440
4441 boxes, drawing - L<Imager::Draw/box>
4442
4443 changes between image - L<Imager::Filters/"Image Difference">
4444
4445 channels, combine into one image - L<Imager::Transformations/combine>
4446
4447 color - L<Imager::Color>
4448
4449 color names - L<Imager::Color>, L<Imager::Color::Table>
4450
4451 combine modes - L<Imager::Draw/"Combine Types">
4452
4453 compare images - L<Imager::Filters/"Image Difference">
4454
4455 contrast - L<Imager::Filters/contrast>, L<Imager::Filters/autolevels>
4456
4457 convolution - L<Imager::Filters/conv>
4458
4459 cropping - L<Imager::Transformations/crop>
4460
4461 CUR files - L<Imager::Files/"ICO (Microsoft Windows Icon) and CUR (Microsoft Windows Cursor)">
4462
4463 C<diff> images - L<Imager::Filters/"Image Difference">
4464
4465 dpi - L<Imager::ImageTypes/i_xres>, 
4466 L<Imager::Cookbook/"Image spatial resolution">
4467
4468 drawing boxes - L<Imager::Draw/box>
4469
4470 drawing lines - L<Imager::Draw/line>
4471
4472 drawing text - L<Imager::Draw/string>, L<Imager::Draw/align_string>
4473
4474 error message - L<"ERROR HANDLING">
4475
4476 files, font - L<Imager::Font>
4477
4478 files, image - L<Imager::Files>
4479
4480 filling, types of fill - L<Imager::Fill>
4481
4482 filling, boxes - L<Imager::Draw/box>
4483
4484 filling, flood fill - L<Imager::Draw/flood_fill>
4485
4486 flood fill - L<Imager::Draw/flood_fill>
4487
4488 fonts - L<Imager::Font>
4489
4490 fonts, drawing with - L<Imager::Draw/string>,
4491 L<Imager::Draw/align_string>, L<Imager::Font::Wrap>
4492
4493 fonts, metrics - L<Imager::Font/bounding_box>, L<Imager::Font::BBox>
4494
4495 fonts, multiple master - L<Imager::Font/"MULTIPLE MASTER FONTS">
4496
4497 fountain fill - L<Imager::Fill/"Fountain fills">,
4498 L<Imager::Filters/fountain>, L<Imager::Fountain>,
4499 L<Imager::Filters/gradgen>
4500
4501 GIF files - L<Imager::Files/"GIF">
4502
4503 GIF files, animated - L<Imager::File/"Writing an animated GIF">
4504
4505 gradient fill - L<Imager::Fill/"Fountain fills">,
4506 L<Imager::Filters/fountain>, L<Imager::Fountain>,
4507 L<Imager::Filters/gradgen>
4508
4509 gray scale, convert image to - L<Imager::Transformations/convert>
4510
4511 guassian blur - L<Imager::Filters/guassian>
4512
4513 hatch fills - L<Imager::Fill/"Hatched fills">
4514
4515 ICO files - L<Imager::Files/"ICO (Microsoft Windows Icon) and CUR (Microsoft Windows Cursor)">
4516
4517 invert image - L<Imager::Filters/hardinvert>,
4518 L<Imager::Filters/hardinvertall>
4519
4520 JPEG - L<Imager::Files/"JPEG">
4521
4522 limiting image sizes - L<Imager::Files/"Limiting the sizes of images you read">
4523
4524 lines, drawing - L<Imager::Draw/line>
4525
4526 matrix - L<Imager::Matrix2d>, 
4527 L<Imager::Transformations/"Matrix Transformations">,
4528 L<Imager::Font/transform>
4529
4530 metadata, image - L<Imager::ImageTypes/"Tags">
4531
4532 mosaic - L<Imager::Filters/mosaic>
4533
4534 noise, filter - L<Imager::Filters/noise>
4535
4536 noise, rendered - L<Imager::Filters/turbnoise>,
4537 L<Imager::Filters/radnoise>
4538
4539 paste - L<Imager::Transformations/paste>,
4540 L<Imager::Transformations/rubthrough>
4541
4542 pseudo-color image - L<Imager::ImageTypes/to_paletted>,
4543 L<Imager::ImageTypes/new>
4544
4545 =for stopwords posterize
4546
4547 posterize - L<Imager::Filters/postlevels>
4548
4549 PNG files - L<Imager::Files>, L<Imager::Files/"PNG">
4550
4551 PNM - L<Imager::Files/"PNM (Portable aNy Map)">
4552
4553 rectangles, drawing - L<Imager::Draw/box>
4554
4555 resizing an image - L<Imager::Transformations/scale>, 
4556 L<Imager::Transformations/crop>
4557
4558 RGB (SGI) files - L<Imager::Files/"SGI (RGB, BW)">
4559
4560 saving an image - L<Imager::Files>
4561
4562 scaling - L<Imager::Transformations/scale>
4563
4564 SGI files - L<Imager::Files/"SGI (RGB, BW)">
4565
4566 sharpen - L<Imager::Filters/unsharpmask>, L<Imager::Filters/conv>
4567
4568 size, image - L<Imager::ImageTypes/getwidth>,
4569 L<Imager::ImageTypes/getheight>
4570
4571 size, text - L<Imager::Font/bounding_box>
4572
4573 tags, image metadata - L<Imager::ImageTypes/"Tags">
4574
4575 text, drawing - L<Imager::Draw/string>, L<Imager::Draw/align_string>,
4576 L<Imager::Font::Wrap>
4577
4578 text, wrapping text in an area - L<Imager::Font::Wrap>
4579
4580 text, measuring - L<Imager::Font/bounding_box>, L<Imager::Font::BBox>
4581
4582 tiles, color - L<Imager::Filters/mosaic>
4583
4584 =for stopwords unsharp
4585
4586 unsharp mask - L<Imager::Filters/unsharpmask>
4587
4588 watermark - L<Imager::Filters/watermark>
4589
4590 writing an image to a file - L<Imager::Files>
4591
4592 =head1 THREADS
4593
4594 Imager doesn't support perl threads.
4595
4596 Imager has limited code to prevent double frees if you create images,
4597 colors etc, and then create a thread, but has no code to prevent two
4598 threads entering Imager's error handling code, and none is likely to
4599 be added.
4600
4601 =head1 SUPPORT
4602
4603 The best place to get help with Imager is the mailing list.
4604
4605 To subscribe send a message with C<subscribe> in the body to:
4606
4607    imager-devel+request@molar.is
4608
4609 or use the form at:
4610
4611 =over
4612
4613 L<http://www.molar.is/en/lists/imager-devel/>
4614
4615 =back
4616
4617 where you can also find the mailing list archive.
4618
4619 You can report bugs by pointing your browser at:
4620
4621 =over
4622
4623 L<https://rt.cpan.org/NoAuth/ReportBug.html?Queue=Imager>
4624
4625 =back
4626
4627 or by sending an email to:
4628
4629 =over
4630
4631 bug-Imager@rt.cpan.org
4632
4633 =back
4634
4635 Please remember to include the versions of Imager, perl, supporting
4636 libraries, and any relevant code.  If you have specific images that
4637 cause the problems, please include those too.
4638
4639 If you don't want to publish your email address on a mailing list you
4640 can use CPAN::Forum:
4641
4642   http://www.cpanforum.com/dist/Imager
4643
4644 You will need to register to post.
4645
4646 =head1 CONTRIBUTING TO IMAGER
4647
4648 =head2 Feedback
4649
4650 I like feedback.
4651
4652 If you like or dislike Imager, you can add a public review of Imager
4653 at CPAN Ratings:
4654
4655   http://cpanratings.perl.org/dist/Imager
4656
4657 =for stopwords Bitcard
4658
4659 This requires a Bitcard account (http://www.bitcard.org).
4660
4661 You can also send email to the maintainer below.
4662
4663 If you send me a bug report via email, it will be copied to Request
4664 Tracker.
4665
4666 =head2 Patches
4667
4668 I accept patches, preferably against the main branch in subversion.
4669 You should include an explanation of the reason for why the patch is
4670 needed or useful.
4671
4672 Your patch should include regression tests where possible, otherwise
4673 it will be delayed until I get a chance to write them.
4674
4675 =head1 AUTHOR
4676
4677 Tony Cook <tony@imager.perl.org> is the current maintainer for Imager.
4678
4679 Arnar M. Hrafnkelsson is the original author of Imager.
4680
4681 Many others have contributed to Imager, please see the C<README> for a
4682 complete list.
4683
4684 =head1 LICENSE
4685
4686 Imager is licensed under the same terms as perl itself.
4687
4688 =for stopwords
4689 makeblendedfont Fontforge
4690
4691 A test font, FT2/fontfiles/MMOne.pfb, contains a Postscript operator
4692 definition copyrighted by Adobe.  See adobe.txt in the source for
4693 license information.
4694
4695 =head1 SEE ALSO
4696
4697 L<perl>(1), L<Imager::ImageTypes>(3), L<Imager::Files>(3),
4698 L<Imager::Draw>(3), L<Imager::Color>(3), L<Imager::Fill>(3),
4699 L<Imager::Font>(3), L<Imager::Transformations>(3),
4700 L<Imager::Engines>(3), L<Imager::Filters>(3), L<Imager::Expr>(3),
4701 L<Imager::Matrix2d>(3), L<Imager::Fountain>(3)
4702
4703 L<http://imager.perl.org/>
4704
4705 L<Affix::Infix2Postfix>(3), L<Parse::RecDescent>(3)
4706
4707 Other perl imaging modules include:
4708
4709 L<GD>(3), L<Image::Magick>(3), L<Graphics::Magick>(3).
4710
4711 =cut