temporary scaling test code, proper defaults for crop().
[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 $fontstate %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_readjpeg_wiol
78                 i_writejpeg_wiol
79
80                 i_readtiff_wiol
81                 i_writetiff_wiol
82                 i_writetiff_wiol_faxable
83
84                 i_readpng_wiol
85                 i_writepng_wiol
86
87                 i_readgif
88                 i_readgif_wiol
89                 i_readgif_callback
90                 i_writegif
91                 i_writegifmc
92                 i_writegif_gen
93                 i_writegif_callback
94
95                 i_readpnm_wiol
96                 i_writeppm_wiol
97
98                 i_readraw_wiol
99                 i_writeraw_wiol
100
101                 i_contrast
102                 i_hardinvert
103                 i_noise
104                 i_bumpmap
105                 i_postlevels
106                 i_mosaic
107                 i_watermark
108
109                 malloc_state
110
111                 list_formats
112
113                 i_gifquant
114
115                 newfont
116                 newcolor
117                 newcolour
118                 NC
119                 NF
120 );
121
122 @EXPORT=qw(
123            init_log
124            i_list_formats
125            i_has_format
126            malloc_state
127            i_color_new
128
129            i_img_empty
130            i_img_empty_ch
131           );
132
133 %EXPORT_TAGS=
134   (handy => [qw(
135                 newfont
136                 newcolor
137                 NF
138                 NC
139                )],
140    all => [@EXPORT_OK],
141    default => [qw(
142                   load_plugin
143                   unload_plugin
144                  )]);
145
146 BEGIN {
147   require Exporter;
148   require DynaLoader;
149
150   $VERSION = '0.41';
151   @ISA = qw(Exporter DynaLoader);
152   bootstrap Imager $VERSION;
153 }
154
155 BEGIN {
156   i_init_fonts(); # Initialize font engines
157   Imager::Font::__init();
158   for(i_list_formats()) { $formats{$_}++; }
159
160   if ($formats{'t1'}) {
161     i_t1_set_aa(1);
162   }
163
164   if (!$formats{'t1'} and !$formats{'tt'} 
165       && !$formats{'ft2'} && !$formats{'w32'}) {
166     $fontstate='no font support';
167   }
168
169   %OPCODES=(Add=>[0],Sub=>[1],Mult=>[2],Div=>[3],Parm=>[4],'sin'=>[5],'cos'=>[6],'x'=>[4,0],'y'=>[4,1]);
170
171   $DEBUG=0;
172
173   # the members of the subhashes under %filters are:
174   #  callseq - a list of the parameters to the underlying filter in the
175   #            order they are passed
176   #  callsub - a code ref that takes a named parameter list and calls the
177   #            underlying filter
178   #  defaults - a hash of default values
179   #  names - defines names for value of given parameters so if the names 
180   #          field is foo=> { bar=>1 }, and the user supplies "bar" as the
181   #          foo parameter, the filter will receive 1 for the foo
182   #          parameter
183   $filters{contrast}={
184                       callseq => ['image','intensity'],
185                       callsub => sub { my %hsh=@_; i_contrast($hsh{image},$hsh{intensity}); } 
186                      };
187
188   $filters{noise} ={
189                     callseq => ['image', 'amount', 'subtype'],
190                     defaults => { amount=>3,subtype=>0 },
191                     callsub => sub { my %hsh=@_; i_noise($hsh{image},$hsh{amount},$hsh{subtype}); }
192                    };
193
194   $filters{hardinvert} ={
195                          callseq => ['image'],
196                          defaults => { },
197                          callsub => sub { my %hsh=@_; i_hardinvert($hsh{image}); }
198                         };
199
200   $filters{autolevels} ={
201                          callseq => ['image','lsat','usat','skew'],
202                          defaults => { lsat=>0.1,usat=>0.1,skew=>0.0 },
203                          callsub => sub { my %hsh=@_; i_autolevels($hsh{image},$hsh{lsat},$hsh{usat},$hsh{skew}); }
204                         };
205
206   $filters{turbnoise} ={
207                         callseq => ['image'],
208                         defaults => { xo=>0.0,yo=>0.0,scale=>10.0 },
209                         callsub => sub { my %hsh=@_; i_turbnoise($hsh{image},$hsh{xo},$hsh{yo},$hsh{scale}); }
210                        };
211
212   $filters{radnoise} ={
213                        callseq => ['image'],
214                        defaults => { xo=>100,yo=>100,ascale=>17.0,rscale=>0.02 },
215                        callsub => sub { my %hsh=@_; i_radnoise($hsh{image},$hsh{xo},$hsh{yo},$hsh{rscale},$hsh{ascale}); }
216                       };
217
218   $filters{conv} ={
219                        callseq => ['image', 'coef'],
220                        defaults => { },
221                        callsub => sub { my %hsh=@_; i_conv($hsh{image},$hsh{coef}); }
222                       };
223
224   $filters{gradgen} ={
225                        callseq => ['image', 'xo', 'yo', 'colors', 'dist'],
226                        defaults => { },
227                        callsub => sub { my %hsh=@_; i_gradgen($hsh{image}, $hsh{xo}, $hsh{yo}, $hsh{colors}, $hsh{dist}); }
228                       };
229
230   $filters{nearest_color} ={
231                             callseq => ['image', 'xo', 'yo', 'colors', 'dist'],
232                             defaults => { },
233                             callsub => sub { my %hsh=@_; i_nearest_color($hsh{image}, $hsh{xo}, $hsh{yo}, $hsh{colors}, $hsh{dist}); }
234                            };
235   $filters{gaussian} = {
236                         callseq => [ 'image', 'stddev' ],
237                         defaults => { },
238                         callsub => sub { my %hsh = @_; i_gaussian($hsh{image}, $hsh{stddev}); },
239                        };
240   $filters{mosaic} =
241     {
242      callseq => [ qw(image size) ],
243      defaults => { size => 20 },
244      callsub => sub { my %hsh = @_; i_mosaic($hsh{image}, $hsh{size}) },
245     };
246   $filters{bumpmap} =
247     {
248      callseq => [ qw(image bump elevation lightx lighty st) ],
249      defaults => { elevation=>0, st=> 2 },
250      callsub => sub {
251        my %hsh = @_;
252        i_bumpmap($hsh{image}, $hsh{bump}{IMG}, $hsh{elevation},
253                  $hsh{lightx}, $hsh{lighty}, $hsh{st});
254      },
255     };
256   $filters{bumpmap_complex} =
257     {
258      callseq => [ qw(image bump channel tx ty Lx Ly Lz cd cs n Ia Il Is) ],
259      defaults => {
260                   channel => 0,
261                   tx => 0,
262                   ty => 0,
263                   Lx => 0.2,
264                   Ly => 0.4,
265                   Lz => -1.0,
266                   cd => 1.0,
267                   cs => 40,
268                   n => 1.3,
269                   Ia => Imager::Color->new(rgb=>[0,0,0]),
270                   Il => Imager::Color->new(rgb=>[255,255,255]),
271                   Is => Imager::Color->new(rgb=>[255,255,255]),
272                  },
273      callsub => sub {
274        my %hsh = @_;
275        i_bumpmap_complex($hsh{image}, $hsh{bump}{IMG}, $hsh{channel},
276                  $hsh{tx}, $hsh{ty}, $hsh{Lx}, $hsh{Ly}, $hsh{Lz},
277                  $hsh{cd}, $hsh{cs}, $hsh{n}, $hsh{Ia}, $hsh{Il},
278                  $hsh{Is});
279      },
280     };
281   $filters{postlevels} =
282     {
283      callseq  => [ qw(image levels) ],
284      defaults => { levels => 10 },
285      callsub  => sub { my %hsh = @_; i_postlevels($hsh{image}, $hsh{levels}); },
286     };
287   $filters{watermark} =
288     {
289      callseq  => [ qw(image wmark tx ty pixdiff) ],
290      defaults => { pixdiff=>10, tx=>0, ty=>0 },
291      callsub  => 
292      sub { 
293        my %hsh = @_; 
294        i_watermark($hsh{image}, $hsh{wmark}{IMG}, $hsh{tx}, $hsh{ty}, 
295                    $hsh{pixdiff}); 
296      },
297     };
298   $filters{fountain} =
299     {
300      callseq  => [ qw(image xa ya xb yb ftype repeat combine super_sample ssample_param segments) ],
301      names    => {
302                   ftype => { linear         => 0,
303                              bilinear       => 1,
304                              radial         => 2,
305                              radial_square  => 3,
306                              revolution     => 4,
307                              conical        => 5 },
308                   repeat => { none      => 0,
309                               sawtooth  => 1,
310                               triangle  => 2,
311                               saw_both  => 3,
312                               tri_both  => 4,
313                             },
314                   super_sample => {
315                                    none    => 0,
316                                    grid    => 1,
317                                    random  => 2,
318                                    circle  => 3,
319                                   },
320                   combine => {
321                               none      => 0,
322                               normal    => 1,
323                               multiply  => 2, mult => 2,
324                               dissolve  => 3,
325                               add       => 4,
326                               subtract  => 5, 'sub' => 5,
327                               diff      => 6,
328                               lighten   => 7,
329                               darken    => 8,
330                               hue       => 9,
331                               sat       => 10,
332                               value     => 11,
333                               color     => 12,
334                              },
335                  },
336      defaults => { ftype => 0, repeat => 0, combine => 0,
337                    super_sample => 0, ssample_param => 4,
338                    segments=>[ 
339                               [ 0, 0.5, 1,
340                                 Imager::Color->new(0,0,0),
341                                 Imager::Color->new(255, 255, 255),
342                                 0, 0,
343                               ],
344                              ],
345                  },
346      callsub  => 
347      sub {
348        my %hsh = @_;
349        i_fountain($hsh{image}, $hsh{xa}, $hsh{ya}, $hsh{xb}, $hsh{yb},
350                   $hsh{ftype}, $hsh{repeat}, $hsh{combine}, $hsh{super_sample},
351                   $hsh{ssample_param}, $hsh{segments});
352      },
353     };
354   $filters{unsharpmask} =
355     {
356      callseq => [ qw(image stddev scale) ],
357      defaults => { stddev=>2.0, scale=>1.0 },
358      callsub => 
359      sub { 
360        my %hsh = @_;
361        i_unsharp_mask($hsh{image}, $hsh{stddev}, $hsh{scale});
362      },
363     };
364
365   $FORMATGUESS=\&def_guess_type;
366
367   $warn_obsolete = 1;
368 }
369
370 #
371 # Non methods
372 #
373
374 # initlize Imager
375 # NOTE: this might be moved to an import override later on
376
377 #sub import {
378 #  my $pack = shift;
379 #  (look through @_ for special tags, process, and remove them);   
380 #  use Data::Dumper;
381 #  print Dumper($pack);
382 #  print Dumper(@_);
383 #}
384
385 sub init_log {
386         m_init_log($_[0],$_[1]);
387         log_entry("Imager $VERSION starting\n", 1);
388 }
389
390
391 sub init {
392   my %parms=(loglevel=>1,@_);
393   if ($parms{'log'}) {
394     init_log($parms{'log'},$parms{'loglevel'});
395   }
396
397   if (exists $parms{'warn_obsolete'}) {
398     $warn_obsolete = $parms{'warn_obsolete'};
399   }
400
401 #    if ($parms{T1LIB_CONFIG}) { $ENV{T1LIB_CONFIG}=$parms{T1LIB_CONFIG}; }
402 #    if ( $ENV{T1LIB_CONFIG} and ( $fontstate eq 'missing conf' )) {
403 #       i_init_fonts();
404 #       $fontstate='ok';
405 #    }
406   if (exists $parms{'t1log'}) {
407     i_init_fonts($parms{'t1log'});
408   }
409 }
410
411 END {
412   if ($DEBUG) {
413     print "shutdown code\n";
414     #   for(keys %instances) { $instances{$_}->DESTROY(); }
415     malloc_state(); # how do decide if this should be used? -- store something from the import
416     print "Imager exiting\n";
417   }
418 }
419
420 # Load a filter plugin 
421
422 sub load_plugin {
423   my ($filename)=@_;
424   my $i;
425   my ($DSO_handle,$str)=DSO_open($filename);
426   if (!defined($DSO_handle)) { $Imager::ERRSTR="Couldn't load plugin '$filename'\n"; return undef; }
427   my %funcs=DSO_funclist($DSO_handle);
428   if ($DEBUG) { print "loading module $filename\n"; $i=0; for(keys %funcs) { printf("  %2d: %s\n",$i++,$_); } }
429   $i=0;
430   for(keys %funcs) { if ($filters{$_}) { $ERRSTR="filter '$_' already exists\n"; DSO_close($DSO_handle); return undef; } }
431
432   $DSOs{$filename}=[$DSO_handle,\%funcs];
433
434   for(keys %funcs) { 
435     my $evstr="\$filters{'".$_."'}={".$funcs{$_}.'};';
436     $DEBUG && print "eval string:\n",$evstr,"\n";
437     eval $evstr;
438     print $@ if $@;
439   }
440   return 1;
441 }
442
443 # Unload a plugin
444
445 sub unload_plugin {
446   my ($filename)=@_;
447
448   if (!$DSOs{$filename}) { $ERRSTR="plugin '$filename' not loaded."; return undef; }
449   my ($DSO_handle,$funcref)=@{$DSOs{$filename}};
450   for(keys %{$funcref}) {
451     delete $filters{$_};
452     $DEBUG && print "unloading: $_\n";
453   }
454   my $rc=DSO_close($DSO_handle);
455   if (!defined($rc)) { $ERRSTR="unable to unload plugin '$filename'."; return undef; }
456   return 1;
457 }
458
459 # take the results of i_error() and make a message out of it
460 sub _error_as_msg {
461   return join(": ", map $_->[0], i_errors());
462 }
463
464 # this function tries to DWIM for color parameters
465 #  color objects are used as is
466 #  simple scalars are simply treated as single parameters to Imager::Color->new
467 #  hashrefs are treated as named argument lists to Imager::Color->new
468 #  arrayrefs are treated as list arguments to Imager::Color->new iff any
469 #    parameter is > 1
470 #  other arrayrefs are treated as list arguments to Imager::Color::Float
471
472 sub _color {
473   my $arg = shift;
474   # perl 5.6.0 seems to do weird things to $arg if we don't make an 
475   # explicitly stringified copy
476   # I vaguely remember a bug on this on p5p, but couldn't find it
477   # through bugs.perl.org (I had trouble getting it to find any bugs)
478   my $copy = $arg . "";
479   my $result;
480
481   if (ref $arg) {
482     if (UNIVERSAL::isa($arg, "Imager::Color")
483         || UNIVERSAL::isa($arg, "Imager::Color::Float")) {
484       $result = $arg;
485     }
486     else {
487       if ($copy =~ /^HASH\(/) {
488         $result = Imager::Color->new(%$arg);
489       }
490       elsif ($copy =~ /^ARRAY\(/) {
491         if (grep $_ > 1, @$arg) {
492           $result = Imager::Color->new(@$arg);
493         }
494         else {
495           $result = Imager::Color::Float->new(@$arg);
496         }
497       }
498       else {
499         $Imager::ERRSTR = "Not a color";
500       }
501     }
502   }
503   else {
504     # assume Imager::Color::new knows how to handle it
505     $result = Imager::Color->new($arg);
506   }
507
508   return $result;
509 }
510
511
512 #
513 # Methods to be called on objects.
514 #
515
516 # Create a new Imager object takes very few parameters.
517 # usually you call this method and then call open from
518 # the resulting object
519
520 sub new {
521   my $class = shift;
522   my $self ={};
523   my %hsh=@_;
524   bless $self,$class;
525   $self->{IMG}=undef;    # Just to indicate what exists
526   $self->{ERRSTR}=undef; #
527   $self->{DEBUG}=$DEBUG;
528   $self->{DEBUG} && print "Initialized Imager\n";
529   if ($hsh{xsize} && $hsh{ysize}) { $self->img_set(%hsh); }
530   return $self;
531 }
532
533 # Copy an entire image with no changes 
534 # - if an image has magic the copy of it will not be magical
535
536 sub copy {
537   my $self = shift;
538   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
539
540   my $newcopy=Imager->new();
541   $newcopy->{IMG}=i_img_new();
542   i_copy($newcopy->{IMG},$self->{IMG});
543   return $newcopy;
544 }
545
546 # Paste a region
547
548 sub paste {
549   my $self = shift;
550   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
551   my %input=(left=>0, top=>0, @_);
552   unless($input{img}) {
553     $self->{ERRSTR}="no source image";
554     return;
555   }
556   $input{left}=0 if $input{left} <= 0;
557   $input{top}=0 if $input{top} <= 0;
558   my $src=$input{img};
559   my($r,$b)=i_img_info($src->{IMG});
560
561   i_copyto($self->{IMG}, $src->{IMG}, 
562            0,0, $r, $b, $input{left}, $input{top});
563   return $self;  # What should go here??
564 }
565
566 # Crop an image - i.e. return a new image that is smaller
567
568 sub crop {
569   my $self=shift;
570   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
571   my %hsh=(left=>0,right=>$self->getwidth(),top=>0,bottom=>$self->getheight(),@_);
572
573   my ($w,$h,$l,$r,$b,$t)=($self->getwidth(),$self->getheight(),
574                                 @hsh{qw(left right bottom top)});
575   $l=0 if not defined $l;
576   $t=0 if not defined $t;
577
578   $r||=$l+delete $hsh{'width'}    if defined $l and exists $hsh{'width'};
579   $b||=$t+delete $hsh{'height'}   if defined $t and exists $hsh{'height'};
580   $l||=$r-delete $hsh{'width'}    if defined $r and exists $hsh{'width'};
581   $t||=$b-delete $hsh{'height'}   if defined $b and exists $hsh{'height'};
582
583   $r=$self->getwidth if not defined $r;
584   $b=$self->getheight if not defined $b;
585
586   ($l,$r)=($r,$l) if $l>$r;
587   ($t,$b)=($b,$t) if $t>$b;
588
589   if ($hsh{'width'}) {
590     $l=int(0.5+($w-$hsh{'width'})/2);
591     $r=$l+$hsh{'width'};
592   } else {
593     $hsh{'width'}=$r-$l;
594   }
595   if ($hsh{'height'}) {
596     $b=int(0.5+($h-$hsh{'height'})/2);
597     $t=$h+$hsh{'height'};
598   } else {
599     $hsh{'height'}=$b-$t;
600   }
601
602 #    print "l=$l, r=$r, h=$hsh{'width'}\n";
603 #    print "t=$t, b=$b, w=$hsh{'height'}\n";
604
605   my $dst=Imager->new(xsize=>$hsh{'width'}, ysize=>$hsh{'height'}, channels=>$self->getchannels());
606
607   i_copyto($dst->{IMG},$self->{IMG},$l,$t,$r,$b,0,0);
608   return $dst;
609 }
610
611 # Sets an image to a certain size and channel number
612 # if there was previously data in the image it is discarded
613
614 sub img_set {
615   my $self=shift;
616
617   my %hsh=(xsize=>100, ysize=>100, channels=>3, bits=>8, type=>'direct', @_);
618
619   if (defined($self->{IMG})) {
620     # let IIM_DESTROY destroy it, it's possible this image is
621     # referenced from a virtual image (like masked)
622     #i_img_destroy($self->{IMG});
623     undef($self->{IMG});
624   }
625
626   if ($hsh{type} eq 'paletted' || $hsh{type} eq 'pseudo') {
627     $self->{IMG} = i_img_pal_new($hsh{xsize}, $hsh{ysize}, $hsh{channels},
628                                  $hsh{maxcolors} || 256);
629   }
630   elsif ($hsh{bits} eq 'double') {
631     $self->{IMG} = i_img_double_new($hsh{xsize}, $hsh{ysize}, $hsh{channels});
632   }
633   elsif ($hsh{bits} == 16) {
634     $self->{IMG} = i_img_16_new($hsh{xsize}, $hsh{ysize}, $hsh{channels});
635   }
636   else {
637     $self->{IMG}=Imager::ImgRaw::new($hsh{'xsize'}, $hsh{'ysize'},
638                                      $hsh{'channels'});
639   }
640 }
641
642 # created a masked version of the current image
643 sub masked {
644   my $self = shift;
645
646   $self or return undef;
647   my %opts = (left    => 0, 
648               top     => 0, 
649               right   => $self->getwidth, 
650               bottom  => $self->getheight,
651               @_);
652   my $mask = $opts{mask} ? $opts{mask}{IMG} : undef;
653
654   my $result = Imager->new;
655   $result->{IMG} = i_img_masked_new($self->{IMG}, $mask, $opts{left}, 
656                                     $opts{top}, $opts{right} - $opts{left},
657                                     $opts{bottom} - $opts{top});
658   # keep references to the mask and base images so they don't
659   # disappear on us
660   $result->{DEPENDS} = [ $self->{IMG}, $mask ];
661
662   $result;
663 }
664
665 # convert an RGB image into a paletted image
666 sub to_paletted {
667   my $self = shift;
668   my $opts;
669   if (@_ != 1 && !ref $_[0]) {
670     $opts = { @_ };
671   }
672   else {
673     $opts = shift;
674   }
675
676   my $result = Imager->new;
677   $result->{IMG} = i_img_to_pal($self->{IMG}, $opts);
678
679   #print "Type ", i_img_type($result->{IMG}), "\n";
680
681   $result->{IMG} or undef $result;
682
683   return $result;
684 }
685
686 # convert a paletted (or any image) to an 8-bit/channel RGB images
687 sub to_rgb8 {
688   my $self = shift;
689   my $result;
690
691   if ($self->{IMG}) {
692     $result = Imager->new;
693     $result->{IMG} = i_img_to_rgb($self->{IMG})
694       or undef $result;
695   }
696
697   return $result;
698 }
699
700 sub addcolors {
701   my $self = shift;
702   my %opts = (colors=>[], @_);
703
704   @{$opts{colors}} or return undef;
705
706   $self->{IMG} and i_addcolors($self->{IMG}, @{$opts{colors}});
707 }
708
709 sub setcolors {
710   my $self = shift;
711   my %opts = (start=>0, colors=>[], @_);
712   @{$opts{colors}} or return undef;
713
714   $self->{IMG} and i_setcolors($self->{IMG}, $opts{start}, @{$opts{colors}});
715 }
716
717 sub getcolors {
718   my $self = shift;
719   my %opts = @_;
720   if (!exists $opts{start} && !exists $opts{count}) {
721     # get them all
722     $opts{start} = 0;
723     $opts{count} = $self->colorcount;
724   }
725   elsif (!exists $opts{count}) {
726     $opts{count} = 1;
727   }
728   elsif (!exists $opts{start}) {
729     $opts{start} = 0;
730   }
731   
732   $self->{IMG} and 
733     return i_getcolors($self->{IMG}, $opts{start}, $opts{count});
734 }
735
736 sub colorcount {
737   i_colorcount($_[0]{IMG});
738 }
739
740 sub maxcolors {
741   i_maxcolors($_[0]{IMG});
742 }
743
744 sub findcolor {
745   my $self = shift;
746   my %opts = @_;
747   $opts{color} or return undef;
748
749   $self->{IMG} and i_findcolor($self->{IMG}, $opts{color});
750 }
751
752 sub bits {
753   my $self = shift;
754   my $bits = $self->{IMG} && i_img_bits($self->{IMG});
755   if ($bits && $bits == length(pack("d", 1)) * 8) {
756     $bits = 'double';
757   }
758   $bits;
759 }
760
761 sub type {
762   my $self = shift;
763   if ($self->{IMG}) {
764     return i_img_type($self->{IMG}) ? "paletted" : "direct";
765   }
766 }
767
768 sub virtual {
769   my $self = shift;
770   $self->{IMG} and i_img_virtual($self->{IMG});
771 }
772
773 sub tags {
774   my ($self, %opts) = @_;
775
776   $self->{IMG} or return;
777
778   if (defined $opts{name}) {
779     my @result;
780     my $start = 0;
781     my $found;
782     while (defined($found = i_tags_find($self->{IMG}, $opts{name}, $start))) {
783       push @result, (i_tags_get($self->{IMG}, $found))[1];
784       $start = $found+1;
785     }
786     return wantarray ? @result : $result[0];
787   }
788   elsif (defined $opts{code}) {
789     my @result;
790     my $start = 0;
791     my $found;
792     while (defined($found = i_tags_findn($self->{IMG}, $opts{code}, $start))) {
793       push @result, (i_tags_get($self->{IMG}, $found))[1];
794       $start = $found+1;
795     }
796     return @result;
797   }
798   else {
799     if (wantarray) {
800       return map { [ i_tags_get($self->{IMG}, $_) ] } 0.. i_tags_count($self->{IMG})-1;
801     }
802     else {
803       return i_tags_count($self->{IMG});
804     }
805   }
806 }
807
808 sub addtag {
809   my $self = shift;
810   my %opts = @_;
811
812   return -1 unless $self->{IMG};
813   if ($opts{name}) {
814     if (defined $opts{value}) {
815       if ($opts{value} =~ /^\d+$/) {
816         # add as a number
817         return i_tags_addn($self->{IMG}, $opts{name}, 0, $opts{value});
818       }
819       else {
820         return i_tags_add($self->{IMG}, $opts{name}, 0, $opts{value}, 0);
821       }
822     }
823     elsif (defined $opts{data}) {
824       # force addition as a string
825       return i_tags_add($self->{IMG}, $opts{name}, 0, $opts{data}, 0);
826     }
827     else {
828       $self->{ERRSTR} = "No value supplied";
829       return undef;
830     }
831   }
832   elsif ($opts{code}) {
833     if (defined $opts{value}) {
834       if ($opts{value} =~ /^\d+$/) {
835         # add as a number
836         return i_tags_addn($self->{IMG}, $opts{code}, 0, $opts{value});
837       }
838       else {
839         return i_tags_add($self->{IMG}, $opts{code}, 0, $opts{value}, 0);
840       }
841     }
842     elsif (defined $opts{data}) {
843       # force addition as a string
844       return i_tags_add($self->{IMG}, $opts{code}, 0, $opts{data}, 0);
845     }
846     else {
847       $self->{ERRSTR} = "No value supplied";
848       return undef;
849     }
850   }
851   else {
852     return undef;
853   }
854 }
855
856 sub deltag {
857   my $self = shift;
858   my %opts = @_;
859
860   return 0 unless $self->{IMG};
861
862   if (defined $opts{'index'}) {
863     return i_tags_delete($self->{IMG}, $opts{'index'});
864   }
865   elsif (defined $opts{name}) {
866     return i_tags_delbyname($self->{IMG}, $opts{name});
867   }
868   elsif (defined $opts{code}) {
869     return i_tags_delbycode($self->{IMG}, $opts{code});
870   }
871   else {
872     $self->{ERRSTR} = "Need to supply index, name, or code parameter";
873     return 0;
874   }
875 }
876
877 sub settag {
878   my ($self, %opts) = @_;
879
880   if ($opts{name}) {
881     $self->deltag(name=>$opts{name});
882     return $self->addtag(name=>$opts{name}, value=>$opts{value});
883   }
884   elsif (defined $opts{code}) {
885     $self->deltag(code=>$opts{code});
886     return $self->addtag(code=>$opts{code}, value=>$opts{value});
887   }
888   else {
889     return undef;
890   }
891 }
892
893 my @needseekcb = qw/tiff/;
894 my %needseekcb = map { $_, $_ } @needseekcb;
895
896
897 sub _get_reader_io {
898   my ($self, $input, $type) = @_;
899
900   if ($input->{fd}) {
901     return io_new_fd($input->{fd});
902   }
903   elsif ($input->{fh}) {
904     my $fd = fileno($input->{fh});
905     unless ($fd) {
906       $self->_set_error("Handle in fh option not opened");
907       return;
908     }
909     return io_new_fd($fd);
910   }
911   elsif ($input->{file}) {
912     my $file = IO::File->new($input->{file}, "r");
913     unless ($file) {
914       $self->_set_error("Could not open $input->{file}: $!");
915       return;
916     }
917     binmode $file;
918     return (io_new_fd(fileno($file)), $file);
919   }
920   elsif ($input->{data}) {
921     return io_new_buffer($input->{data});
922   }
923   elsif ($input->{callback} || $input->{readcb}) {
924     if ($needseekcb{$type} && !$input->{seekcb}) {
925       $self->_set_error("Format $type needs a seekcb parameter");
926     }
927     if ($input->{maxbuffer}) {
928       return io_new_cb($input->{writecb},
929                        $input->{callback} || $input->{readcb},
930                        $input->{seekcb}, $input->{closecb},
931                        $input->{maxbuffer});
932     }
933     else {
934       return io_new_cb($input->{writecb},
935                        $input->{callback} || $input->{readcb},
936                        $input->{seekcb}, $input->{closecb});
937     }
938   }
939   else {
940     $self->_set_error("file/fd/fh/data/callback parameter missing");
941     return;
942   }
943 }
944
945 sub _get_writer_io {
946   my ($self, $input, $type) = @_;
947
948   if ($input->{fd}) {
949     return io_new_fd($input->{fd});
950   }
951   elsif ($input->{fh}) {
952     my $fd = fileno($input->{fh});
953     unless ($fd) {
954       $self->_set_error("Handle in fh option not opened");
955       return;
956     }
957     # flush it
958     my $oldfh = select($input->{fh});
959     # flush anything that's buffered, and make sure anything else is flushed
960     $| = 1;
961     select($oldfh);
962     return io_new_fd($fd);
963   }
964   elsif ($input->{file}) {
965     my $fh = new IO::File($input->{file},"w+");
966     unless ($fh) { 
967       $self->_set_error("Could not open file $input->{file}: $!");
968       return;
969     }
970     binmode($fh) or die;
971     return (io_new_fd(fileno($fh)), $fh);
972   }
973   elsif ($input->{data}) {
974     return io_new_bufchain();
975   }
976   elsif ($input->{callback} || $input->{writecb}) {
977     if ($input->{maxbuffer}) {
978       return io_new_cb($input->{callback} || $input->{writecb},
979                        $input->{readcb},
980                        $input->{seekcb}, $input->{closecb},
981                        $input->{maxbuffer});
982     }
983     else {
984       return io_new_cb($input->{callback} || $input->{writecb},
985                        $input->{readcb},
986                        $input->{seekcb}, $input->{closecb});
987     }
988   }
989   else {
990     $self->_set_error("file/fd/fh/data/callback parameter missing");
991     return;
992   }
993 }
994
995 # Read an image from file
996
997 sub read {
998   my $self = shift;
999   my %input=@_;
1000
1001   if (defined($self->{IMG})) {
1002     # let IIM_DESTROY do the destruction, since the image may be
1003     # referenced from elsewhere
1004     #i_img_destroy($self->{IMG});
1005     undef($self->{IMG});
1006   }
1007
1008   # FIXME: Find the format here if not specified
1009   # yes the code isn't here yet - next week maybe?
1010   # Next week?  Are you high or something?  That comment
1011   # has been there for half a year dude.
1012   # Look, i just work here, ok?
1013
1014   if (!$input{'type'} and $input{file}) {
1015     $input{'type'}=$FORMATGUESS->($input{file});
1016   }
1017   unless ($input{'type'}) {
1018     $self->_set_error('type parameter missing and not possible to guess from extension'); 
1019     return undef;
1020   }
1021   if (!$formats{$input{'type'}}) {
1022     $self->{ERRSTR}='format not supported'; return undef;
1023   }
1024
1025   my %iolready=(jpeg=>1, png=>1, tiff=>1, pnm=>1, raw=>1, bmp=>1, tga=>1, rgb=>1, gif=>1);
1026
1027   if ($iolready{$input{'type'}}) {
1028     # Setup data source
1029     my ($IO, $fh) = $self->_get_reader_io(\%input, $input{'type'})
1030       or return;
1031
1032     if ( $input{'type'} eq 'jpeg' ) {
1033       ($self->{IMG},$self->{IPTCRAW})=i_readjpeg_wiol( $IO );
1034       if ( !defined($self->{IMG}) ) {
1035         $self->{ERRSTR}='unable to read jpeg image'; return undef;
1036       }
1037       $self->{DEBUG} && print "loading a jpeg file\n";
1038       return $self;
1039     }
1040
1041     if ( $input{'type'} eq 'tiff' ) {
1042       $self->{IMG}=i_readtiff_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed
1043       if ( !defined($self->{IMG}) ) {
1044         $self->{ERRSTR}=$self->_error_as_msg(); return undef;
1045       }
1046       $self->{DEBUG} && print "loading a tiff file\n";
1047       return $self;
1048     }
1049
1050     if ( $input{'type'} eq 'pnm' ) {
1051       $self->{IMG}=i_readpnm_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed
1052       if ( !defined($self->{IMG}) ) {
1053         $self->{ERRSTR}='unable to read pnm image: '._error_as_msg(); return undef;
1054       }
1055       $self->{DEBUG} && print "loading a pnm file\n";
1056       return $self;
1057     }
1058
1059     if ( $input{'type'} eq 'png' ) {
1060       $self->{IMG}=i_readpng_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed
1061       if ( !defined($self->{IMG}) ) {
1062         $self->{ERRSTR}='unable to read png image';
1063         return undef;
1064       }
1065       $self->{DEBUG} && print "loading a png file\n";
1066     }
1067
1068     if ( $input{'type'} eq 'bmp' ) {
1069       $self->{IMG}=i_readbmp_wiol( $IO );
1070       if ( !defined($self->{IMG}) ) {
1071         $self->{ERRSTR}=$self->_error_as_msg();
1072         return undef;
1073       }
1074       $self->{DEBUG} && print "loading a bmp file\n";
1075     }
1076
1077     if ( $input{'type'} eq 'gif' ) {
1078       if ($input{colors} && !ref($input{colors})) {
1079         # must be a reference to a scalar that accepts the colour map
1080         $self->{ERRSTR} = "option 'colors' must be a scalar reference";
1081         return undef;
1082       }
1083       if ($input{colors}) {
1084         my $colors;
1085         ($self->{IMG}, $colors) =i_readgif_wiol( $IO );
1086         if ($colors) {
1087           ${ $input{colors} } = [ map { NC(@$_) } @$colors ];
1088         }
1089       }
1090       else {
1091         $self->{IMG} =i_readgif_wiol( $IO );
1092       }
1093       if ( !defined($self->{IMG}) ) {
1094         $self->{ERRSTR}=$self->_error_as_msg();
1095         return undef;
1096       }
1097       $self->{DEBUG} && print "loading a gif file\n";
1098     }
1099
1100     if ( $input{'type'} eq 'tga' ) {
1101       $self->{IMG}=i_readtga_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed
1102       if ( !defined($self->{IMG}) ) {
1103         $self->{ERRSTR}=$self->_error_as_msg();
1104         return undef;
1105       }
1106       $self->{DEBUG} && print "loading a tga file\n";
1107     }
1108
1109     if ( $input{'type'} eq 'rgb' ) {
1110       $self->{IMG}=i_readrgb_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed
1111       if ( !defined($self->{IMG}) ) {
1112         $self->{ERRSTR}=$self->_error_as_msg();
1113         return undef;
1114       }
1115       $self->{DEBUG} && print "loading a tga file\n";
1116     }
1117
1118
1119     if ( $input{'type'} eq 'raw' ) {
1120       my %params=(datachannels=>3,storechannels=>3,interleave=>1,%input);
1121
1122       if ( !($params{xsize} && $params{ysize}) ) {
1123         $self->{ERRSTR}='missing xsize or ysize parameter for raw';
1124         return undef;
1125       }
1126
1127       $self->{IMG} = i_readraw_wiol( $IO,
1128                                      $params{xsize},
1129                                      $params{ysize},
1130                                      $params{datachannels},
1131                                      $params{storechannels},
1132                                      $params{interleave});
1133       if ( !defined($self->{IMG}) ) {
1134         $self->{ERRSTR}='unable to read raw image';
1135         return undef;
1136       }
1137       $self->{DEBUG} && print "loading a raw file\n";
1138     }
1139
1140   } else {
1141
1142     # Old code for reference while changing the new stuff
1143
1144     if (!$input{'type'} and $input{file}) {
1145       $input{'type'}=$FORMATGUESS->($input{file});
1146     }
1147
1148     if (!$input{'type'}) {
1149       $self->{ERRSTR}='type parameter missing and not possible to guess from extension'; return undef;
1150     }
1151
1152     if (!$formats{$input{'type'}}) {
1153       $self->{ERRSTR}='format not supported';
1154       return undef;
1155     }
1156
1157     my ($fh, $fd);
1158     if ($input{file}) {
1159       $fh = new IO::File($input{file},"r");
1160       if (!defined $fh) {
1161         $self->{ERRSTR}='Could not open file';
1162         return undef;
1163       }
1164       binmode($fh);
1165       $fd = $fh->fileno();
1166     }
1167
1168     if ($input{fd}) {
1169       $fd=$input{fd};
1170     }
1171
1172     if ( $input{'type'} eq 'gif' ) {
1173       my $colors;
1174       if ($input{colors} && !ref($input{colors})) {
1175         # must be a reference to a scalar that accepts the colour map
1176         $self->{ERRSTR} = "option 'colors' must be a scalar reference";
1177         return undef;
1178       }
1179       if (exists $input{data}) {
1180         if ($input{colors}) {
1181           ($self->{IMG}, $colors) = i_readgif_scalar($input{data});
1182         } else {
1183           $self->{IMG}=i_readgif_scalar($input{data});
1184         }
1185       } else {
1186         if ($input{colors}) {
1187           ($self->{IMG}, $colors) = i_readgif( $fd );
1188         } else {
1189           $self->{IMG} = i_readgif( $fd )
1190         }
1191       }
1192       if ($colors) {
1193         # we may or may not change i_readgif to return blessed objects...
1194         ${ $input{colors} } = [ map { NC(@$_) } @$colors ];
1195       }
1196       if ( !defined($self->{IMG}) ) {
1197         $self->{ERRSTR}= 'reading GIF:'._error_as_msg();
1198         return undef;
1199       }
1200       $self->{DEBUG} && print "loading a gif file\n";
1201     }
1202   }
1203   return $self;
1204 }
1205
1206 sub _fix_gif_positions {
1207   my ($opts, $opt, $msg, @imgs) = @_;
1208   
1209   my $positions = $opts->{'gif_positions'};
1210   my $index = 0;
1211   for my $pos (@$positions) {
1212     my ($x, $y) = @$pos;
1213     my $img = $imgs[$index++];
1214     $img->settag(name=>'gif_left', value=>$x);
1215     $img->settag(name=>'gif_top', value=>$y) if defined $y;
1216   }
1217   $$msg .= "replaced with the gif_left and gif_top tags";
1218 }
1219
1220 my %obsolete_opts =
1221   (
1222    gif_each_palette=>'gif_local_map',
1223    interlace       => 'gif_interlace',
1224    gif_delays => 'gif_delay',
1225    gif_positions => \&_fix_gif_positions,
1226    gif_loop_count => 'gif_loop',
1227   );
1228
1229 sub _set_opts {
1230   my ($self, $opts, $prefix, @imgs) = @_;
1231
1232   for my $opt (keys %$opts) {
1233     my $tagname = $opt;
1234     if ($obsolete_opts{$opt}) {
1235       my $new = $obsolete_opts{$opt};
1236       my $msg = "Obsolete option $opt ";
1237       if (ref $new) {
1238         $new->($opts, $opt, \$msg, @imgs);
1239       }
1240       else {
1241         $msg .= "replaced with the $new tag ";
1242         $tagname = $new;
1243       }
1244       $msg .= "line ".(caller(2))[2]." of file ".(caller(2))[1];
1245       warn $msg if $warn_obsolete && $^W;
1246     }
1247     next unless $tagname =~ /^\Q$prefix/;
1248     my $value = $opts->{$opt};
1249     if (ref $value) {
1250       if (UNIVERSAL::isa($value, "Imager::Color")) {
1251         my $tag = sprintf("color(%d,%d,%d,%d)", $value->rgba);
1252         for my $img (@imgs) {
1253           $img->settag(name=>$tagname, value=>$tag);
1254         }
1255       }
1256       elsif (ref($value) eq 'ARRAY') {
1257         for my $i (0..$#$value) {
1258           my $val = $value->[$i];
1259           if (ref $val) {
1260             if (UNIVERSAL::isa($val, "Imager::Color")) {
1261               my $tag = sprintf("color(%d,%d,%d,%d)", $value->rgba);
1262               $i < @imgs and
1263                 $imgs[$i]->settag(name=>$tagname, value=>$tag);
1264             }
1265             else {
1266               $self->_set_error("Unknown reference type " . ref($value) . 
1267                                 " supplied in array for $opt");
1268               return;
1269             }
1270           }
1271           else {
1272             $i < @imgs
1273               and $imgs[$i]->settag(name=>$tagname, value=>$val);
1274           }
1275         }
1276       }
1277       else {
1278         $self->_set_error("Unknown reference type " . ref($value) . 
1279                           " supplied for $opt");
1280         return;
1281       }
1282     }
1283     else {
1284       # set it as a tag for every image
1285       for my $img (@imgs) {
1286         $img->settag(name=>$tagname, value=>$value);
1287       }
1288     }
1289   }
1290
1291   return 1;
1292 }
1293
1294 # Write an image to file
1295 sub write {
1296   my $self = shift;
1297   my %input=(jpegquality=>75, 
1298              gifquant=>'mc', 
1299              lmdither=>6.0, 
1300              lmfixed=>[],
1301              idstring=>"",
1302              compress=>1,
1303              wierdpack=>0,
1304              fax_fine=>1, @_);
1305   my $rc;
1306
1307   $self->_set_opts(\%input, "i_", $self)
1308     or return undef;
1309
1310   my %iolready=( tiff=>1, raw=>1, png=>1, pnm=>1, bmp=>1, jpeg=>1, tga=>1, 
1311                  gif=>1 ); # this will be SO MUCH BETTER once they are all in there
1312
1313   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1314
1315   if (!$input{'type'} and $input{file}) { 
1316     $input{'type'}=$FORMATGUESS->($input{file});
1317   }
1318   if (!$input{'type'}) { 
1319     $self->{ERRSTR}='type parameter missing and not possible to guess from extension';
1320     return undef;
1321   }
1322
1323   if (!$formats{$input{'type'}}) { $self->{ERRSTR}='format not supported'; return undef; }
1324
1325   my ($IO, $fh) = $self->_get_writer_io(\%input, $input{'type'})
1326     or return undef;
1327
1328   # this conditional is probably obsolete
1329   if ($iolready{$input{'type'}}) {
1330
1331     if ($input{'type'} eq 'tiff') {
1332       $self->_set_opts(\%input, "tiff_", $self)
1333         or return undef;
1334       $self->_set_opts(\%input, "exif_", $self)
1335         or return undef;
1336
1337       if (defined $input{class} && $input{class} eq 'fax') {
1338         if (!i_writetiff_wiol_faxable($self->{IMG}, $IO, $input{fax_fine})) {
1339           $self->{ERRSTR}='Could not write to buffer';
1340           return undef;
1341         }
1342       } else {
1343         if (!i_writetiff_wiol($self->{IMG}, $IO)) {
1344           $self->{ERRSTR}='Could not write to buffer';
1345           return undef;
1346         }
1347       }
1348     } elsif ( $input{'type'} eq 'pnm' ) {
1349       $self->_set_opts(\%input, "pnm_", $self)
1350         or return undef;
1351       if ( ! i_writeppm_wiol($self->{IMG},$IO) ) {
1352         $self->{ERRSTR}='unable to write pnm image';
1353         return undef;
1354       }
1355       $self->{DEBUG} && print "writing a pnm file\n";
1356     } elsif ( $input{'type'} eq 'raw' ) {
1357       $self->_set_opts(\%input, "raw_", $self)
1358         or return undef;
1359       if ( !i_writeraw_wiol($self->{IMG},$IO) ) {
1360         $self->{ERRSTR}='unable to write raw image';
1361         return undef;
1362       }
1363       $self->{DEBUG} && print "writing a raw file\n";
1364     } elsif ( $input{'type'} eq 'png' ) {
1365       $self->_set_opts(\%input, "png_", $self)
1366         or return undef;
1367       if ( !i_writepng_wiol($self->{IMG}, $IO) ) {
1368         $self->{ERRSTR}='unable to write png image';
1369         return undef;
1370       }
1371       $self->{DEBUG} && print "writing a png file\n";
1372     } elsif ( $input{'type'} eq 'jpeg' ) {
1373       $self->_set_opts(\%input, "jpeg_", $self)
1374         or return undef;
1375       $self->_set_opts(\%input, "exif_", $self)
1376         or return undef;
1377       if ( !i_writejpeg_wiol($self->{IMG}, $IO, $input{jpegquality})) {
1378         $self->{ERRSTR} = $self->_error_as_msg();
1379         return undef;
1380       }
1381       $self->{DEBUG} && print "writing a jpeg file\n";
1382     } elsif ( $input{'type'} eq 'bmp' ) {
1383       $self->_set_opts(\%input, "bmp_", $self)
1384         or return undef;
1385       if ( !i_writebmp_wiol($self->{IMG}, $IO) ) {
1386         $self->{ERRSTR}='unable to write bmp image';
1387         return undef;
1388       }
1389       $self->{DEBUG} && print "writing a bmp file\n";
1390     } elsif ( $input{'type'} eq 'tga' ) {
1391       $self->_set_opts(\%input, "tga_", $self)
1392         or return undef;
1393
1394       if ( !i_writetga_wiol($self->{IMG}, $IO, $input{wierdpack}, $input{compress}, $input{idstring}) ) {
1395         $self->{ERRSTR}=$self->_error_as_msg();
1396         return undef;
1397       }
1398       $self->{DEBUG} && print "writing a tga file\n";
1399     } elsif ( $input{'type'} eq 'gif' ) {
1400       $self->_set_opts(\%input, "gif_", $self)
1401         or return undef;
1402       # compatibility with the old interfaces
1403       if ($input{gifquant} eq 'lm') {
1404         $input{make_colors} = 'addi';
1405         $input{translate} = 'perturb';
1406         $input{perturb} = $input{lmdither};
1407       } elsif ($input{gifquant} eq 'gen') {
1408         # just pass options through
1409       } else {
1410         $input{make_colors} = 'webmap'; # ignored
1411         $input{translate} = 'giflib';
1412       }
1413       $rc = i_writegif_wiol($IO, \%input, $self->{IMG});
1414     }
1415
1416     if (exists $input{'data'}) {
1417       my $data = io_slurp($IO);
1418       if (!$data) {
1419         $self->{ERRSTR}='Could not slurp from buffer';
1420         return undef;
1421       }
1422       ${$input{data}} = $data;
1423     }
1424     return $self;
1425   }
1426
1427   return $self;
1428 }
1429
1430 sub write_multi {
1431   my ($class, $opts, @images) = @_;
1432
1433   if (!$opts->{'type'} && $opts->{'file'}) {
1434     $opts->{'type'} = $FORMATGUESS->($opts->{'file'});
1435   }
1436   unless ($opts->{'type'}) {
1437     $class->_set_error('type parameter missing and not possible to guess from extension');
1438     return;
1439   }
1440   # translate to ImgRaw
1441   if (grep !UNIVERSAL::isa($_, 'Imager') || !$_->{IMG}, @images) {
1442     $class->_set_error('Usage: Imager->write_multi({ options }, @images)');
1443     return 0;
1444   }
1445   $class->_set_opts($opts, "i_", @images)
1446     or return;
1447   my @work = map $_->{IMG}, @images;
1448   my ($IO, $file) = $class->_get_writer_io($opts, $opts->{'type'})
1449     or return undef;
1450   if ($opts->{'type'} eq 'gif') {
1451     $class->_set_opts($opts, "gif_", @images)
1452       or return;
1453     my $gif_delays = $opts->{gif_delays};
1454     local $opts->{gif_delays} = $gif_delays;
1455     if ($opts->{gif_delays} && !ref $opts->{gif_delays}) {
1456       # assume the caller wants the same delay for each frame
1457       $opts->{gif_delays} = [ ($gif_delays) x @images ];
1458     }
1459     my $res = i_writegif_wiol($IO, $opts, @work);
1460     $res or $class->_set_error($class->_error_as_msg());
1461     return $res;
1462   }
1463   elsif ($opts->{'type'} eq 'tiff') {
1464     $class->_set_opts($opts, "tiff_", @images)
1465       or return;
1466     $class->_set_opts($opts, "exif_", @images)
1467       or return;
1468     my $res;
1469     $opts->{fax_fine} = 1 unless exists $opts->{fax_fine};
1470     if ($opts->{'class'} && $opts->{'class'} eq 'fax') {
1471       $res = i_writetiff_multi_wiol_faxable($IO, $opts->{fax_fine}, @work);
1472     }
1473     else {
1474       $res = i_writetiff_multi_wiol($IO, @work);
1475     }
1476     $res or $class->_set_error($class->_error_as_msg());
1477     return $res;
1478   }
1479   else {
1480     $ERRSTR = "Sorry, write_multi doesn't support $opts->{'type'} yet";
1481     return 0;
1482   }
1483 }
1484
1485 # read multiple images from a file
1486 sub read_multi {
1487   my ($class, %opts) = @_;
1488
1489   if ($opts{file} && !exists $opts{'type'}) {
1490     # guess the type 
1491     my $type = $FORMATGUESS->($opts{file});
1492     $opts{'type'} = $type;
1493   }
1494   unless ($opts{'type'}) {
1495     $ERRSTR = "No type parameter supplied and it couldn't be guessed";
1496     return;
1497   }
1498
1499   my ($IO, $file) = $class->_get_reader_io(\%opts, $opts{'type'})
1500     or return;
1501   if ($opts{'type'} eq 'gif') {
1502     my @imgs;
1503     @imgs = i_readgif_multi_wiol($IO);
1504     if (@imgs) {
1505       return map { 
1506         bless { IMG=>$_, DEBUG=>$DEBUG, ERRSTR=>undef }, 'Imager' 
1507       } @imgs;
1508     }
1509     else {
1510       $ERRSTR = _error_as_msg();
1511       return;
1512     }
1513   }
1514   elsif ($opts{'type'} eq 'tiff') {
1515     my @imgs = i_readtiff_multi_wiol($IO, -1);
1516     if (@imgs) {
1517       return map { 
1518         bless { IMG=>$_, DEBUG=>$DEBUG, ERRSTR=>undef }, 'Imager' 
1519       } @imgs;
1520     }
1521     else {
1522       $ERRSTR = _error_as_msg();
1523       return;
1524     }
1525   }
1526
1527   $ERRSTR = "Cannot read multiple images from $opts{'type'} files";
1528   return;
1529 }
1530
1531 # Destroy an Imager object
1532
1533 sub DESTROY {
1534   my $self=shift;
1535   #    delete $instances{$self};
1536   if (defined($self->{IMG})) {
1537     # the following is now handled by the XS DESTROY method for
1538     # Imager::ImgRaw object
1539     # Re-enabling this will break virtual images
1540     # tested for in t/t020masked.t
1541     # i_img_destroy($self->{IMG});
1542     undef($self->{IMG});
1543   } else {
1544 #    print "Destroy Called on an empty image!\n"; # why did I put this here??
1545   }
1546 }
1547
1548 # Perform an inplace filter of an image
1549 # that is the image will be overwritten with the data
1550
1551 sub filter {
1552   my $self=shift;
1553   my %input=@_;
1554   my %hsh;
1555   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1556
1557   if (!$input{'type'}) { $self->{ERRSTR}='type parameter missing'; return undef; }
1558
1559   if ( (grep { $_ eq $input{'type'} } keys %filters) != 1) {
1560     $self->{ERRSTR}='type parameter not matching any filter'; return undef;
1561   }
1562
1563   if ($filters{$input{'type'}}{names}) {
1564     my $names = $filters{$input{'type'}}{names};
1565     for my $name (keys %$names) {
1566       if (defined $input{$name} && exists $names->{$name}{$input{$name}}) {
1567         $input{$name} = $names->{$name}{$input{$name}};
1568       }
1569     }
1570   }
1571   if (defined($filters{$input{'type'}}{defaults})) {
1572     %hsh=('image',$self->{IMG},%{$filters{$input{'type'}}{defaults}},%input);
1573   } else {
1574     %hsh=('image',$self->{IMG},%input);
1575   }
1576
1577   my @cs=@{$filters{$input{'type'}}{callseq}};
1578
1579   for(@cs) {
1580     if (!defined($hsh{$_})) {
1581       $self->{ERRSTR}="missing parameter '$_' for filter ".$input{'type'}; return undef;
1582     }
1583   }
1584
1585   &{$filters{$input{'type'}}{callsub}}(%hsh);
1586
1587   my @b=keys %hsh;
1588
1589   $self->{DEBUG} && print "callseq is: @cs\n";
1590   $self->{DEBUG} && print "matching callseq is: @b\n";
1591
1592   return $self;
1593 }
1594
1595 # Scale an image to requested size and return the scaled version
1596
1597 sub scale {
1598   my $self=shift;
1599   my %opts=(scalefactor=>0.5,'type'=>'max',qtype=>'normal',@_);
1600   my $img = Imager->new();
1601   my $tmp = Imager->new();
1602
1603   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1604
1605   if ($opts{xpixels} and $opts{ypixels} and $opts{'type'}) {
1606     my ($xpix,$ypix)=( $opts{xpixels}/$self->getwidth() , $opts{ypixels}/$self->getheight() );
1607     if ($opts{'type'} eq 'min') { $opts{scalefactor}=min($xpix,$ypix); }
1608     if ($opts{'type'} eq 'max') { $opts{scalefactor}=max($xpix,$ypix); }
1609   } elsif ($opts{xpixels}) { $opts{scalefactor}=$opts{xpixels}/$self->getwidth(); }
1610   elsif ($opts{ypixels}) { $opts{scalefactor}=$opts{ypixels}/$self->getheight(); }
1611
1612   if ($opts{qtype} eq 'normal') {
1613     $tmp->{IMG}=i_scaleaxis($self->{IMG},$opts{scalefactor},0);
1614     if ( !defined($tmp->{IMG}) ) { $self->{ERRSTR}='unable to scale image'; return undef; }
1615     $img->{IMG}=i_scaleaxis($tmp->{IMG},$opts{scalefactor},1);
1616     if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='unable to scale image'; return undef; }
1617     return $img;
1618   }
1619   if ($opts{'qtype'} eq 'preview') {
1620     $img->{IMG}=i_scale_nn($self->{IMG},$opts{'scalefactor'},$opts{'scalefactor'}); 
1621     if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='unable to scale image'; return undef; }
1622     return $img;
1623   }
1624   $self->{ERRSTR}='scale: invalid value for qtype'; return undef;
1625 }
1626
1627 # Scales only along the X axis
1628
1629 sub scaleX {
1630   my $self=shift;
1631   my %opts=(scalefactor=>0.5,@_);
1632
1633   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1634
1635   my $img = Imager->new();
1636
1637   if ($opts{pixels}) { $opts{scalefactor}=$opts{pixels}/$self->getwidth(); }
1638
1639   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1640   $img->{IMG}=i_scaleaxis($self->{IMG},$opts{scalefactor},0);
1641
1642   if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='unable to scale image'; return undef; }
1643   return $img;
1644 }
1645
1646 # Scales only along the Y axis
1647
1648 sub scaleY {
1649   my $self=shift;
1650   my %opts=(scalefactor=>0.5,@_);
1651
1652   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1653
1654   my $img = Imager->new();
1655
1656   if ($opts{pixels}) { $opts{scalefactor}=$opts{pixels}/$self->getheight(); }
1657
1658   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1659   $img->{IMG}=i_scaleaxis($self->{IMG},$opts{scalefactor},1);
1660
1661   if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='unable to scale image'; return undef; }
1662   return $img;
1663 }
1664
1665
1666 # Transform returns a spatial transformation of the input image
1667 # this moves pixels to a new location in the returned image.
1668 # NOTE - should make a utility function to check transforms for
1669 # stack overruns
1670
1671 sub transform {
1672   my $self=shift;
1673   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1674   my %opts=@_;
1675   my (@op,@ropx,@ropy,$iop,$or,@parm,$expr,@xt,@yt,@pt,$numre);
1676
1677 #  print Dumper(\%opts);
1678 #  xopcopdes
1679
1680   if ( $opts{'xexpr'} and $opts{'yexpr'} ) {
1681     if (!$I2P) {
1682       eval ("use Affix::Infix2Postfix;");
1683       print $@;
1684       if ( $@ ) {
1685         $self->{ERRSTR}='transform: expr given and Affix::Infix2Postfix is not avaliable.'; 
1686         return undef;
1687       }
1688       $I2P=Affix::Infix2Postfix->new('ops'=>[{op=>'+',trans=>'Add'},
1689                                              {op=>'-',trans=>'Sub'},
1690                                              {op=>'*',trans=>'Mult'},
1691                                              {op=>'/',trans=>'Div'},
1692                                              {op=>'-','type'=>'unary',trans=>'u-'},
1693                                              {op=>'**'},
1694                                              {op=>'func','type'=>'unary'}],
1695                                      'grouping'=>[qw( \( \) )],
1696                                      'func'=>[qw( sin cos )],
1697                                      'vars'=>[qw( x y )]
1698                                     );
1699     }
1700
1701     @xt=$I2P->translate($opts{'xexpr'});
1702     @yt=$I2P->translate($opts{'yexpr'});
1703
1704     $numre=$I2P->{'numre'};
1705     @pt=(0,0);
1706
1707     for(@xt) { if (/$numre/) { push(@pt,$_); push(@{$opts{'xopcodes'}},'Parm',$#pt); } else { push(@{$opts{'xopcodes'}},$_); } }
1708     for(@yt) { if (/$numre/) { push(@pt,$_); push(@{$opts{'yopcodes'}},'Parm',$#pt); } else { push(@{$opts{'yopcodes'}},$_); } }
1709     @{$opts{'parm'}}=@pt;
1710   }
1711
1712 #  print Dumper(\%opts);
1713
1714   if ( !exists $opts{'xopcodes'} or @{$opts{'xopcodes'}}==0) {
1715     $self->{ERRSTR}='transform: no xopcodes given.';
1716     return undef;
1717   }
1718
1719   @op=@{$opts{'xopcodes'}};
1720   for $iop (@op) { 
1721     if (!defined ($OPCODES{$iop}) and ($iop !~ /^\d+$/) ) {
1722       $self->{ERRSTR}="transform: illegal opcode '$_'.";
1723       return undef;
1724     }
1725     push(@ropx,(exists $OPCODES{$iop}) ? @{$OPCODES{$iop}} : $iop );
1726   }
1727
1728
1729 # yopcopdes
1730
1731   if ( !exists $opts{'yopcodes'} or @{$opts{'yopcodes'}}==0) {
1732     $self->{ERRSTR}='transform: no yopcodes given.';
1733     return undef;
1734   }
1735
1736   @op=@{$opts{'yopcodes'}};
1737   for $iop (@op) { 
1738     if (!defined ($OPCODES{$iop}) and ($iop !~ /^\d+$/) ) {
1739       $self->{ERRSTR}="transform: illegal opcode '$_'.";
1740       return undef;
1741     }
1742     push(@ropy,(exists $OPCODES{$iop}) ? @{$OPCODES{$iop}} : $iop );
1743   }
1744
1745 #parameters
1746
1747   if ( !exists $opts{'parm'}) {
1748     $self->{ERRSTR}='transform: no parameter arg given.';
1749     return undef;
1750   }
1751
1752 #  print Dumper(\@ropx);
1753 #  print Dumper(\@ropy);
1754 #  print Dumper(\@ropy);
1755
1756   my $img = Imager->new();
1757   $img->{IMG}=i_transform($self->{IMG},\@ropx,\@ropy,$opts{'parm'});
1758   if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='transform: failed'; return undef; }
1759   return $img;
1760 }
1761
1762
1763 sub transform2 {
1764   my ($opts, @imgs) = @_;
1765   
1766   require "Imager/Expr.pm";
1767
1768   $opts->{variables} = [ qw(x y) ];
1769   my ($width, $height) = @{$opts}{qw(width height)};
1770   if (@imgs) {
1771     $width ||= $imgs[0]->getwidth();
1772     $height ||= $imgs[0]->getheight();
1773     my $img_num = 1;
1774     for my $img (@imgs) {
1775       $opts->{constants}{"w$img_num"} = $img->getwidth();
1776       $opts->{constants}{"h$img_num"} = $img->getheight();
1777       $opts->{constants}{"cx$img_num"} = $img->getwidth()/2;
1778       $opts->{constants}{"cy$img_num"} = $img->getheight()/2;
1779       ++$img_num;
1780     }
1781   }
1782   if ($width) {
1783     $opts->{constants}{w} = $width;
1784     $opts->{constants}{cx} = $width/2;
1785   }
1786   else {
1787     $Imager::ERRSTR = "No width supplied";
1788     return;
1789   }
1790   if ($height) {
1791     $opts->{constants}{h} = $height;
1792     $opts->{constants}{cy} = $height/2;
1793   }
1794   else {
1795     $Imager::ERRSTR = "No height supplied";
1796     return;
1797   }
1798   my $code = Imager::Expr->new($opts);
1799   if (!$code) {
1800     $Imager::ERRSTR = Imager::Expr::error();
1801     return;
1802   }
1803
1804   my $img = Imager->new();
1805   $img->{IMG} = i_transform2($opts->{width}, $opts->{height}, $code->code(),
1806                              $code->nregs(), $code->cregs(),
1807                              [ map { $_->{IMG} } @imgs ]);
1808   if (!defined $img->{IMG}) {
1809     $Imager::ERRSTR = Imager->_error_as_msg();
1810     return;
1811   }
1812
1813   return $img;
1814 }
1815
1816 sub rubthrough {
1817   my $self=shift;
1818   my %opts=(tx=>0,ty=>0,@_);
1819
1820   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1821   unless ($opts{src} && $opts{src}->{IMG}) { $self->{ERRSTR}='empty input image for source'; return undef; }
1822
1823   unless (i_rubthru($self->{IMG}, $opts{src}->{IMG}, $opts{tx},$opts{ty})) {
1824     $self->{ERRSTR} = $self->_error_as_msg();
1825     return undef;
1826   }
1827   return $self;
1828 }
1829
1830
1831 sub flip {
1832   my $self  = shift;
1833   my %opts  = @_;
1834   my %xlate = (h=>0, v=>1, hv=>2, vh=>2);
1835   my $dir;
1836   return () unless defined $opts{'dir'} and defined $xlate{$opts{'dir'}};
1837   $dir = $xlate{$opts{'dir'}};
1838   return $self if i_flipxy($self->{IMG}, $dir);
1839   return ();
1840 }
1841
1842 sub rotate {
1843   my $self = shift;
1844   my %opts = @_;
1845   if (defined $opts{right}) {
1846     my $degrees = $opts{right};
1847     if ($degrees < 0) {
1848       $degrees += 360 * int(((-$degrees)+360)/360);
1849     }
1850     $degrees = $degrees % 360;
1851     if ($degrees == 0) {
1852       return $self->copy();
1853     }
1854     elsif ($degrees == 90 || $degrees == 180 || $degrees == 270) {
1855       my $result = Imager->new();
1856       if ($result->{IMG} = i_rotate90($self->{IMG}, $degrees)) {
1857         return $result;
1858       }
1859       else {
1860         $self->{ERRSTR} = $self->_error_as_msg();
1861         return undef;
1862       }
1863     }
1864     else {
1865       $self->{ERRSTR} = "Parameter 'right' must be a multiple of 90 degrees";
1866       return undef;
1867     }
1868   }
1869   elsif (defined $opts{radians} || defined $opts{degrees}) {
1870     my $amount = $opts{radians} || $opts{degrees} * 3.1415926535 / 180;
1871
1872     my $result = Imager->new;
1873     if ($result->{IMG} = i_rotate_exact($self->{IMG}, $amount)) {
1874       return $result;
1875     }
1876     else {
1877       $self->{ERRSTR} = $self->_error_as_msg();
1878       return undef;
1879     }
1880   }
1881   else {
1882     $self->{ERRSTR} = "Only the 'right' parameter is available";
1883     return undef;
1884   }
1885 }
1886
1887 sub matrix_transform {
1888   my $self = shift;
1889   my %opts = @_;
1890
1891   if ($opts{matrix}) {
1892     my $xsize = $opts{xsize} || $self->getwidth;
1893     my $ysize = $opts{ysize} || $self->getheight;
1894
1895     my $result = Imager->new;
1896     $result->{IMG} = i_matrix_transform($self->{IMG}, $xsize, $ysize, 
1897                                         $opts{matrix})
1898       or return undef;
1899
1900     return $result;
1901   }
1902   else {
1903     $self->{ERRSTR} = "matrix parameter required";
1904     return undef;
1905   }
1906 }
1907
1908 # blame Leolo :)
1909 *yatf = \&matrix_transform;
1910
1911 # These two are supported for legacy code only
1912
1913 sub i_color_new {
1914   return Imager::Color->new(@_);
1915 }
1916
1917 sub i_color_set {
1918   return Imager::Color::set(@_);
1919 }
1920
1921 # Draws a box between the specified corner points.
1922 sub box {
1923   my $self=shift;
1924   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1925   my $dflcl=i_color_new(255,255,255,255);
1926   my %opts=(color=>$dflcl,xmin=>0,ymin=>0,xmax=>$self->getwidth()-1,ymax=>$self->getheight()-1,@_);
1927
1928   if (exists $opts{'box'}) { 
1929     $opts{'xmin'} = min($opts{'box'}->[0],$opts{'box'}->[2]);
1930     $opts{'xmax'} = max($opts{'box'}->[0],$opts{'box'}->[2]);
1931     $opts{'ymin'} = min($opts{'box'}->[1],$opts{'box'}->[3]);
1932     $opts{'ymax'} = max($opts{'box'}->[1],$opts{'box'}->[3]);
1933   }
1934
1935   if ($opts{filled}) { 
1936     my $color = _color($opts{'color'});
1937     unless ($color) { 
1938       $self->{ERRSTR} = $Imager::ERRSTR; 
1939       return; 
1940     }
1941     i_box_filled($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},
1942                  $opts{ymax}, $color); 
1943   }
1944   elsif ($opts{fill}) {
1945     unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
1946       # assume it's a hash ref
1947       require 'Imager/Fill.pm';
1948       unless ($opts{fill} = Imager::Fill->new(%{$opts{fill}})) {
1949         $self->{ERRSTR} = $Imager::ERRSTR;
1950         return undef;
1951       }
1952     }
1953     i_box_cfill($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},
1954                 $opts{ymax},$opts{fill}{fill});
1955   }
1956   else {
1957     my $color = _color($opts{'color'});
1958     unless ($color) { 
1959       $self->{ERRSTR} = $Imager::ERRSTR;
1960       return;
1961     }
1962     i_box($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},$opts{ymax},
1963           $color);
1964   }
1965   return $self;
1966 }
1967
1968 # Draws an arc - this routine SUCKS and is buggy - it sometimes doesn't work when the arc is a convex polygon
1969
1970 sub arc {
1971   my $self=shift;
1972   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1973   my $dflcl=i_color_new(255,255,255,255);
1974   my %opts=(color=>$dflcl,
1975             'r'=>min($self->getwidth(),$self->getheight())/3,
1976             'x'=>$self->getwidth()/2,
1977             'y'=>$self->getheight()/2,
1978             'd1'=>0, 'd2'=>361, @_);
1979   if ($opts{fill}) {
1980     unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
1981       # assume it's a hash ref
1982       require 'Imager/Fill.pm';
1983       unless ($opts{fill} = Imager::Fill->new(%{$opts{fill}})) {
1984         $self->{ERRSTR} = $Imager::ERRSTR;
1985         return;
1986       }
1987     }
1988     i_arc_cfill($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},$opts{'d1'},
1989                 $opts{'d2'}, $opts{fill}{fill});
1990   }
1991   else {
1992     my $color = _color($opts{'color'});
1993     unless ($color) { 
1994       $self->{ERRSTR} = $Imager::ERRSTR; 
1995       return; 
1996     }
1997     if ($opts{d1} == 0 && $opts{d2} == 361 && $opts{aa}) {
1998       i_circle_aa($self->{IMG}, $opts{'x'}, $opts{'y'}, $opts{'r'}, 
1999                   $color);
2000     }
2001     else {
2002       if ($opts{'d1'} <= $opts{'d2'}) { 
2003         i_arc($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},
2004               $opts{'d1'}, $opts{'d2'}, $color); 
2005       }
2006       else {
2007         i_arc($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},
2008               $opts{'d1'}, 361,         $color);
2009         i_arc($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},
2010               0,           $opts{'d2'}, $color); 
2011       }
2012     }
2013   }
2014
2015   return $self;
2016 }
2017
2018 # Draws a line from one point to the other
2019 # the endpoint is set if the endp parameter is set which it is by default.
2020 # to turn of the endpoint being set use endp=>0 when calling line.
2021
2022 sub line {
2023   my $self=shift;
2024   my $dflcl=i_color_new(0,0,0,0);
2025   my %opts=(color=>$dflcl,
2026             endp => 1,
2027             @_);
2028   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2029
2030   unless (exists $opts{x1} and exists $opts{y1}) { $self->{ERRSTR}='missing begining coord'; return undef; }
2031   unless (exists $opts{x2} and exists $opts{y2}) { $self->{ERRSTR}='missing ending coord'; return undef; }
2032
2033   my $color = _color($opts{'color'});
2034   unless ($color) {
2035     $self->{ERRSTR} = $Imager::ERRSTR;
2036     return;
2037   }
2038
2039   $opts{antialias} = $opts{aa} if defined $opts{aa};
2040   if ($opts{antialias}) {
2041     i_line_aa($self->{IMG},$opts{x1}, $opts{y1}, $opts{x2}, $opts{y2},
2042               $color, $opts{endp});
2043   } else {
2044     i_line($self->{IMG},$opts{x1}, $opts{y1}, $opts{x2}, $opts{y2},
2045            $color, $opts{endp});
2046   }
2047   return $self;
2048 }
2049
2050 # Draws a line between an ordered set of points - It more or less just transforms this
2051 # into a list of lines.
2052
2053 sub polyline {
2054   my $self=shift;
2055   my ($pt,$ls,@points);
2056   my $dflcl=i_color_new(0,0,0,0);
2057   my %opts=(color=>$dflcl,@_);
2058
2059   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2060
2061   if (exists($opts{points})) { @points=@{$opts{points}}; }
2062   if (!exists($opts{points}) and exists($opts{'x'}) and exists($opts{'y'}) ) {
2063     @points=map { [ $opts{'x'}->[$_],$opts{'y'}->[$_] ] } (0..(scalar @{$opts{'x'}}-1));
2064     }
2065
2066 #  print Dumper(\@points);
2067
2068   my $color = _color($opts{'color'});
2069   unless ($color) { 
2070     $self->{ERRSTR} = $Imager::ERRSTR; 
2071     return; 
2072   }
2073   $opts{antialias} = $opts{aa} if defined $opts{aa};
2074   if ($opts{antialias}) {
2075     for $pt(@points) {
2076       if (defined($ls)) { 
2077         i_line_aa($self->{IMG},$ls->[0],$ls->[1],$pt->[0],$pt->[1],$color, 1);
2078       }
2079       $ls=$pt;
2080     }
2081   } else {
2082     for $pt(@points) {
2083       if (defined($ls)) { 
2084         i_line($self->{IMG},$ls->[0],$ls->[1],$pt->[0],$pt->[1],$color,1);
2085       }
2086       $ls=$pt;
2087     }
2088   }
2089   return $self;
2090 }
2091
2092 sub polygon {
2093   my $self = shift;
2094   my ($pt,$ls,@points);
2095   my $dflcl = i_color_new(0,0,0,0);
2096   my %opts = (color=>$dflcl, @_);
2097
2098   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2099
2100   if (exists($opts{points})) {
2101     $opts{'x'} = [ map { $_->[0] } @{$opts{points}} ];
2102     $opts{'y'} = [ map { $_->[1] } @{$opts{points}} ];
2103   }
2104
2105   if (!exists $opts{'x'} or !exists $opts{'y'})  {
2106     $self->{ERRSTR} = 'no points array, or x and y arrays.'; return undef;
2107   }
2108
2109   if ($opts{'fill'}) {
2110     unless (UNIVERSAL::isa($opts{'fill'}, 'Imager::Fill')) {
2111       # assume it's a hash ref
2112       require 'Imager/Fill.pm';
2113       unless ($opts{'fill'} = Imager::Fill->new(%{$opts{'fill'}})) {
2114         $self->{ERRSTR} = $Imager::ERRSTR;
2115         return undef;
2116       }
2117     }
2118     i_poly_aa_cfill($self->{IMG}, $opts{'x'}, $opts{'y'}, 
2119                     $opts{'fill'}{'fill'});
2120   }
2121   else {
2122     my $color = _color($opts{'color'});
2123     unless ($color) { 
2124       $self->{ERRSTR} = $Imager::ERRSTR; 
2125       return; 
2126     }
2127     i_poly_aa($self->{IMG}, $opts{'x'}, $opts{'y'}, $color);
2128   }
2129
2130   return $self;
2131 }
2132
2133
2134 # this the multipoint bezier curve
2135 # this is here more for testing that actual usage since
2136 # this is not a good algorithm.  Usually the curve would be
2137 # broken into smaller segments and each done individually.
2138
2139 sub polybezier {
2140   my $self=shift;
2141   my ($pt,$ls,@points);
2142   my $dflcl=i_color_new(0,0,0,0);
2143   my %opts=(color=>$dflcl,@_);
2144
2145   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2146
2147   if (exists $opts{points}) {
2148     $opts{'x'}=map { $_->[0]; } @{$opts{'points'}};
2149     $opts{'y'}=map { $_->[1]; } @{$opts{'points'}};
2150   }
2151
2152   unless ( @{$opts{'x'}} and @{$opts{'x'}} == @{$opts{'y'}} ) {
2153     $self->{ERRSTR}='Missing or invalid points.';
2154     return;
2155   }
2156
2157   my $color = _color($opts{'color'});
2158   unless ($color) { 
2159     $self->{ERRSTR} = $Imager::ERRSTR; 
2160     return; 
2161   }
2162   i_bezier_multi($self->{IMG},$opts{'x'},$opts{'y'},$color);
2163   return $self;
2164 }
2165
2166 sub flood_fill {
2167   my $self = shift;
2168   my %opts = ( color=>Imager::Color->new(255, 255, 255), @_ );
2169   my $rc;
2170
2171   unless (exists $opts{'x'} && exists $opts{'y'}) {
2172     $self->{ERRSTR} = "missing seed x and y parameters";
2173     return undef;
2174   }
2175
2176   if ($opts{fill}) {
2177     unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
2178       # assume it's a hash ref
2179       require 'Imager/Fill.pm';
2180       unless ($opts{fill} = Imager::Fill->new(%{$opts{fill}})) {
2181         $self->{ERRSTR} = $Imager::ERRSTR;
2182         return;
2183       }
2184     }
2185     $rc = i_flood_cfill($self->{IMG}, $opts{'x'}, $opts{'y'}, $opts{fill}{fill});
2186   }
2187   else {
2188     my $color = _color($opts{'color'});
2189     unless ($color) {
2190       $self->{ERRSTR} = $Imager::ERRSTR;
2191       return;
2192     }
2193     $rc = i_flood_fill($self->{IMG}, $opts{'x'}, $opts{'y'}, $color);
2194   }
2195   if ($rc) { $self; } else { $self->{ERRSTR} = $self->_error_as_msg(); return (); }
2196 }
2197
2198 sub setpixel {
2199   my $self = shift;
2200
2201   my %opts = ( color=>$self->{fg} || NC(255, 255, 255), @_);
2202
2203   unless (exists $opts{'x'} && exists $opts{'y'}) {
2204     $self->{ERRSTR} = 'missing x and y parameters';
2205     return undef;
2206   }
2207
2208   my $x = $opts{'x'};
2209   my $y = $opts{'y'};
2210   my $color = _color($opts{color})
2211     or return undef;
2212   if (ref $x && ref $y) {
2213     unless (@$x == @$y) {
2214       $self->{ERRSTR} = 'length of x and y mismatch';
2215       return undef;
2216     }
2217     if ($color->isa('Imager::Color')) {
2218       for my $i (0..$#{$opts{'x'}}) {
2219         i_ppix($self->{IMG}, $x->[$i], $y->[$i], $color);
2220       }
2221     }
2222     else {
2223       for my $i (0..$#{$opts{'x'}}) {
2224         i_ppixf($self->{IMG}, $x->[$i], $y->[$i], $color);
2225       }
2226     }
2227   }
2228   else {
2229     if ($color->isa('Imager::Color')) {
2230       i_ppix($self->{IMG}, $x, $y, $color);
2231     }
2232     else {
2233       i_ppixf($self->{IMG}, $x, $y, $color);
2234     }
2235   }
2236
2237   $self;
2238 }
2239
2240 sub getpixel {
2241   my $self = shift;
2242
2243   my %opts = ( "type"=>'8bit', @_);
2244
2245   unless (exists $opts{'x'} && exists $opts{'y'}) {
2246     $self->{ERRSTR} = 'missing x and y parameters';
2247     return undef;
2248   }
2249
2250   my $x = $opts{'x'};
2251   my $y = $opts{'y'};
2252   if (ref $x && ref $y) {
2253     unless (@$x == @$y) {
2254       $self->{ERRSTR} = 'length of x and y mismatch';
2255       return undef;
2256     }
2257     my @result;
2258     if ($opts{"type"} eq '8bit') {
2259       for my $i (0..$#{$opts{'x'}}) {
2260         push(@result, i_get_pixel($self->{IMG}, $x->[$i], $y->[$i]));
2261       }
2262     }
2263     else {
2264       for my $i (0..$#{$opts{'x'}}) {
2265         push(@result, i_gpixf($self->{IMG}, $x->[$i], $y->[$i]));
2266       }
2267     }
2268     return wantarray ? @result : \@result;
2269   }
2270   else {
2271     if ($opts{"type"} eq '8bit') {
2272       return i_get_pixel($self->{IMG}, $x, $y);
2273     }
2274     else {
2275       return i_gpixf($self->{IMG}, $x, $y);
2276     }
2277   }
2278
2279   $self;
2280 }
2281
2282 # make an identity matrix of the given size
2283 sub _identity {
2284   my ($size) = @_;
2285
2286   my $matrix = [ map { [ (0) x $size ] } 1..$size ];
2287   for my $c (0 .. ($size-1)) {
2288     $matrix->[$c][$c] = 1;
2289   }
2290   return $matrix;
2291 }
2292
2293 # general function to convert an image
2294 sub convert {
2295   my ($self, %opts) = @_;
2296   my $matrix;
2297
2298   # the user can either specify a matrix or preset
2299   # the matrix overrides the preset
2300   if (!exists($opts{matrix})) {
2301     unless (exists($opts{preset})) {
2302       $self->{ERRSTR} = "convert() needs a matrix or preset";
2303       return;
2304     }
2305     else {
2306       if ($opts{preset} eq 'gray' || $opts{preset} eq 'grey') {
2307         # convert to greyscale, keeping the alpha channel if any
2308         if ($self->getchannels == 3) {
2309           $matrix = [ [ 0.222, 0.707, 0.071 ] ];
2310         }
2311         elsif ($self->getchannels == 4) {
2312           # preserve the alpha channel
2313           $matrix = [ [ 0.222, 0.707, 0.071, 0 ],
2314                       [ 0,     0,     0,     1 ] ];
2315         }
2316         else {
2317           # an identity
2318           $matrix = _identity($self->getchannels);
2319         }
2320       }
2321       elsif ($opts{preset} eq 'noalpha') {
2322         # strip the alpha channel
2323         if ($self->getchannels == 2 or $self->getchannels == 4) {
2324           $matrix = _identity($self->getchannels);
2325           pop(@$matrix); # lose the alpha entry
2326         }
2327         else {
2328           $matrix = _identity($self->getchannels);
2329         }
2330       }
2331       elsif ($opts{preset} eq 'red' || $opts{preset} eq 'channel0') {
2332         # extract channel 0
2333         $matrix = [ [ 1 ] ];
2334       }
2335       elsif ($opts{preset} eq 'green' || $opts{preset} eq 'channel1') {
2336         $matrix = [ [ 0, 1 ] ];
2337       }
2338       elsif ($opts{preset} eq 'blue' || $opts{preset} eq 'channel2') {
2339         $matrix = [ [ 0, 0, 1 ] ];
2340       }
2341       elsif ($opts{preset} eq 'alpha') {
2342         if ($self->getchannels == 2 or $self->getchannels == 4) {
2343           $matrix = [ [ (0) x ($self->getchannels-1), 1 ] ];
2344         }
2345         else {
2346           # the alpha is just 1 <shrug>
2347           $matrix = [ [ (0) x $self->getchannels, 1 ] ];
2348         }
2349       }
2350       elsif ($opts{preset} eq 'rgb') {
2351         if ($self->getchannels == 1) {
2352           $matrix = [ [ 1 ], [ 1 ], [ 1 ] ];
2353         }
2354         elsif ($self->getchannels == 2) {
2355           # preserve the alpha channel
2356           $matrix = [ [ 1, 0 ], [ 1, 0 ], [ 1, 0 ], [ 0, 1 ] ];
2357         }
2358         else {
2359           $matrix = _identity($self->getchannels);
2360         }
2361       }
2362       elsif ($opts{preset} eq 'addalpha') {
2363         if ($self->getchannels == 1) {
2364           $matrix = _identity(2);
2365         }
2366         elsif ($self->getchannels == 3) {
2367           $matrix = _identity(4);
2368         }
2369         else {
2370           $matrix = _identity($self->getchannels);
2371         }
2372       }
2373       else {
2374         $self->{ERRSTR} = "Unknown convert preset $opts{preset}";
2375         return undef;
2376       }
2377     }
2378   }
2379   else {
2380     $matrix = $opts{matrix};
2381   }
2382
2383   my $new = Imager->new();
2384   $new->{IMG} = i_img_new();
2385   unless (i_convert($new->{IMG}, $self->{IMG}, $matrix)) {
2386     # most likely a bad matrix
2387     $self->{ERRSTR} = _error_as_msg();
2388     return undef;
2389   }
2390   return $new;
2391 }
2392
2393
2394 # general function to map an image through lookup tables
2395
2396 sub map {
2397   my ($self, %opts) = @_;
2398   my @chlist = qw( red green blue alpha );
2399
2400   if (!exists($opts{'maps'})) {
2401     # make maps from channel maps
2402     my $chnum;
2403     for $chnum (0..$#chlist) {
2404       if (exists $opts{$chlist[$chnum]}) {
2405         $opts{'maps'}[$chnum] = $opts{$chlist[$chnum]};
2406       } elsif (exists $opts{'all'}) {
2407         $opts{'maps'}[$chnum] = $opts{'all'};
2408       }
2409     }
2410   }
2411   if ($opts{'maps'} and $self->{IMG}) {
2412     i_map($self->{IMG}, $opts{'maps'} );
2413   }
2414   return $self;
2415 }
2416
2417 sub difference {
2418   my ($self, %opts) = @_;
2419
2420   defined $opts{mindist} or $opts{mindist} = 0;
2421
2422   defined $opts{other}
2423     or return $self->_set_error("No 'other' parameter supplied");
2424   defined $opts{other}{IMG}
2425     or return $self->_set_error("No image data in 'other' image");
2426
2427   $self->{IMG}
2428     or return $self->_set_error("No image data");
2429
2430   my $result = Imager->new;
2431   $result->{IMG} = i_diff_image($self->{IMG}, $opts{other}{IMG}, 
2432                                 $opts{mindist})
2433     or return $self->_set_error($self->_error_as_msg());
2434
2435   return $result;
2436 }
2437
2438 # destructive border - image is shrunk by one pixel all around
2439
2440 sub border {
2441   my ($self,%opts)=@_;
2442   my($tx,$ty)=($self->getwidth()-1,$self->getheight()-1);
2443   $self->polyline('x'=>[0,$tx,$tx,0,0],'y'=>[0,0,$ty,$ty,0],%opts);
2444 }
2445
2446
2447 # Get the width of an image
2448
2449 sub getwidth {
2450   my $self = shift;
2451   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
2452   return (i_img_info($self->{IMG}))[0];
2453 }
2454
2455 # Get the height of an image
2456
2457 sub getheight {
2458   my $self = shift;
2459   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
2460   return (i_img_info($self->{IMG}))[1];
2461 }
2462
2463 # Get number of channels in an image
2464
2465 sub getchannels {
2466   my $self = shift;
2467   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
2468   return i_img_getchannels($self->{IMG});
2469 }
2470
2471 # Get channel mask
2472
2473 sub getmask {
2474   my $self = shift;
2475   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
2476   return i_img_getmask($self->{IMG});
2477 }
2478
2479 # Set channel mask
2480
2481 sub setmask {
2482   my $self = shift;
2483   my %opts = @_;
2484   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
2485   i_img_setmask( $self->{IMG} , $opts{mask} );
2486 }
2487
2488 # Get number of colors in an image
2489
2490 sub getcolorcount {
2491   my $self=shift;
2492   my %opts=('maxcolors'=>2**30,@_);
2493   if (!defined($self->{IMG})) { $self->{ERRSTR}='image is empty'; return undef; }
2494   my $rc=i_count_colors($self->{IMG},$opts{'maxcolors'});
2495   return ($rc==-1? undef : $rc);
2496 }
2497
2498 # draw string to an image
2499
2500 sub string {
2501   my $self = shift;
2502   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2503
2504   my %input=('x'=>0, 'y'=>0, @_);
2505   $input{string}||=$input{text};
2506
2507   unless(exists $input{string}) {
2508     $self->{ERRSTR}="missing required parameter 'string'";
2509     return;
2510   }
2511
2512   unless($input{font}) {
2513     $self->{ERRSTR}="missing required parameter 'font'";
2514     return;
2515   }
2516
2517   unless ($input{font}->draw(image=>$self, %input)) {
2518     $self->{ERRSTR} = $self->_error_as_msg();
2519     return;
2520   }
2521
2522   return $self;
2523 }
2524
2525 # Shortcuts that can be exported
2526
2527 sub newcolor { Imager::Color->new(@_); }
2528 sub newfont  { Imager::Font->new(@_); }
2529
2530 *NC=*newcolour=*newcolor;
2531 *NF=*newfont;
2532
2533 *open=\&read;
2534 *circle=\&arc;
2535
2536
2537 #### Utility routines
2538
2539 sub errstr { 
2540   ref $_[0] ? $_[0]->{ERRSTR} : $ERRSTR
2541 }
2542
2543 sub _set_error {
2544   my ($self, $msg) = @_;
2545
2546   if (ref $self) {
2547     $self->{ERRSTR} = $msg;
2548   }
2549   else {
2550     $ERRSTR = $msg;
2551   }
2552   return;
2553 }
2554
2555 # Default guess for the type of an image from extension
2556
2557 sub def_guess_type {
2558   my $name=lc(shift);
2559   my $ext;
2560   $ext=($name =~ m/\.([^\.]+)$/)[0];
2561   return 'tiff' if ($ext =~ m/^tiff?$/);
2562   return 'jpeg' if ($ext =~ m/^jpe?g$/);
2563   return 'pnm'  if ($ext =~ m/^p[pgb]m$/);
2564   return 'png'  if ($ext eq "png");
2565   return 'bmp'  if ($ext eq "bmp" || $ext eq "dib");
2566   return 'tga'  if ($ext eq "tga");
2567   return 'rgb'  if ($ext eq "rgb");
2568   return 'gif'  if ($ext eq "gif");
2569   return 'raw'  if ($ext eq "raw");
2570   return ();
2571 }
2572
2573 # get the minimum of a list
2574
2575 sub min {
2576   my $mx=shift;
2577   for(@_) { if ($_<$mx) { $mx=$_; }}
2578   return $mx;
2579 }
2580
2581 # get the maximum of a list
2582
2583 sub max {
2584   my $mx=shift;
2585   for(@_) { if ($_>$mx) { $mx=$_; }}
2586   return $mx;
2587 }
2588
2589 # string stuff for iptc headers
2590
2591 sub clean {
2592   my($str)=$_[0];
2593   $str = substr($str,3);
2594   $str =~ s/[\n\r]//g;
2595   $str =~ s/\s+/ /g;
2596   $str =~ s/^\s//;
2597   $str =~ s/\s$//;
2598   return $str;
2599 }
2600
2601 # A little hack to parse iptc headers.
2602
2603 sub parseiptc {
2604   my $self=shift;
2605   my(@sar,$item,@ar);
2606   my($caption,$photogr,$headln,$credit);
2607
2608   my $str=$self->{IPTCRAW};
2609
2610   #print $str;
2611
2612   @ar=split(/8BIM/,$str);
2613
2614   my $i=0;
2615   foreach (@ar) {
2616     if (/^\004\004/) {
2617       @sar=split(/\034\002/);
2618       foreach $item (@sar) {
2619         if ($item =~ m/^x/) {
2620           $caption=&clean($item);
2621           $i++;
2622         }
2623         if ($item =~ m/^P/) {
2624           $photogr=&clean($item);
2625           $i++;
2626         }
2627         if ($item =~ m/^i/) {
2628           $headln=&clean($item);
2629           $i++;
2630         }
2631         if ($item =~ m/^n/) {
2632           $credit=&clean($item);
2633           $i++;
2634         }
2635       }
2636     }
2637   }
2638   return (caption=>$caption,photogr=>$photogr,headln=>$headln,credit=>$credit);
2639 }
2640
2641 # Autoload methods go after =cut, and are processed by the autosplit program.
2642
2643 1;
2644 __END__
2645 # Below is the stub of documentation for your module. You better edit it!
2646
2647 =head1 NAME
2648
2649 Imager - Perl extension for Generating 24 bit Images
2650
2651 =head1 SYNOPSIS
2652
2653   # Thumbnail example
2654
2655   #!/usr/bin/perl -w
2656   use strict;
2657   use Imager;
2658
2659   die "Usage: thumbmake.pl filename\n" if !-f $ARGV[0];
2660   my $file = shift;
2661
2662   my $format;
2663
2664   my $img = Imager->new();
2665   $img->open(file=>$file) or die $img->errstr();
2666
2667   $file =~ s/\.[^.]*$//;
2668
2669   # Create smaller version
2670   my $thumb = $img->scale(scalefactor=>.3);
2671
2672   # Autostretch individual channels
2673   $thumb->filter(type=>'autolevels');
2674
2675   # try to save in one of these formats
2676   SAVE:
2677
2678   for $format ( qw( png gif jpg tiff ppm ) ) {
2679     # Check if given format is supported
2680     if ($Imager::formats{$format}) {
2681       $file.="_low.$format";
2682       print "Storing image as: $file\n";
2683       $thumb->write(file=>$file) or
2684         die $thumb->errstr;
2685       last SAVE;
2686     }
2687   }
2688
2689
2690
2691
2692 =head1 DESCRIPTION
2693
2694 Imager is a module for creating and altering images.  It can read and
2695 write various image formats, draw primitive shapes like lines,and
2696 polygons, blend multiple images together in various ways, scale, crop,
2697 render text and more.
2698
2699 =head2 Overview of documentation
2700
2701 =over
2702
2703 =item Imager
2704
2705 This document - Synopsis Example, Table of Contents and Overview.
2706
2707 =item Imager::ImageTypes
2708
2709 Basics of constructing image objects with C<new()>:
2710 Direct type/virtual images, RGB(A)/paletted images, 8/16/double
2711 bits/channel, color maps, channel masks, image tags, color
2712 quantization.  Also discusses basic image information methods.
2713
2714 =item Imager::Files
2715
2716 IO interaction, reading/writing images, format specific tags.
2717
2718 =item Imager::Draw
2719
2720 Drawing Primitives, lines, boxes, circles, arcs, flood fill.
2721
2722 =item Imager::Color
2723
2724 Color specification.
2725
2726 =item Imager::Fill
2727
2728 Fill pattern specification.
2729
2730 =item Imager::Font
2731
2732 General font rendering, bounding boxes and font metrics.
2733
2734 =item Imager::Transformations
2735
2736 Copying, scaling, cropping, flipping, blending, pasting, convert and
2737 map.
2738
2739 =item Imager::Engines
2740
2741 Programmable transformations through C<transform()>, C<transform2()>
2742 and C<matrix_transform()>.
2743
2744 =item Imager::Filters
2745
2746 Filters, sharpen, blur, noise, convolve etc. and filter plugins.
2747
2748 =item Imager::Expr
2749
2750 Expressions for evaluation engine used by transform2().
2751
2752 =item Imager::Matrix2d
2753
2754 Helper class for affine transformations.
2755
2756 =item Imager::Fountain
2757
2758 Helper for making gradient profiles.
2759
2760 =back
2761
2762
2763
2764 =head2 Basic Overview
2765
2766 An Image object is created with C<$img = Imager-E<gt>new()>.
2767 Examples:
2768
2769   $img=Imager->new();                         # create empty image
2770   $img->open(file=>'lena.png',type=>'png') or # read image from file
2771      die $img->errstr();                      # give an explanation
2772                                               # if something failed
2773
2774 or if you want to create an empty image:
2775
2776   $img=Imager->new(xsize=>400,ysize=>300,channels=>4);
2777
2778 This example creates a completely black image of width 400 and height
2779 300 and 4 channels.
2780
2781 When an operation fails which can be directly associated with an image
2782 the error message is stored can be retrieved with
2783 C<$img-E<gt>errstr()>.
2784
2785 In cases where no image object is associated with an operation
2786 C<$Imager::ERRSTR> is used to report errors not directly associated
2787 with an image object.
2788
2789 The C<Imager-><gt>new> method is described in detail in the 
2790 Imager::ImageTypes manpage.
2791
2792 =head1 SUPPORT
2793
2794 You can ask for help, report bugs or express your undying love for
2795 Imager on the Imager-devel mailing list.
2796
2797 To subscribe send a message with C<subscribe> in the body to:
2798
2799    imager-devel+request@molar.is
2800
2801 or use the form at:
2802
2803    http://www.molar.is/en/lists/imager-devel/
2804    (annonymous is temporarily off due to spam)
2805
2806 where you can also find the mailing list archive.
2807
2808 If you're into IRC, you can typically find the developers in #Imager
2809 on irc.rhizomatic.net.  As with any IRC channel, the participants
2810 could be occupied or asleep, so please be patient.
2811
2812 =head1 BUGS
2813
2814 Bugs are listed individually for relevant pod pages.
2815
2816 =head1 AUTHOR
2817
2818 Arnar M. Hrafnkelsson (addi@imager.perl.org) and Tony Cook
2819 (tony@imager.perl.org) See the README for a complete list.
2820
2821 =head1 SEE ALSO
2822
2823 perl(1), Imager::ImageTypes(3), Imager::Files(3), Imager::Draw(3),
2824 Imager::Color(3), Imager::Fill(3), Imager::Font(3),
2825 Imager::Transformations(3), Imager::Engines(3), Imager::Filters(3),
2826 Imager::Expr(3), Imager::Matrix2d(3), Imager::Fountain(3)
2827
2828 Affix::Infix2Postfix(3), Parse::RecDescent(3)
2829 http://www.eecs.umich.edu/~addi/perl/Imager/
2830
2831 =cut
2832
2833
2834
2835