added POD to trans2.c
[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);
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_draw
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
48                 i_copyto
49                 i_rubthru
50                 i_scaleaxis
51                 i_scale_nn
52                 i_haar
53                 i_count_colors
54
55                 i_gaussian
56                 i_conv
57
58                 i_convert
59                 i_map
60
61                 i_img_diff
62
63                 i_init_fonts
64                 i_t1_new
65                 i_t1_destroy
66                 i_t1_set_aa
67                 i_t1_cp
68                 i_t1_text
69                 i_t1_bbox
70
71                 i_tt_set_aa
72                 i_tt_cp
73                 i_tt_text
74                 i_tt_bbox
75
76                 i_readjpeg_wiol
77                 i_writejpeg_wiol
78
79                 i_readtiff_wiol
80                 i_writetiff_wiol
81                 i_writetiff_wiol_faxable
82
83                 i_readpng_wiol
84                 i_writepng_wiol
85
86                 i_readgif
87                 i_readgif_callback
88                 i_writegif
89                 i_writegifmc
90                 i_writegif_gen
91                 i_writegif_callback
92
93                 i_readpnm_wiol
94                 i_writeppm_wiol
95
96                 i_readraw_wiol
97                 i_writeraw_wiol
98
99                 i_contrast
100                 i_hardinvert
101                 i_noise
102                 i_bumpmap
103                 i_postlevels
104                 i_mosaic
105                 i_watermark
106
107                 malloc_state
108
109                 list_formats
110
111                 i_gifquant
112
113                 newfont
114                 newcolor
115                 newcolour
116                 NC
117                 NF
118 );
119
120 @EXPORT=qw( 
121            init_log
122            i_list_formats
123            i_has_format
124            malloc_state
125            i_color_new
126
127            i_img_empty
128            i_img_empty_ch
129           );
130
131 %EXPORT_TAGS=
132   (handy => [qw(
133                 newfont
134                 newcolor
135                 NF
136                 NC
137                )],
138    all => [@EXPORT_OK],
139    default => [qw(
140                   load_plugin
141                   unload_plugin
142                  )]);
143
144 BEGIN {
145   require Exporter;
146   require DynaLoader;
147
148   $VERSION = '0.39pre1';
149   @ISA = qw(Exporter DynaLoader);
150   bootstrap Imager $VERSION;
151 }
152
153 BEGIN {
154   i_init_fonts(); # Initialize font engines
155   Imager::Font::__init();
156   for(i_list_formats()) { $formats{$_}++; }
157
158   if ($formats{'t1'}) {
159     i_t1_set_aa(1);
160   }
161
162   if (!$formats{'t1'} and !$formats{'tt'} 
163       && !$formats{'ft2'} && !$formats{'w32'}) {
164     $fontstate='no font support';
165   }
166
167   %OPCODES=(Add=>[0],Sub=>[1],Mult=>[2],Div=>[3],Parm=>[4],'sin'=>[5],'cos'=>[6],'x'=>[4,0],'y'=>[4,1]);
168
169   $DEBUG=0;
170
171   # the members of the subhashes under %filters are:
172   #  callseq - a list of the parameters to the underlying filter in the
173   #            order they are passed
174   #  callsub - a code ref that takes a named parameter list and calls the
175   #            underlying filter
176   #  defaults - a hash of default values
177   #  names - defines names for value of given parameters so if the names 
178   #          field is foo=> { bar=>1 }, and the user supplies "bar" as the
179   #          foo parameter, the filter will receive 1 for the foo
180   #          parameter
181   $filters{contrast}={
182                       callseq => ['image','intensity'],
183                       callsub => sub { my %hsh=@_; i_contrast($hsh{image},$hsh{intensity}); } 
184                      };
185
186   $filters{noise} ={
187                     callseq => ['image', 'amount', 'subtype'],
188                     defaults => { amount=>3,subtype=>0 },
189                     callsub => sub { my %hsh=@_; i_noise($hsh{image},$hsh{amount},$hsh{subtype}); }
190                    };
191
192   $filters{hardinvert} ={
193                          callseq => ['image'],
194                          defaults => { },
195                          callsub => sub { my %hsh=@_; i_hardinvert($hsh{image}); }
196                         };
197
198   $filters{autolevels} ={
199                          callseq => ['image','lsat','usat','skew'],
200                          defaults => { lsat=>0.1,usat=>0.1,skew=>0.0 },
201                          callsub => sub { my %hsh=@_; i_autolevels($hsh{image},$hsh{lsat},$hsh{usat},$hsh{skew}); }
202                         };
203
204   $filters{turbnoise} ={
205                         callseq => ['image'],
206                         defaults => { xo=>0.0,yo=>0.0,scale=>10.0 },
207                         callsub => sub { my %hsh=@_; i_turbnoise($hsh{image},$hsh{xo},$hsh{yo},$hsh{scale}); }
208                        };
209
210   $filters{radnoise} ={
211                        callseq => ['image'],
212                        defaults => { xo=>100,yo=>100,ascale=>17.0,rscale=>0.02 },
213                        callsub => sub { my %hsh=@_; i_radnoise($hsh{image},$hsh{xo},$hsh{yo},$hsh{rscale},$hsh{ascale}); }
214                       };
215
216   $filters{conv} ={
217                        callseq => ['image', 'coef'],
218                        defaults => { },
219                        callsub => sub { my %hsh=@_; i_conv($hsh{image},$hsh{coef}); }
220                       };
221
222   $filters{gradgen} ={
223                        callseq => ['image', 'xo', 'yo', 'colors', 'dist'],
224                        defaults => { },
225                        callsub => sub { my %hsh=@_; i_gradgen($hsh{image}, $hsh{xo}, $hsh{yo}, $hsh{colors}, $hsh{dist}); }
226                       };
227
228   $filters{nearest_color} ={
229                             callseq => ['image', 'xo', 'yo', 'colors', 'dist'],
230                             defaults => { },
231                             callsub => sub { my %hsh=@_; i_nearest_color($hsh{image}, $hsh{xo}, $hsh{yo}, $hsh{colors}, $hsh{dist}); }
232                            };
233   $filters{gaussian} = {
234                         callseq => [ 'image', 'stddev' ],
235                         defaults => { },
236                         callsub => sub { my %hsh = @_; i_gaussian($hsh{image}, $hsh{stddev}); },
237                        };
238   $filters{mosaic} =
239     {
240      callseq => [ qw(image size) ],
241      defaults => { size => 20 },
242      callsub => sub { my %hsh = @_; i_mosaic($hsh{image}, $hsh{size}) },
243     };
244   $filters{bumpmap} =
245     {
246      callseq => [ qw(image bump elevation lightx lighty st) ],
247      defaults => { elevation=>0, st=> 2 },
248      callsub => sub {
249        my %hsh = @_;
250        i_bumpmap($hsh{image}, $hsh{bump}{IMG}, $hsh{elevation},
251                  $hsh{lightx}, $hsh{lighty}, $hsh{st});
252      },
253     };
254   $filters{bumpmap_complex} =
255     {
256      callseq => [ qw(image bump channel tx ty Lx Ly Lz cd cs n Ia Il Is) ],
257      defaults => {
258                   channel => 0,
259                   tx => 0,
260                   ty => 0,
261                   Lx => 0.2,
262                   Ly => 0.4,
263                   Lz => -1.0,
264                   cd => 1.0,
265                   cs => 40,
266                   n => 1.3,
267                   Ia => Imager::Color->new(rgb=>[0,0,0]),
268                   Il => Imager::Color->new(rgb=>[255,255,255]),
269                   Is => Imager::Color->new(rgb=>[255,255,255]),
270                  },
271      callsub => sub {
272        my %hsh = @_;
273        i_bumpmap_complex($hsh{image}, $hsh{bump}{IMG}, $hsh{channel},
274                  $hsh{tx}, $hsh{ty}, $hsh{Lx}, $hsh{Ly}, $hsh{Lz},
275                  $hsh{cd}, $hsh{cs}, $hsh{n}, $hsh{Ia}, $hsh{Il},
276                  $hsh{Is});
277      },
278     };
279   $filters{postlevels} =
280     {
281      callseq  => [ qw(image levels) ],
282      defaults => { levels => 10 },
283      callsub  => sub { my %hsh = @_; i_postlevels($hsh{image}, $hsh{levels}); },
284     };
285   $filters{watermark} =
286     {
287      callseq  => [ qw(image wmark tx ty pixdiff) ],
288      defaults => { pixdiff=>10, tx=>0, ty=>0 },
289      callsub  => 
290      sub { 
291        my %hsh = @_; 
292        i_watermark($hsh{image}, $hsh{wmark}{IMG}, $hsh{tx}, $hsh{ty}, 
293                    $hsh{pixdiff}); 
294      },
295     };
296   $filters{fountain} =
297     {
298      callseq  => [ qw(image xa ya xb yb ftype repeat combine super_sample ssample_param segments) ],
299      names    => {
300                   ftype => { linear         => 0,
301                              bilinear       => 1,
302                              radial         => 2,
303                              radial_square  => 3,
304                              revolution     => 4,
305                              conical        => 5 },
306                   repeat => { none      => 0,
307                               sawtooth  => 1,
308                               triangle  => 2,
309                               saw_both  => 3,
310                               tri_both  => 4,
311                             },
312                   super_sample => {
313                                    none    => 0,
314                                    grid    => 1,
315                                    random  => 2,
316                                    circle  => 3,
317                                   },
318                   combine => {
319                               none      => 0,
320                               normal    => 1,
321                               multiply  => 2, mult => 2,
322                               dissolve  => 3,
323                               add       => 4,
324                               subtract  => 5, sub => 5,
325                               diff      => 6,
326                               lighten   => 7,
327                               darken    => 8,
328                               hue       => 9,
329                               sat       => 10,
330                               value     => 11,
331                               color     => 12,
332                              },
333                  },
334      defaults => { ftype => 0, repeat => 0, combine => 0,
335                    super_sample => 0, ssample_param => 4,
336                    segments=>[ 
337                               [ 0, 0.5, 1,
338                                 Imager::Color->new(0,0,0),
339                                 Imager::Color->new(255, 255, 255),
340                                 0, 0,
341                               ],
342                              ],
343                  },
344      callsub  => 
345      sub {
346        my %hsh = @_;
347        i_fountain($hsh{image}, $hsh{xa}, $hsh{ya}, $hsh{xb}, $hsh{yb},
348                   $hsh{ftype}, $hsh{repeat}, $hsh{combine}, $hsh{super_sample},
349                   $hsh{ssample_param}, $hsh{segments});
350      },
351     };
352   $filters{unsharpmask} =
353     {
354      callseq => [ qw(image stddev scale) ],
355      defaults => { stddev=>2.0, scale=>1.0 },
356      callsub => 
357      sub { 
358        my %hsh = @_;
359        i_unsharp_mask($hsh{image}, $hsh{stddev}, $hsh{scale});
360      },
361     };
362
363   $FORMATGUESS=\&def_guess_type;
364 }
365
366 #
367 # Non methods
368 #
369
370 # initlize Imager
371 # NOTE: this might be moved to an import override later on
372
373 #sub import {
374 #  my $pack = shift;
375 #  (look through @_ for special tags, process, and remove them);   
376 #  use Data::Dumper;
377 #  print Dumper($pack);
378 #  print Dumper(@_);
379 #}
380
381 sub init {
382   my %parms=(loglevel=>1,@_);
383   if ($parms{'log'}) {
384     init_log($parms{'log'},$parms{'loglevel'});
385   }
386
387 #    if ($parms{T1LIB_CONFIG}) { $ENV{T1LIB_CONFIG}=$parms{T1LIB_CONFIG}; }
388 #    if ( $ENV{T1LIB_CONFIG} and ( $fontstate eq 'missing conf' )) {
389 #       i_init_fonts();
390 #       $fontstate='ok';
391 #    }
392 }
393
394 END {
395   if ($DEBUG) {
396     print "shutdown code\n";
397     #   for(keys %instances) { $instances{$_}->DESTROY(); }
398     malloc_state(); # how do decide if this should be used? -- store something from the import
399     print "Imager exiting\n";
400   }
401 }
402
403 # Load a filter plugin 
404
405 sub load_plugin {
406   my ($filename)=@_;
407   my $i;
408   my ($DSO_handle,$str)=DSO_open($filename);
409   if (!defined($DSO_handle)) { $Imager::ERRSTR="Couldn't load plugin '$filename'\n"; return undef; }
410   my %funcs=DSO_funclist($DSO_handle);
411   if ($DEBUG) { print "loading module $filename\n"; $i=0; for(keys %funcs) { printf("  %2d: %s\n",$i++,$_); } }
412   $i=0;
413   for(keys %funcs) { if ($filters{$_}) { $ERRSTR="filter '$_' already exists\n"; DSO_close($DSO_handle); return undef; } }
414
415   $DSOs{$filename}=[$DSO_handle,\%funcs];
416
417   for(keys %funcs) { 
418     my $evstr="\$filters{'".$_."'}={".$funcs{$_}.'};';
419     $DEBUG && print "eval string:\n",$evstr,"\n";
420     eval $evstr;
421     print $@ if $@;
422   }
423   return 1;
424 }
425
426 # Unload a plugin
427
428 sub unload_plugin {
429   my ($filename)=@_;
430
431   if (!$DSOs{$filename}) { $ERRSTR="plugin '$filename' not loaded."; return undef; }
432   my ($DSO_handle,$funcref)=@{$DSOs{$filename}};
433   for(keys %{$funcref}) {
434     delete $filters{$_};
435     $DEBUG && print "unloading: $_\n";
436   }
437   my $rc=DSO_close($DSO_handle);
438   if (!defined($rc)) { $ERRSTR="unable to unload plugin '$filename'."; return undef; }
439   return 1;
440 }
441
442 # take the results of i_error() and make a message out of it
443 sub _error_as_msg {
444   return join(": ", map $_->[0], i_errors());
445 }
446
447 #
448 # Methods to be called on objects.
449 #
450
451 # Create a new Imager object takes very few parameters.
452 # usually you call this method and then call open from
453 # the resulting object
454
455 sub new {
456   my $class = shift;
457   my $self ={};
458   my %hsh=@_;
459   bless $self,$class;
460   $self->{IMG}=undef;    # Just to indicate what exists
461   $self->{ERRSTR}=undef; #
462   $self->{DEBUG}=$DEBUG;
463   $self->{DEBUG} && print "Initialized Imager\n";
464   if ($hsh{xsize} && $hsh{ysize}) { $self->img_set(%hsh); }
465   return $self;
466 }
467
468 # Copy an entire image with no changes 
469 # - if an image has magic the copy of it will not be magical
470
471 sub copy {
472   my $self = shift;
473   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
474
475   my $newcopy=Imager->new();
476   $newcopy->{IMG}=i_img_new();
477   i_copy($newcopy->{IMG},$self->{IMG});
478   return $newcopy;
479 }
480
481 # Paste a region
482
483 sub paste {
484   my $self = shift;
485   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
486   my %input=(left=>0, top=>0, @_);
487   unless($input{img}) {
488     $self->{ERRSTR}="no source image";
489     return;
490   }
491   $input{left}=0 if $input{left} <= 0;
492   $input{top}=0 if $input{top} <= 0;
493   my $src=$input{img};
494   my($r,$b)=i_img_info($src->{IMG});
495
496   i_copyto($self->{IMG}, $src->{IMG}, 
497            0,0, $r, $b, $input{left}, $input{top});
498   return $self;  # What should go here??
499 }
500
501 # Crop an image - i.e. return a new image that is smaller
502
503 sub crop {
504   my $self=shift;
505   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
506   my %hsh=(left=>0,right=>0,top=>0,bottom=>0,@_);
507
508   my ($w,$h,$l,$r,$b,$t)=($self->getwidth(),$self->getheight(),
509                                 @hsh{qw(left right bottom top)});
510   $l=0 if not defined $l;
511   $t=0 if not defined $t;
512
513   $r||=$l+delete $hsh{'width'}    if defined $l and exists $hsh{'width'};
514   $b||=$t+delete $hsh{'height'}   if defined $t and exists $hsh{'height'};
515   $l||=$r-delete $hsh{'width'}    if defined $r and exists $hsh{'width'};
516   $t||=$b-delete $hsh{'height'}   if defined $b and exists $hsh{'height'};
517
518   $r=$self->getwidth if not defined $r;
519   $b=$self->getheight if not defined $b;
520
521   ($l,$r)=($r,$l) if $l>$r;
522   ($t,$b)=($b,$t) if $t>$b;
523
524   if ($hsh{'width'}) {
525     $l=int(0.5+($w-$hsh{'width'})/2);
526     $r=$l+$hsh{'width'};
527   } else {
528     $hsh{'width'}=$r-$l;
529   }
530   if ($hsh{'height'}) {
531     $b=int(0.5+($h-$hsh{'height'})/2);
532     $t=$h+$hsh{'height'};
533   } else {
534     $hsh{'height'}=$b-$t;
535   }
536
537 #    print "l=$l, r=$r, h=$hsh{'width'}\n";
538 #    print "t=$t, b=$b, w=$hsh{'height'}\n";
539
540   my $dst=Imager->new(xsize=>$hsh{'width'}, ysize=>$hsh{'height'}, channels=>$self->getchannels());
541
542   i_copyto($dst->{IMG},$self->{IMG},$l,$t,$r,$b,0,0);
543   return $dst;
544 }
545
546 # Sets an image to a certain size and channel number
547 # if there was previously data in the image it is discarded
548
549 sub img_set {
550   my $self=shift;
551
552   my %hsh=(xsize=>100, ysize=>100, channels=>3, bits=>8, type=>'direct', @_);
553
554   if (defined($self->{IMG})) {
555     # let IIM_DESTROY destroy it, it's possible this image is
556     # referenced from a virtual image (like masked)
557     #i_img_destroy($self->{IMG});
558     undef($self->{IMG});
559   }
560
561   if ($hsh{type} eq 'paletted' || $hsh{type} eq 'pseudo') {
562     $self->{IMG} = i_img_pal_new($hsh{xsize}, $hsh{ysize}, $hsh{channels},
563                                  $hsh{maxcolors} || 256);
564   }
565   elsif ($hsh{bits} eq 'double') {
566     $self->{IMG} = i_img_double_new($hsh{xsize}, $hsh{ysize}, $hsh{channels});
567   }
568   elsif ($hsh{bits} == 16) {
569     $self->{IMG} = i_img_16_new($hsh{xsize}, $hsh{ysize}, $hsh{channels});
570   }
571   else {
572     $self->{IMG}=Imager::ImgRaw::new($hsh{'xsize'}, $hsh{'ysize'},
573                                      $hsh{'channels'});
574   }
575 }
576
577 # created a masked version of the current image
578 sub masked {
579   my $self = shift;
580
581   $self or return undef;
582   my %opts = (left    => 0, 
583               top     => 0, 
584               right   => $self->getwidth, 
585               bottom  => $self->getheight,
586               @_);
587   my $mask = $opts{mask} ? $opts{mask}{IMG} : undef;
588
589   my $result = Imager->new;
590   $result->{IMG} = i_img_masked_new($self->{IMG}, $mask, $opts{left}, 
591                                     $opts{top}, $opts{right} - $opts{left},
592                                     $opts{bottom} - $opts{top});
593   # keep references to the mask and base images so they don't
594   # disappear on us
595   $result->{DEPENDS} = [ $self->{IMG}, $mask ];
596
597   $result;
598 }
599
600 # convert an RGB image into a paletted image
601 sub to_paletted {
602   my $self = shift;
603   my $opts;
604   if (@_ != 1 && !ref $_[0]) {
605     $opts = { @_ };
606   }
607   else {
608     $opts = shift;
609   }
610
611   my $result = Imager->new;
612   $result->{IMG} = i_img_to_pal($self->{IMG}, $opts);
613
614   #print "Type ", i_img_type($result->{IMG}), "\n";
615
616   $result->{IMG} or undef $result;
617
618   return $result;
619 }
620
621 # convert a paletted (or any image) to an 8-bit/channel RGB images
622 sub to_rgb8 {
623   my $self = shift;
624   my $result;
625
626   if ($self->{IMG}) {
627     $result = Imager->new;
628     $result->{IMG} = i_img_to_rgb($self->{IMG})
629       or undef $result;
630   }
631
632   return $result;
633 }
634
635 sub addcolors {
636   my $self = shift;
637   my %opts = (colors=>[], @_);
638
639   @{$opts{colors}} or return undef;
640
641   $self->{IMG} and i_addcolors($self->{IMG}, @{$opts{colors}});
642 }
643
644 sub setcolors {
645   my $self = shift;
646   my %opts = (start=>0, colors=>[], @_);
647   @{$opts{colors}} or return undef;
648
649   $self->{IMG} and i_setcolors($self->{IMG}, $opts{start}, @{$opts{colors}});
650 }
651
652 sub getcolors {
653   my $self = shift;
654   my %opts = @_;
655   if (!exists $opts{start} && !exists $opts{count}) {
656     # get them all
657     $opts{start} = 0;
658     $opts{count} = $self->colorcount;
659   }
660   elsif (!exists $opts{count}) {
661     $opts{count} = 1;
662   }
663   elsif (!exists $opts{start}) {
664     $opts{start} = 0;
665   }
666   
667   $self->{IMG} and 
668     return i_getcolors($self->{IMG}, $opts{start}, $opts{count});
669 }
670
671 sub colorcount {
672   i_colorcount($_[0]{IMG});
673 }
674
675 sub maxcolors {
676   i_maxcolors($_[0]{IMG});
677 }
678
679 sub findcolor {
680   my $self = shift;
681   my %opts = @_;
682   $opts{color} or return undef;
683
684   $self->{IMG} and i_findcolor($self->{IMG}, $opts{color});
685 }
686
687 sub bits {
688   my $self = shift;
689   my $bits = $self->{IMG} && i_img_bits($self->{IMG});
690   if ($bits && $bits == length(pack("d", 1)) * 8) {
691     $bits = 'double';
692   }
693   $bits;
694 }
695
696 sub type {
697   my $self = shift;
698   if ($self->{IMG}) {
699     return i_img_type($self->{IMG}) ? "paletted" : "direct";
700   }
701 }
702
703 sub virtual {
704   my $self = shift;
705   $self->{IMG} and i_img_virtual($self->{IMG});
706 }
707
708 sub tags {
709   my ($self, %opts) = @_;
710
711   $self->{IMG} or return;
712
713   if (defined $opts{name}) {
714     my @result;
715     my $start = 0;
716     my $found;
717     while (defined($found = i_tags_find($self->{IMG}, $opts{name}, $start))) {
718       push @result, (i_tags_get($self->{IMG}, $found))[1];
719       $start = $found+1;
720     }
721     return wantarray ? @result : $result[0];
722   }
723   elsif (defined $opts{code}) {
724     my @result;
725     my $start = 0;
726     my $found;
727     while (defined($found = i_tags_findn($self->{IMG}, $opts{code}, $start))) {
728       push @result, (i_tags_get($self->{IMG}, $found))[1];
729       $start = $found+1;
730     }
731     return @result;
732   }
733   else {
734     if (wantarray) {
735       return map { [ i_tags_get($self->{IMG}, $_) ] } 0.. i_tags_count($self->{IMG})-1;
736     }
737     else {
738       return i_tags_count($self->{IMG});
739     }
740   }
741 }
742
743 sub addtag {
744   my $self = shift;
745   my %opts = @_;
746
747   return -1 unless $self->{IMG};
748   if ($opts{name}) {
749     if (defined $opts{value}) {
750       if ($opts{value} =~ /^\d+$/) {
751         # add as a number
752         return i_tags_addn($self->{IMG}, $opts{name}, 0, $opts{value});
753       }
754       else {
755         return i_tags_add($self->{IMG}, $opts{name}, 0, $opts{value}, 0);
756       }
757     }
758     elsif (defined $opts{data}) {
759       # force addition as a string
760       return i_tags_add($self->{IMG}, $opts{name}, 0, $opts{data}, 0);
761     }
762     else {
763       $self->{ERRSTR} = "No value supplied";
764       return undef;
765     }
766   }
767   elsif ($opts{code}) {
768     if (defined $opts{value}) {
769       if ($opts{value} =~ /^\d+$/) {
770         # add as a number
771         return i_tags_addn($self->{IMG}, $opts{code}, 0, $opts{value});
772       }
773       else {
774         return i_tags_add($self->{IMG}, $opts{code}, 0, $opts{value}, 0);
775       }
776     }
777     elsif (defined $opts{data}) {
778       # force addition as a string
779       return i_tags_add($self->{IMG}, $opts{code}, 0, $opts{data}, 0);
780     }
781     else {
782       $self->{ERRSTR} = "No value supplied";
783       return undef;
784     }
785   }
786   else {
787     return undef;
788   }
789 }
790
791 sub deltag {
792   my $self = shift;
793   my %opts = @_;
794
795   return 0 unless $self->{IMG};
796
797   if (defined $opts{index}) {
798     return i_tags_delete($self->{IMG}, $opts{index});
799   }
800   elsif (defined $opts{name}) {
801     return i_tags_delbyname($self->{IMG}, $opts{name});
802   }
803   elsif (defined $opts{code}) {
804     return i_tags_delbycode($self->{IMG}, $opts{code});
805   }
806   else {
807     $self->{ERRSTR} = "Need to supply index, name, or code parameter";
808     return 0;
809   }
810 }
811
812 # Read an image from file
813
814 sub read {
815   my $self = shift;
816   my %input=@_;
817   my ($fh, $fd, $IO);
818
819   if (defined($self->{IMG})) {
820     # let IIM_DESTROY do the destruction, since the image may be
821     # referenced from elsewhere
822     #i_img_destroy($self->{IMG});
823     undef($self->{IMG});
824   }
825
826   if (!$input{fd} and !$input{file} and !$input{data}) {
827     $self->{ERRSTR}='no file, fd or data parameter'; return undef;
828   }
829   if ($input{file}) {
830     $fh = new IO::File($input{file},"r");
831     if (!defined $fh) {
832       $self->{ERRSTR}='Could not open file'; return undef;
833     }
834     binmode($fh);
835     $fd = $fh->fileno();
836   }
837   if ($input{fd}) {
838     $fd=$input{fd};
839   }
840
841   # FIXME: Find the format here if not specified
842   # yes the code isn't here yet - next week maybe?
843   # Next week?  Are you high or something?  That comment
844   # has been there for half a year dude.
845   # Look, i just work here, ok?
846
847   if (!$input{type} and $input{file}) {
848     $input{type}=$FORMATGUESS->($input{file});
849   }
850   if (!$formats{$input{type}}) {
851     $self->{ERRSTR}='format not supported'; return undef;
852   }
853
854   my %iolready=(jpeg=>1, png=>1, tiff=>1, pnm=>1, raw=>1, bmp=>1, tga=>1);
855
856   if ($iolready{$input{type}}) {
857     # Setup data source
858     $IO = io_new_fd($fd);       # sort of simple for now eh?
859
860     if ( $input{type} eq 'jpeg' ) {
861       ($self->{IMG},$self->{IPTCRAW})=i_readjpeg_wiol( $IO );
862       if ( !defined($self->{IMG}) ) {
863         $self->{ERRSTR}='unable to read jpeg image'; return undef;
864       }
865       $self->{DEBUG} && print "loading a jpeg file\n";
866       return $self;
867     }
868
869     if ( $input{type} eq 'tiff' ) {
870       $self->{IMG}=i_readtiff_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed
871       if ( !defined($self->{IMG}) ) {
872         $self->{ERRSTR}='unable to read tiff image'; return undef;
873       }
874       $self->{DEBUG} && print "loading a tiff file\n";
875       return $self;
876     }
877
878     if ( $input{type} eq 'pnm' ) {
879       $self->{IMG}=i_readpnm_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed
880       if ( !defined($self->{IMG}) ) {
881         $self->{ERRSTR}='unable to read pnm image: '._error_as_msg(); return undef;
882       }
883       $self->{DEBUG} && print "loading a pnm file\n";
884       return $self;
885     }
886
887     if ( $input{type} eq 'png' ) {
888       $self->{IMG}=i_readpng_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed
889       if ( !defined($self->{IMG}) ) {
890         $self->{ERRSTR}='unable to read png image';
891         return undef;
892       }
893       $self->{DEBUG} && print "loading a png file\n";
894     }
895
896     if ( $input{type} eq 'bmp' ) {
897       $self->{IMG}=i_readbmp_wiol( $IO );
898       if ( !defined($self->{IMG}) ) {
899         $self->{ERRSTR}='unable to read bmp image';
900         return undef;
901       }
902       $self->{DEBUG} && print "loading a bmp file\n";
903     }
904
905     if ( $input{type} eq 'tga' ) {
906       $self->{IMG}=i_readtga_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed
907       if ( !defined($self->{IMG}) ) {
908         $self->{ERRSTR}=$self->_error_as_msg();
909 #       $self->{ERRSTR}='unable to read tga image';
910         return undef;
911       }
912       $self->{DEBUG} && print "loading a tga file\n";
913     }
914
915     if ( $input{type} eq 'raw' ) {
916       my %params=(datachannels=>3,storechannels=>3,interleave=>1,%input);
917
918       if ( !($params{xsize} && $params{ysize}) ) {
919         $self->{ERRSTR}='missing xsize or ysize parameter for raw';
920         return undef;
921       }
922
923       $self->{IMG} = i_readraw_wiol( $IO,
924                                      $params{xsize},
925                                      $params{ysize},
926                                      $params{datachannels},
927                                      $params{storechannels},
928                                      $params{interleave});
929       if ( !defined($self->{IMG}) ) {
930         $self->{ERRSTR}='unable to read raw image';
931         return undef;
932       }
933       $self->{DEBUG} && print "loading a raw file\n";
934     }
935
936   } else {
937
938     # Old code for reference while changing the new stuff
939
940     if (!$input{type} and $input{file}) {
941       $input{type}=$FORMATGUESS->($input{file});
942     }
943
944     if (!$input{type}) {
945       $self->{ERRSTR}='type parameter missing and not possible to guess from extension'; return undef;
946     }
947
948     if (!$formats{$input{type}}) {
949       $self->{ERRSTR}='format not supported';
950       return undef;
951     }
952
953     if ($input{file}) {
954       $fh = new IO::File($input{file},"r");
955       if (!defined $fh) {
956         $self->{ERRSTR}='Could not open file';
957         return undef;
958       }
959       binmode($fh);
960       $fd = $fh->fileno();
961     }
962
963     if ($input{fd}) {
964       $fd=$input{fd};
965     }
966
967     if ( $input{type} eq 'gif' ) {
968       my $colors;
969       if ($input{colors} && !ref($input{colors})) {
970         # must be a reference to a scalar that accepts the colour map
971         $self->{ERRSTR} = "option 'colors' must be a scalar reference";
972         return undef;
973       }
974       if (exists $input{data}) {
975         if ($input{colors}) {
976           ($self->{IMG}, $colors) = i_readgif_scalar($input{data});
977         } else {
978           $self->{IMG}=i_readgif_scalar($input{data});
979         }
980       } else {
981         if ($input{colors}) {
982           ($self->{IMG}, $colors) = i_readgif( $fd );
983         } else {
984           $self->{IMG} = i_readgif( $fd )
985         }
986       }
987       if ($colors) {
988         # we may or may not change i_readgif to return blessed objects...
989         ${ $input{colors} } = [ map { NC(@$_) } @$colors ];
990       }
991       if ( !defined($self->{IMG}) ) {
992         $self->{ERRSTR}= 'reading GIF:'._error_as_msg();
993         return undef;
994       }
995       $self->{DEBUG} && print "loading a gif file\n";
996     }
997   }
998   return $self;
999 }
1000
1001 # Write an image to file
1002 sub write {
1003   my $self = shift;
1004   my %input=(jpegquality=>75, gifquant=>'mc', lmdither=>6.0, lmfixed=>[], 
1005              fax_fine=>1, @_);
1006   my ($fh, $rc, $fd, $IO);
1007
1008   my %iolready=( tiff=>1, raw=>1, png=>1, pnm=>1, bmp=>1, jpeg=>1, tga=>1 ); # this will be SO MUCH BETTER once they are all in there
1009
1010   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1011
1012   if (!$input{file} and !$input{'fd'} and !$input{'data'}) { $self->{ERRSTR}='file/fd/data parameter missing'; return undef; }
1013   if (!$input{type} and $input{file}) { $input{type}=$FORMATGUESS->($input{file}); }
1014   if (!$input{type}) { $self->{ERRSTR}='type parameter missing and not possible to guess from extension'; return undef; }
1015
1016   if (!$formats{$input{type}}) { $self->{ERRSTR}='format not supported'; return undef; }
1017
1018   if (exists $input{'fd'}) {
1019     $fd=$input{'fd'};
1020   } elsif (exists $input{'data'}) {
1021     $IO = Imager::io_new_bufchain();
1022   } else {
1023     $fh = new IO::File($input{file},"w+");
1024     if (!defined $fh) { $self->{ERRSTR}='Could not open file'; return undef; }
1025     binmode($fh) or die;
1026     $fd = $fh->fileno();
1027   }
1028
1029   if ($iolready{$input{type}}) {
1030     if (defined $fd) {
1031       $IO = io_new_fd($fd);
1032     }
1033
1034     if ($input{type} eq 'tiff') {
1035       if (defined $input{class} && $input{class} eq 'fax') {
1036         if (!i_writetiff_wiol_faxable($self->{IMG}, $IO, $input{fax_fine})) {
1037           $self->{ERRSTR}='Could not write to buffer';
1038           return undef;
1039         }
1040       } else {
1041         if (!i_writetiff_wiol($self->{IMG}, $IO)) {
1042           $self->{ERRSTR}='Could not write to buffer';
1043           return undef;
1044         }
1045       }
1046     } elsif ( $input{type} eq 'pnm' ) {
1047       if ( ! i_writeppm_wiol($self->{IMG},$IO) ) {
1048         $self->{ERRSTR}='unable to write pnm image';
1049         return undef;
1050       }
1051       $self->{DEBUG} && print "writing a pnm file\n";
1052     } elsif ( $input{type} eq 'raw' ) {
1053       if ( !i_writeraw_wiol($self->{IMG},$IO) ) {
1054         $self->{ERRSTR}='unable to write raw image';
1055         return undef;
1056       }
1057       $self->{DEBUG} && print "writing a raw file\n";
1058     } elsif ( $input{type} eq 'png' ) {
1059       if ( !i_writepng_wiol($self->{IMG}, $IO) ) {
1060         $self->{ERRSTR}='unable to write png image';
1061         return undef;
1062       }
1063       $self->{DEBUG} && print "writing a png file\n";
1064     } elsif ( $input{type} eq 'jpeg' ) {
1065       if ( !i_writejpeg_wiol($self->{IMG}, $IO, $input{jpegquality})) {
1066         $self->{ERRSTR} = $self->_error_as_msg();
1067         return undef;
1068       }
1069       $self->{DEBUG} && print "writing a jpeg file\n";
1070     } elsif ( $input{type} eq 'bmp' ) {
1071       if ( !i_writebmp_wiol($self->{IMG}, $IO) ) {
1072         $self->{ERRSTR}='unable to write bmp image';
1073         return undef;
1074       }
1075       $self->{DEBUG} && print "writing a bmp file\n";
1076     } elsif ( $input{type} eq 'tga' ) {
1077       if ( !i_writetga_wiol($self->{IMG}, $IO) ) {
1078         $self->{ERRSTR}=$self->_error_as_msg();
1079 #       $self->{ERRSTR}='unable to write tga image';
1080         return undef;
1081       }
1082       $self->{DEBUG} && print "writing a tga file\n";
1083     }
1084
1085     if (exists $input{'data'}) {
1086       my $data = io_slurp($IO);
1087       if (!$data) {
1088         $self->{ERRSTR}='Could not slurp from buffer';
1089         return undef;
1090       }
1091       ${$input{data}} = $data;
1092     }
1093     return $self;
1094   } else {
1095     if ( $input{type} eq 'gif' ) {
1096       if (not $input{gifplanes}) {
1097         my $gp;
1098         my $count=i_count_colors($self->{IMG}, 256);
1099         $gp=8 if $count == -1;
1100         $gp=1 if not $gp and $count <= 2;
1101         $gp=2 if not $gp and $count <= 4;
1102         $gp=3 if not $gp and $count <= 8;
1103         $gp=4 if not $gp and $count <= 16;
1104         $gp=5 if not $gp and $count <= 32;
1105         $gp=6 if not $gp and $count <= 64;
1106         $gp=7 if not $gp and $count <= 128;
1107         $input{gifplanes} = $gp || 8;
1108       }
1109
1110       if ($input{gifplanes}>8) {
1111         $input{gifplanes}=8;
1112       }
1113       if ($input{gifquant} eq 'gen' || $input{callback}) {
1114
1115
1116         if ($input{gifquant} eq 'lm') {
1117
1118           $input{make_colors} = 'addi';
1119           $input{translate} = 'perturb';
1120           $input{perturb} = $input{lmdither};
1121         } elsif ($input{gifquant} eq 'gen') {
1122           # just pass options through
1123         } else {
1124           $input{make_colors} = 'webmap'; # ignored
1125           $input{translate} = 'giflib';
1126         }
1127
1128         if ($input{callback}) {
1129           defined $input{maxbuffer} or $input{maxbuffer} = -1;
1130           $rc = i_writegif_callback($input{callback}, $input{maxbuffer},
1131                                     \%input, $self->{IMG});
1132         } else {
1133           $rc = i_writegif_gen($fd, \%input, $self->{IMG});
1134         }
1135
1136       } elsif ($input{gifquant} eq 'lm') {
1137         $rc=i_writegif($self->{IMG},$fd,$input{gifplanes},$input{lmdither},$input{lmfixed});
1138       } else {
1139         $rc=i_writegifmc($self->{IMG},$fd,$input{gifplanes});
1140       }
1141       if ( !defined($rc) ) {
1142         $self->{ERRSTR} = "Writing GIF file: "._error_as_msg(); return undef;
1143       }
1144       $self->{DEBUG} && print "writing a gif file\n";
1145
1146     }
1147   }
1148   return $self;
1149 }
1150
1151 sub write_multi {
1152   my ($class, $opts, @images) = @_;
1153
1154   if ($opts->{type} eq 'gif') {
1155     my $gif_delays = $opts->{gif_delays};
1156     local $opts->{gif_delays} = $gif_delays;
1157     unless (ref $opts->{gif_delays}) {
1158       # assume the caller wants the same delay for each frame
1159       $opts->{gif_delays} = [ ($gif_delays) x @images ];
1160     }
1161     # translate to ImgRaw
1162     if (grep !UNIVERSAL::isa($_, 'Imager') || !$_->{IMG}, @images) {
1163       $ERRSTR = "Usage: Imager->write_multi({ options }, @images)";
1164       return 0;
1165     }
1166     my @work = map $_->{IMG}, @images;
1167     if ($opts->{callback}) {
1168       # Note: you may need to fix giflib for this one to work
1169       my $maxbuffer = $opts->{maxbuffer};
1170       defined $maxbuffer or $maxbuffer = -1; # max by default
1171       return i_writegif_callback($opts->{callback}, $maxbuffer,
1172                                  $opts, @work);
1173     }
1174     if ($opts->{fd}) {
1175       return i_writegif_gen($opts->{fd}, $opts, @work);
1176     }
1177     else {
1178       my $fh = IO::File->new($opts->{file}, "w+");
1179       unless ($fh) {
1180         $ERRSTR = "Error creating $opts->{file}: $!";
1181         return 0;
1182       }
1183       binmode($fh);
1184       return i_writegif_gen(fileno($fh), $opts, @work);
1185     }
1186   }
1187   else {
1188     $ERRSTR = "Sorry, write_multi doesn't support $opts->{type} yet";
1189     return 0;
1190   }
1191 }
1192
1193 # read multiple images from a file
1194 sub read_multi {
1195   my ($class, %opts) = @_;
1196
1197   if ($opts{file} && !exists $opts{type}) {
1198     # guess the type 
1199     my $type = $FORMATGUESS->($opts{file});
1200     $opts{type} = $type;
1201   }
1202   unless ($opts{type}) {
1203     $ERRSTR = "No type parameter supplied and it couldn't be guessed";
1204     return;
1205   }
1206   my $fd;
1207   my $file;
1208   if ($opts{file}) {
1209     $file = IO::File->new($opts{file}, "r");
1210     unless ($file) {
1211       $ERRSTR = "Could not open file $opts{file}: $!";
1212       return;
1213     }
1214     binmode $file;
1215     $fd = fileno($file);
1216   }
1217   elsif ($opts{fh}) {
1218     $fd = fileno($opts{fh});
1219     unless ($fd) {
1220       $ERRSTR = "File handle specified with fh option not open";
1221       return;
1222     }
1223   }
1224   elsif ($opts{fd}) {
1225     $fd = $opts{fd};
1226   }
1227   elsif ($opts{callback} || $opts{data}) {
1228     # don't fail here
1229   }
1230   else {
1231     $ERRSTR = "You need to specify one of file, fd, fh, callback or data";
1232     return;
1233   }
1234
1235   if ($opts{type} eq 'gif') {
1236     my @imgs;
1237     if ($fd) {
1238       @imgs = i_readgif_multi($fd);
1239     }
1240     else {
1241       if (Imager::i_giflib_version() < 4.0) {
1242         $ERRSTR = "giflib3.x does not support callbacks";
1243         return;
1244       }
1245       if ($opts{callback}) {
1246         @imgs = i_readgif_multi_callback($opts{callback})
1247       }
1248       else {
1249         @imgs = i_readgif_multi_scalar($opts{data});
1250       }
1251     }
1252     if (@imgs) {
1253       return map { 
1254         bless { IMG=>$_, DEBUG=>$DEBUG, ERRSTR=>undef }, 'Imager' 
1255       } @imgs;
1256     }
1257     else {
1258       $ERRSTR = _error_as_msg();
1259       return;
1260     }
1261   }
1262
1263   $ERRSTR = "Cannot read multiple images from $opts{type} files";
1264   return;
1265 }
1266
1267 # Destroy an Imager object
1268
1269 sub DESTROY {
1270   my $self=shift;
1271   #    delete $instances{$self};
1272   if (defined($self->{IMG})) {
1273     # the following is now handled by the XS DESTROY method for
1274     # Imager::ImgRaw object
1275     # Re-enabling this will break virtual images
1276     # tested for in t/t020masked.t
1277     # i_img_destroy($self->{IMG});
1278     undef($self->{IMG});
1279   } else {
1280 #    print "Destroy Called on an empty image!\n"; # why did I put this here??
1281   }
1282 }
1283
1284 # Perform an inplace filter of an image
1285 # that is the image will be overwritten with the data
1286
1287 sub filter {
1288   my $self=shift;
1289   my %input=@_;
1290   my %hsh;
1291   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1292
1293   if (!$input{type}) { $self->{ERRSTR}='type parameter missing'; return undef; }
1294
1295   if ( (grep { $_ eq $input{type} } keys %filters) != 1) {
1296     $self->{ERRSTR}='type parameter not matching any filter'; return undef;
1297   }
1298
1299   if ($filters{$input{type}}{names}) {
1300     my $names = $filters{$input{type}}{names};
1301     for my $name (keys %$names) {
1302       if (defined $input{$name} && exists $names->{$name}{$input{$name}}) {
1303         $input{$name} = $names->{$name}{$input{$name}};
1304       }
1305     }
1306   }
1307   if (defined($filters{$input{type}}{defaults})) {
1308     %hsh=('image',$self->{IMG},%{$filters{$input{type}}{defaults}},%input);
1309   } else {
1310     %hsh=('image',$self->{IMG},%input);
1311   }
1312
1313   my @cs=@{$filters{$input{type}}{callseq}};
1314
1315   for(@cs) {
1316     if (!defined($hsh{$_})) {
1317       $self->{ERRSTR}="missing parameter '$_' for filter ".$input{type}; return undef;
1318     }
1319   }
1320
1321   &{$filters{$input{type}}{callsub}}(%hsh);
1322
1323   my @b=keys %hsh;
1324
1325   $self->{DEBUG} && print "callseq is: @cs\n";
1326   $self->{DEBUG} && print "matching callseq is: @b\n";
1327
1328   return $self;
1329 }
1330
1331 # Scale an image to requested size and return the scaled version
1332
1333 sub scale {
1334   my $self=shift;
1335   my %opts=(scalefactor=>0.5,type=>'max',qtype=>'normal',@_);
1336   my $img = Imager->new();
1337   my $tmp = Imager->new();
1338
1339   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1340
1341   if ($opts{xpixels} and $opts{ypixels} and $opts{type}) {
1342     my ($xpix,$ypix)=( $opts{xpixels}/$self->getwidth() , $opts{ypixels}/$self->getheight() );
1343     if ($opts{type} eq 'min') { $opts{scalefactor}=min($xpix,$ypix); }
1344     if ($opts{type} eq 'max') { $opts{scalefactor}=max($xpix,$ypix); }
1345   } elsif ($opts{xpixels}) { $opts{scalefactor}=$opts{xpixels}/$self->getwidth(); }
1346   elsif ($opts{ypixels}) { $opts{scalefactor}=$opts{ypixels}/$self->getheight(); }
1347
1348   if ($opts{qtype} eq 'normal') {
1349     $tmp->{IMG}=i_scaleaxis($self->{IMG},$opts{scalefactor},0);
1350     if ( !defined($tmp->{IMG}) ) { $self->{ERRSTR}='unable to scale image'; return undef; }
1351     $img->{IMG}=i_scaleaxis($tmp->{IMG},$opts{scalefactor},1);
1352     if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='unable to scale image'; return undef; }
1353     return $img;
1354   }
1355   if ($opts{'qtype'} eq 'preview') {
1356     $img->{IMG}=i_scale_nn($self->{IMG},$opts{'scalefactor'},$opts{'scalefactor'}); 
1357     if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='unable to scale image'; return undef; }
1358     return $img;
1359   }
1360   $self->{ERRSTR}='scale: invalid value for qtype'; return undef;
1361 }
1362
1363 # Scales only along the X axis
1364
1365 sub scaleX {
1366   my $self=shift;
1367   my %opts=(scalefactor=>0.5,@_);
1368
1369   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1370
1371   my $img = Imager->new();
1372
1373   if ($opts{pixels}) { $opts{scalefactor}=$opts{pixels}/$self->getwidth(); }
1374
1375   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1376   $img->{IMG}=i_scaleaxis($self->{IMG},$opts{scalefactor},0);
1377
1378   if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='unable to scale image'; return undef; }
1379   return $img;
1380 }
1381
1382 # Scales only along the Y axis
1383
1384 sub scaleY {
1385   my $self=shift;
1386   my %opts=(scalefactor=>0.5,@_);
1387
1388   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1389
1390   my $img = Imager->new();
1391
1392   if ($opts{pixels}) { $opts{scalefactor}=$opts{pixels}/$self->getheight(); }
1393
1394   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1395   $img->{IMG}=i_scaleaxis($self->{IMG},$opts{scalefactor},1);
1396
1397   if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='unable to scale image'; return undef; }
1398   return $img;
1399 }
1400
1401
1402 # Transform returns a spatial transformation of the input image
1403 # this moves pixels to a new location in the returned image.
1404 # NOTE - should make a utility function to check transforms for
1405 # stack overruns
1406
1407 sub transform {
1408   my $self=shift;
1409   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1410   my %opts=@_;
1411   my (@op,@ropx,@ropy,$iop,$or,@parm,$expr,@xt,@yt,@pt,$numre);
1412
1413 #  print Dumper(\%opts);
1414 #  xopcopdes
1415
1416   if ( $opts{'xexpr'} and $opts{'yexpr'} ) {
1417     if (!$I2P) {
1418       eval ("use Affix::Infix2Postfix;");
1419       print $@;
1420       if ( $@ ) {
1421         $self->{ERRSTR}='transform: expr given and Affix::Infix2Postfix is not avaliable.'; 
1422         return undef;
1423       }
1424       $I2P=Affix::Infix2Postfix->new('ops'=>[{op=>'+',trans=>'Add'},
1425                                              {op=>'-',trans=>'Sub'},
1426                                              {op=>'*',trans=>'Mult'},
1427                                              {op=>'/',trans=>'Div'},
1428                                              {op=>'-',type=>'unary',trans=>'u-'},
1429                                              {op=>'**'},
1430                                              {op=>'func',type=>'unary'}],
1431                                      'grouping'=>[qw( \( \) )],
1432                                      'func'=>[qw( sin cos )],
1433                                      'vars'=>[qw( x y )]
1434                                     );
1435     }
1436
1437     @xt=$I2P->translate($opts{'xexpr'});
1438     @yt=$I2P->translate($opts{'yexpr'});
1439
1440     $numre=$I2P->{'numre'};
1441     @pt=(0,0);
1442
1443     for(@xt) { if (/$numre/) { push(@pt,$_); push(@{$opts{'xopcodes'}},'Parm',$#pt); } else { push(@{$opts{'xopcodes'}},$_); } }
1444     for(@yt) { if (/$numre/) { push(@pt,$_); push(@{$opts{'yopcodes'}},'Parm',$#pt); } else { push(@{$opts{'yopcodes'}},$_); } }
1445     @{$opts{'parm'}}=@pt;
1446   }
1447
1448 #  print Dumper(\%opts);
1449
1450   if ( !exists $opts{'xopcodes'} or @{$opts{'xopcodes'}}==0) {
1451     $self->{ERRSTR}='transform: no xopcodes given.';
1452     return undef;
1453   }
1454
1455   @op=@{$opts{'xopcodes'}};
1456   for $iop (@op) { 
1457     if (!defined ($OPCODES{$iop}) and ($iop !~ /^\d+$/) ) {
1458       $self->{ERRSTR}="transform: illegal opcode '$_'.";
1459       return undef;
1460     }
1461     push(@ropx,(exists $OPCODES{$iop}) ? @{$OPCODES{$iop}} : $iop );
1462   }
1463
1464
1465 # yopcopdes
1466
1467   if ( !exists $opts{'yopcodes'} or @{$opts{'yopcodes'}}==0) {
1468     $self->{ERRSTR}='transform: no yopcodes given.';
1469     return undef;
1470   }
1471
1472   @op=@{$opts{'yopcodes'}};
1473   for $iop (@op) { 
1474     if (!defined ($OPCODES{$iop}) and ($iop !~ /^\d+$/) ) {
1475       $self->{ERRSTR}="transform: illegal opcode '$_'.";
1476       return undef;
1477     }
1478     push(@ropy,(exists $OPCODES{$iop}) ? @{$OPCODES{$iop}} : $iop );
1479   }
1480
1481 #parameters
1482
1483   if ( !exists $opts{'parm'}) {
1484     $self->{ERRSTR}='transform: no parameter arg given.';
1485     return undef;
1486   }
1487
1488 #  print Dumper(\@ropx);
1489 #  print Dumper(\@ropy);
1490 #  print Dumper(\@ropy);
1491
1492   my $img = Imager->new();
1493   $img->{IMG}=i_transform($self->{IMG},\@ropx,\@ropy,$opts{'parm'});
1494   if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='transform: failed'; return undef; }
1495   return $img;
1496 }
1497
1498
1499 sub transform2 {
1500   my ($opts, @imgs) = @_;
1501   
1502   require "Imager/Expr.pm";
1503
1504   $opts->{variables} = [ qw(x y) ];
1505   my ($width, $height) = @{$opts}{qw(width height)};
1506   if (@imgs) {
1507     $width ||= $imgs[0]->getwidth();
1508     $height ||= $imgs[0]->getheight();
1509     my $img_num = 1;
1510     for my $img (@imgs) {
1511       $opts->{constants}{"w$img_num"} = $img->getwidth();
1512       $opts->{constants}{"h$img_num"} = $img->getheight();
1513       $opts->{constants}{"cx$img_num"} = $img->getwidth()/2;
1514       $opts->{constants}{"cy$img_num"} = $img->getheight()/2;
1515       ++$img_num;
1516     }
1517   }
1518   if ($width) {
1519     $opts->{constants}{w} = $width;
1520     $opts->{constants}{cx} = $width/2;
1521   }
1522   else {
1523     $Imager::ERRSTR = "No width supplied";
1524     return;
1525   }
1526   if ($height) {
1527     $opts->{constants}{h} = $height;
1528     $opts->{constants}{cy} = $height/2;
1529   }
1530   else {
1531     $Imager::ERRSTR = "No height supplied";
1532     return;
1533   }
1534   my $code = Imager::Expr->new($opts);
1535   if (!$code) {
1536     $Imager::ERRSTR = Imager::Expr::error();
1537     return;
1538   }
1539   
1540   my $img = Imager->new();
1541   $img->{IMG} = i_transform2($opts->{width}, $opts->{height}, $code->code(),
1542                              $code->nregs(), $code->cregs(),
1543                              [ map { $_->{IMG} } @imgs ]);
1544   if (!defined $img->{IMG}) {
1545     $Imager::ERRSTR = Imager->_error_as_msg();
1546     return;
1547   }
1548   
1549   return $img;
1550 }
1551
1552 sub rubthrough {
1553   my $self=shift;
1554   my %opts=(tx=>0,ty=>0,@_);
1555
1556   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1557   unless ($opts{src} && $opts{src}->{IMG}) { $self->{ERRSTR}='empty input image for source'; return undef; }
1558
1559   unless (i_rubthru($self->{IMG}, $opts{src}->{IMG}, $opts{tx},$opts{ty})) {
1560     $self->{ERRSTR} = $self->_error_as_msg();
1561     return undef;
1562   }
1563   return $self;
1564 }
1565
1566
1567 sub flip {
1568   my $self  = shift;
1569   my %opts  = @_;
1570   my %xlate = (h=>0, v=>1, hv=>2, vh=>2);
1571   my $dir;
1572   return () unless defined $opts{'dir'} and defined $xlate{$opts{'dir'}};
1573   $dir = $xlate{$opts{'dir'}};
1574   return $self if i_flipxy($self->{IMG}, $dir);
1575   return ();
1576 }
1577
1578 sub rotate {
1579   my $self = shift;
1580   my %opts = @_;
1581   if (defined $opts{right}) {
1582     my $degrees = $opts{right};
1583     if ($degrees < 0) {
1584       $degrees += 360 * int(((-$degrees)+360)/360);
1585     }
1586     $degrees = $degrees % 360;
1587     if ($degrees == 0) {
1588       return $self->copy();
1589     }
1590     elsif ($degrees == 90 || $degrees == 180 || $degrees == 270) {
1591       my $result = Imager->new();
1592       if ($result->{IMG} = i_rotate90($self->{IMG}, $degrees)) {
1593         return $result;
1594       }
1595       else {
1596         $self->{ERRSTR} = $self->_error_as_msg();
1597         return undef;
1598       }
1599     }
1600     else {
1601       $self->{ERRSTR} = "Parameter 'right' must be a multiple of 90 degrees";
1602       return undef;
1603     }
1604   }
1605   elsif (defined $opts{radians} || defined $opts{degrees}) {
1606     my $amount = $opts{radians} || $opts{degrees} * 3.1415926535 / 180;
1607
1608     my $result = Imager->new;
1609     if ($result->{IMG} = i_rotate_exact($self->{IMG}, $amount)) {
1610       return $result;
1611     }
1612     else {
1613       $self->{ERRSTR} = $self->_error_as_msg();
1614       return undef;
1615     }
1616   }
1617   else {
1618     $self->{ERRSTR} = "Only the 'right' parameter is available";
1619     return undef;
1620   }
1621 }
1622
1623 sub matrix_transform {
1624   my $self = shift;
1625   my %opts = @_;
1626
1627   if ($opts{matrix}) {
1628     my $xsize = $opts{xsize} || $self->getwidth;
1629     my $ysize = $opts{ysize} || $self->getheight;
1630
1631     my $result = Imager->new;
1632     $result->{IMG} = i_matrix_transform($self->{IMG}, $xsize, $ysize, 
1633                                         $opts{matrix})
1634       or return undef;
1635
1636     return $result;
1637   }
1638   else {
1639     $self->{ERRSTR} = "matrix parameter required";
1640     return undef;
1641   }
1642 }
1643
1644 # blame Leolo :)
1645 *yatf = \&matrix_transform;
1646
1647 # These two are supported for legacy code only
1648
1649 sub i_color_new {
1650   return Imager::Color->new(@_);
1651 }
1652
1653 sub i_color_set {
1654   return Imager::Color::set(@_);
1655 }
1656
1657 # Draws a box between the specified corner points.
1658 sub box {
1659   my $self=shift;
1660   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1661   my $dflcl=i_color_new(255,255,255,255);
1662   my %opts=(color=>$dflcl,xmin=>0,ymin=>0,xmax=>$self->getwidth()-1,ymax=>$self->getheight()-1,@_);
1663
1664   if (exists $opts{'box'}) { 
1665     $opts{'xmin'} = min($opts{'box'}->[0],$opts{'box'}->[2]);
1666     $opts{'xmax'} = max($opts{'box'}->[0],$opts{'box'}->[2]);
1667     $opts{'ymin'} = min($opts{'box'}->[1],$opts{'box'}->[3]);
1668     $opts{'ymax'} = max($opts{'box'}->[1],$opts{'box'}->[3]);
1669   }
1670
1671   if ($opts{filled}) { 
1672     i_box_filled($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},
1673                  $opts{ymax},$opts{color}); 
1674   }
1675   elsif ($opts{fill}) {
1676     unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
1677       # assume it's a hash ref
1678       require 'Imager/Fill.pm';
1679       unless ($opts{fill} = Imager::Fill->new(%{$opts{fill}})) {
1680         $self->{ERRSTR} = $Imager::ERRSTR;
1681         return undef;
1682       }
1683     }
1684     i_box_cfill($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},
1685                 $opts{ymax},$opts{fill}{fill});
1686   }
1687   else { 
1688     i_box($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},$opts{ymax},$opts{color});
1689   }
1690   return $self;
1691 }
1692
1693 # Draws an arc - this routine SUCKS and is buggy - it sometimes doesn't work when the arc is a convex polygon
1694
1695 sub arc {
1696   my $self=shift;
1697   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1698   my $dflcl=i_color_new(255,255,255,255);
1699   my %opts=(color=>$dflcl,
1700             'r'=>min($self->getwidth(),$self->getheight())/3,
1701             'x'=>$self->getwidth()/2,
1702             'y'=>$self->getheight()/2,
1703             'd1'=>0, 'd2'=>361, @_);
1704   if ($opts{fill}) {
1705     unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
1706       # assume it's a hash ref
1707       require 'Imager/Fill.pm';
1708       $opts{fill} = Imager::Fill->new(%{$opts{fill}});
1709     }
1710     i_arc_cfill($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},$opts{'d1'},
1711                 $opts{'d2'}, $opts{fill}{fill});
1712   }
1713   else {
1714     if ($opts{d1} == 0 && $opts{d2} == 361 && $opts{aa}) {
1715       i_circle_aa($self->{IMG}, $opts{'x'}, $opts{'y'}, $opts{'r'}, 
1716                   $opts{'color'});
1717     }
1718     else {
1719       #      i_arc($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},$opts{'d1'}, $opts{'d2'},$opts{'color'});
1720       if ($opts{'d1'} <= $opts{'d2'}) { i_arc($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},$opts{'d1'},$opts{'d2'},$opts{'color'}); }
1721       else                            { i_arc($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},$opts{'d1'},        361,$opts{'color'});
1722                                         i_arc($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},          0,$opts{'d2'},$opts{'color'}); }
1723     }
1724   }
1725
1726   return $self;
1727 }
1728
1729 # Draws a line from one point to (but not including) the destination point
1730
1731 sub line {
1732   my $self=shift;
1733   my $dflcl=i_color_new(0,0,0,0);
1734   my %opts=(color=>$dflcl,@_);
1735   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1736
1737   unless (exists $opts{x1} and exists $opts{y1}) { $self->{ERRSTR}='missing begining coord'; return undef; }
1738   unless (exists $opts{x2} and exists $opts{y2}) { $self->{ERRSTR}='missing ending coord'; return undef; }
1739
1740   if ($opts{antialias}) {
1741     i_line_aa($self->{IMG},$opts{x1}, $opts{y1}, $opts{x2}, $opts{y2}, $opts{color});
1742   } else {
1743     i_draw($self->{IMG},$opts{x1}, $opts{y1}, $opts{x2}, $opts{y2}, $opts{color});
1744   }
1745   return $self;
1746 }
1747
1748 # Draws a line between an ordered set of points - It more or less just transforms this
1749 # into a list of lines.
1750
1751 sub polyline {
1752   my $self=shift;
1753   my ($pt,$ls,@points);
1754   my $dflcl=i_color_new(0,0,0,0);
1755   my %opts=(color=>$dflcl,@_);
1756
1757   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1758
1759   if (exists($opts{points})) { @points=@{$opts{points}}; }
1760   if (!exists($opts{points}) and exists($opts{'x'}) and exists($opts{'y'}) ) {
1761     @points=map { [ $opts{'x'}->[$_],$opts{'y'}->[$_] ] } (0..(scalar @{$opts{'x'}}-1));
1762     }
1763
1764 #  print Dumper(\@points);
1765
1766   if ($opts{antialias}) {
1767     for $pt(@points) {
1768       if (defined($ls)) { i_line_aa($self->{IMG},$ls->[0],$ls->[1],$pt->[0],$pt->[1],$opts{color}); }
1769       $ls=$pt;
1770     }
1771   } else {
1772     for $pt(@points) {
1773       if (defined($ls)) { i_draw($self->{IMG},$ls->[0],$ls->[1],$pt->[0],$pt->[1],$opts{color}); }
1774       $ls=$pt;
1775     }
1776   }
1777   return $self;
1778 }
1779
1780 # this the multipoint bezier curve 
1781 # this is here more for testing that actual usage since
1782 # this is not a good algorithm.  Usually the curve would be
1783 # broken into smaller segments and each done individually.
1784
1785 sub polybezier {
1786   my $self=shift;
1787   my ($pt,$ls,@points);
1788   my $dflcl=i_color_new(0,0,0,0);
1789   my %opts=(color=>$dflcl,@_);
1790
1791   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1792
1793   if (exists $opts{points}) {
1794     $opts{'x'}=map { $_->[0]; } @{$opts{'points'}};
1795     $opts{'y'}=map { $_->[1]; } @{$opts{'points'}};
1796   }
1797
1798   unless ( @{$opts{'x'}} and @{$opts{'x'}} == @{$opts{'y'}} ) {
1799     $self->{ERRSTR}='Missing or invalid points.';
1800     return;
1801   }
1802
1803   i_bezier_multi($self->{IMG},$opts{'x'},$opts{'y'},$opts{'color'});
1804   return $self;
1805 }
1806
1807 sub flood_fill {
1808   my $self = shift;
1809   my %opts = ( color=>Imager::Color->new(255, 255, 255), @_ );
1810
1811   unless (exists $opts{x} && exists $opts{'y'}) {
1812     $self->{ERRSTR} = "missing seed x and y parameters";
1813     return undef;
1814   }
1815   
1816   if ($opts{fill}) {
1817     unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
1818       # assume it's a hash ref
1819       require 'Imager/Fill.pm';
1820       $opts{fill} = Imager::Fill->new(%{$opts{fill}});
1821     }
1822     i_flood_cfill($self->{IMG}, $opts{x}, $opts{'y'}, $opts{fill}{fill});
1823   }
1824   else {
1825     i_flood_fill($self->{IMG}, $opts{x}, $opts{'y'}, $opts{color});
1826   }
1827
1828   $self;
1829 }
1830
1831 # make an identity matrix of the given size
1832 sub _identity {
1833   my ($size) = @_;
1834
1835   my $matrix = [ map { [ (0) x $size ] } 1..$size ];
1836   for my $c (0 .. ($size-1)) {
1837     $matrix->[$c][$c] = 1;
1838   }
1839   return $matrix;
1840 }
1841
1842 # general function to convert an image
1843 sub convert {
1844   my ($self, %opts) = @_;
1845   my $matrix;
1846
1847   # the user can either specify a matrix or preset
1848   # the matrix overrides the preset
1849   if (!exists($opts{matrix})) {
1850     unless (exists($opts{preset})) {
1851       $self->{ERRSTR} = "convert() needs a matrix or preset";
1852       return;
1853     }
1854     else {
1855       if ($opts{preset} eq 'gray' || $opts{preset} eq 'grey') {
1856         # convert to greyscale, keeping the alpha channel if any
1857         if ($self->getchannels == 3) {
1858           $matrix = [ [ 0.222, 0.707, 0.071 ] ];
1859         }
1860         elsif ($self->getchannels == 4) {
1861           # preserve the alpha channel
1862           $matrix = [ [ 0.222, 0.707, 0.071, 0 ],
1863                       [ 0,     0,     0,     1 ] ];
1864         }
1865         else {
1866           # an identity
1867           $matrix = _identity($self->getchannels);
1868         }
1869       }
1870       elsif ($opts{preset} eq 'noalpha') {
1871         # strip the alpha channel
1872         if ($self->getchannels == 2 or $self->getchannels == 4) {
1873           $matrix = _identity($self->getchannels);
1874           pop(@$matrix); # lose the alpha entry
1875         }
1876         else {
1877           $matrix = _identity($self->getchannels);
1878         }
1879       }
1880       elsif ($opts{preset} eq 'red' || $opts{preset} eq 'channel0') {
1881         # extract channel 0
1882         $matrix = [ [ 1 ] ];
1883       }
1884       elsif ($opts{preset} eq 'green' || $opts{preset} eq 'channel1') {
1885         $matrix = [ [ 0, 1 ] ];
1886       }
1887       elsif ($opts{preset} eq 'blue' || $opts{preset} eq 'channel2') {
1888         $matrix = [ [ 0, 0, 1 ] ];
1889       }
1890       elsif ($opts{preset} eq 'alpha') {
1891         if ($self->getchannels == 2 or $self->getchannels == 4) {
1892           $matrix = [ [ (0) x ($self->getchannels-1), 1 ] ];
1893         }
1894         else {
1895           # the alpha is just 1 <shrug>
1896           $matrix = [ [ (0) x $self->getchannels, 1 ] ];
1897         }
1898       }
1899       elsif ($opts{preset} eq 'rgb') {
1900         if ($self->getchannels == 1) {
1901           $matrix = [ [ 1 ], [ 1 ], [ 1 ] ];
1902         }
1903         elsif ($self->getchannels == 2) {
1904           # preserve the alpha channel
1905           $matrix = [ [ 1, 0 ], [ 1, 0 ], [ 1, 0 ], [ 0, 1 ] ];
1906         }
1907         else {
1908           $matrix = _identity($self->getchannels);
1909         }
1910       }
1911       elsif ($opts{preset} eq 'addalpha') {
1912         if ($self->getchannels == 1) {
1913           $matrix = _identity(2);
1914         }
1915         elsif ($self->getchannels == 3) {
1916           $matrix = _identity(4);
1917         }
1918         else {
1919           $matrix = _identity($self->getchannels);
1920         }
1921       }
1922       else {
1923         $self->{ERRSTR} = "Unknown convert preset $opts{preset}";
1924         return undef;
1925       }
1926     }
1927   }
1928   else {
1929     $matrix = $opts{matrix};
1930   }
1931
1932   my $new = Imager->new();
1933   $new->{IMG} = i_img_new();
1934   unless (i_convert($new->{IMG}, $self->{IMG}, $matrix)) {
1935     # most likely a bad matrix
1936     $self->{ERRSTR} = _error_as_msg();
1937     return undef;
1938   }
1939   return $new;
1940 }
1941
1942
1943 # general function to map an image through lookup tables
1944
1945 sub map {
1946   my ($self, %opts) = @_;
1947   my @chlist = qw( red green blue alpha );
1948
1949   if (!exists($opts{'maps'})) {
1950     # make maps from channel maps
1951     my $chnum;
1952     for $chnum (0..$#chlist) {
1953       if (exists $opts{$chlist[$chnum]}) {
1954         $opts{'maps'}[$chnum] = $opts{$chlist[$chnum]};
1955       } elsif (exists $opts{'all'}) {
1956         $opts{'maps'}[$chnum] = $opts{'all'};
1957       }
1958     }
1959   }
1960   if ($opts{'maps'} and $self->{IMG}) {
1961     i_map($self->{IMG}, $opts{'maps'} );
1962   }
1963   return $self;
1964 }
1965
1966 # destructive border - image is shrunk by one pixel all around
1967
1968 sub border {
1969   my ($self,%opts)=@_;
1970   my($tx,$ty)=($self->getwidth()-1,$self->getheight()-1);
1971   $self->polyline('x'=>[0,$tx,$tx,0,0],'y'=>[0,0,$ty,$ty,0],%opts);
1972 }
1973
1974
1975 # Get the width of an image
1976
1977 sub getwidth {
1978   my $self = shift;
1979   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
1980   return (i_img_info($self->{IMG}))[0];
1981 }
1982
1983 # Get the height of an image
1984
1985 sub getheight {
1986   my $self = shift;
1987   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
1988   return (i_img_info($self->{IMG}))[1];
1989 }
1990
1991 # Get number of channels in an image
1992
1993 sub getchannels {
1994   my $self = shift;
1995   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
1996   return i_img_getchannels($self->{IMG});
1997 }
1998
1999 # Get channel mask
2000
2001 sub getmask {
2002   my $self = shift;
2003   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
2004   return i_img_getmask($self->{IMG});
2005 }
2006
2007 # Set channel mask
2008
2009 sub setmask {
2010   my $self = shift;
2011   my %opts = @_;
2012   if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
2013   i_img_setmask( $self->{IMG} , $opts{mask} );
2014 }
2015
2016 # Get number of colors in an image
2017
2018 sub getcolorcount {
2019   my $self=shift;
2020   my %opts=(maxcolors=>2**30,@_);
2021   if (!defined($self->{IMG})) { $self->{ERRSTR}='image is empty'; return undef; }
2022   my $rc=i_count_colors($self->{IMG},$opts{'maxcolors'});
2023   return ($rc==-1? undef : $rc);
2024 }
2025
2026 # draw string to an image
2027
2028 sub string {
2029   my $self = shift;
2030   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2031
2032   my %input=('x'=>0, 'y'=>0, @_);
2033   $input{string}||=$input{text};
2034
2035   unless(exists $input{string}) {
2036     $self->{ERRSTR}="missing required parameter 'string'";
2037     return;
2038   }
2039
2040   unless($input{font}) {
2041     $self->{ERRSTR}="missing required parameter 'font'";
2042     return;
2043   }
2044
2045   unless ($input{font}->draw(image=>$self, %input)) {
2046     $self->{ERRSTR} = $self->_error_as_msg();
2047     return;
2048   }
2049
2050   return $self;
2051 }
2052
2053 # Shortcuts that can be exported
2054
2055 sub newcolor { Imager::Color->new(@_); }
2056 sub newfont  { Imager::Font->new(@_); }
2057
2058 *NC=*newcolour=*newcolor;
2059 *NF=*newfont;
2060
2061 *open=\&read;
2062 *circle=\&arc;
2063
2064
2065 #### Utility routines
2066
2067 sub errstr { 
2068   ref $_[0] ? $_[0]->{ERRSTR} : $ERRSTR
2069 }
2070
2071 # Default guess for the type of an image from extension
2072
2073 sub def_guess_type {
2074   my $name=lc(shift);
2075   my $ext;
2076   $ext=($name =~ m/\.([^\.]+)$/)[0];
2077   return 'tiff' if ($ext =~ m/^tiff?$/);
2078   return 'jpeg' if ($ext =~ m/^jpe?g$/);
2079   return 'pnm'  if ($ext =~ m/^p[pgb]m$/);
2080   return 'png'  if ($ext eq "png");
2081   return 'bmp'  if ($ext eq "bmp" || $ext eq "dib");
2082   return 'tga'  if ($ext eq "tga");
2083   return 'gif'  if ($ext eq "gif");
2084   return ();
2085 }
2086
2087 # get the minimum of a list
2088
2089 sub min {
2090   my $mx=shift;
2091   for(@_) { if ($_<$mx) { $mx=$_; }}
2092   return $mx;
2093 }
2094
2095 # get the maximum of a list
2096
2097 sub max {
2098   my $mx=shift;
2099   for(@_) { if ($_>$mx) { $mx=$_; }}
2100   return $mx;
2101 }
2102
2103 # string stuff for iptc headers
2104
2105 sub clean {
2106   my($str)=$_[0];
2107   $str = substr($str,3);
2108   $str =~ s/[\n\r]//g;
2109   $str =~ s/\s+/ /g;
2110   $str =~ s/^\s//;
2111   $str =~ s/\s$//;
2112   return $str;
2113 }
2114
2115 # A little hack to parse iptc headers.
2116
2117 sub parseiptc {
2118   my $self=shift;
2119   my(@sar,$item,@ar);
2120   my($caption,$photogr,$headln,$credit);
2121
2122   my $str=$self->{IPTCRAW};
2123
2124   #print $str;
2125
2126   @ar=split(/8BIM/,$str);
2127
2128   my $i=0;
2129   foreach (@ar) {
2130     if (/^\004\004/) {
2131       @sar=split(/\034\002/);
2132       foreach $item (@sar) {
2133         if ($item =~ m/^x/) { 
2134           $caption=&clean($item);
2135           $i++;
2136         }
2137         if ($item =~ m/^P/) { 
2138           $photogr=&clean($item);
2139           $i++;
2140         }
2141         if ($item =~ m/^i/) { 
2142           $headln=&clean($item);
2143           $i++;
2144         }
2145         if ($item =~ m/^n/) { 
2146           $credit=&clean($item);
2147           $i++;
2148         }
2149       }
2150     }
2151   }
2152   return (caption=>$caption,photogr=>$photogr,headln=>$headln,credit=>$credit);
2153 }
2154
2155 # Autoload methods go after =cut, and are processed by the autosplit program.
2156
2157 1;
2158 __END__
2159 # Below is the stub of documentation for your module. You better edit it!
2160
2161 =head1 NAME
2162
2163 Imager - Perl extension for Generating 24 bit Images
2164
2165 =head1 SYNOPSIS
2166
2167   use Imager qw(init);
2168
2169   init();
2170   $img = Imager->new();
2171   $img->open(file=>'image.ppm',type=>'pnm')
2172     || print "failed: ",$img->{ERRSTR},"\n";
2173   $scaled=$img->scale(xpixels=>400,ypixels=>400);
2174   $scaled->write(file=>'sc_image.ppm',type=>'pnm')
2175     || print "failed: ",$scaled->{ERRSTR},"\n";
2176
2177 =head1 DESCRIPTION
2178
2179 Imager is a module for creating and altering images - It is not meant
2180 as a replacement or a competitor to ImageMagick or GD. Both are
2181 excellent packages and well supported.
2182
2183 =head2 API
2184
2185 Almost all functions take the parameters in the hash fashion.
2186 Example:
2187
2188   $img->open(file=>'lena.png',type=>'png');
2189
2190 or just:
2191
2192   $img->open(file=>'lena.png');
2193
2194 =head2 Basic concept
2195
2196 An Image object is created with C<$img = Imager-E<gt>new()> Should
2197 this fail for some reason an explanation can be found in
2198 C<$Imager::ERRSTR> usually error messages are stored in
2199 C<$img-E<gt>{ERRSTR}>, but since no object is created this is the only
2200 way to give back errors.  C<$Imager::ERRSTR> is also used to report
2201 all errors not directly associated with an image object. Examples:
2202
2203   $img=Imager->new(); # This is an empty image (size is 0 by 0)
2204   $img->open(file=>'lena.png',type=>'png'); # initializes from file
2205
2206 or if you want to create an empty image:
2207
2208   $img=Imager->new(xsize=>400,ysize=>300,channels=>4);
2209
2210 This example creates a completely black image of width 400 and
2211 height 300 and 4 channels.
2212
2213 If you have an existing image, use img_set() to change it's dimensions
2214 - this will destroy any existing image data:
2215
2216   $img->img_set(xsize=>500, ysize=>500, channels=>4);
2217
2218 To create paletted images, set the 'type' parameter to 'paletted':
2219
2220   $img = Imager->new(xsize=>200, ysize=>200, channels=>3, type=>'paletted');
2221
2222 which creates an image with a maxiumum of 256 colors, which you can
2223 change by supplying the C<maxcolors> parameter.
2224
2225 You can create a new paletted image from an existing image using the
2226 to_paletted() method:
2227
2228  $palimg = $img->to_paletted(\%opts)
2229
2230 where %opts contains the options specified under L<Quantization options>.
2231
2232 You can convert a paletted image (or any image) to an 8-bit/channel
2233 RGB image with:
2234
2235   $rgbimg = $img->to_rgb8;
2236
2237 Warning: if you draw on a paletted image with colors that aren't in
2238 the palette, the image will be internally converted to a normal image.
2239
2240 For improved color precision you can use the bits parameter to specify
2241 16 bit per channel:
2242
2243   $img = Imager->new(xsize=>200, ysize=>200, channels=>3, bits=>16);
2244
2245 or for even more precision:
2246
2247   $img = Imager->new(xsize=>200, ysize=>200, channels=>3, bits=>'double');
2248
2249 to get an image that uses a double for each channel.
2250
2251 Note that as of this writing all functions should work on images with
2252 more than 8-bits/channel, but many will only work at only
2253 8-bit/channel precision.
2254
2255 Currently only 8-bit, 16-bit, and double per channel image types are
2256 available, this may change later.
2257
2258 Color objects are created by calling the Imager::Color->new()
2259 method:
2260
2261   $color = Imager::Color->new($red, $green, $blue);
2262   $color = Imager::Color->new($red, $green, $blue, $alpha);
2263   $color = Imager::Color->new("#C0C0FF"); # html color specification
2264
2265 This object can then be passed to functions that require a color parameter.
2266
2267 Coordinates in Imager have the origin in the upper left corner.  The
2268 horizontal coordinate increases to the right and the vertical
2269 downwards.
2270
2271 =head2 Reading and writing images
2272
2273 C<$img-E<gt>read()> generally takes two parameters, 'file' and 'type'.
2274 If the type of the file can be determined from the suffix of the file
2275 it can be omitted.  Format dependant parameters are: For images of
2276 type 'raw' two extra parameters are needed 'xsize' and 'ysize', if the
2277 'channel' parameter is omitted for type 'raw' it is assumed to be 3.
2278 gif and png images might have a palette are converted to truecolor bit
2279 when read.  Alpha channel is preserved for png images irregardless of
2280 them being in RGB or gray colorspace.  Similarly grayscale jpegs are
2281 one channel images after reading them.  For jpeg images the iptc
2282 header information (stored in the APP13 header) is avaliable to some
2283 degree. You can get the raw header with C<$img-E<gt>{IPTCRAW}>, but
2284 you can also retrieve the most basic information with
2285 C<%hsh=$img-E<gt>parseiptc()> as always patches are welcome.  pnm has no 
2286 extra options. Examples:
2287
2288   $img = Imager->new();
2289   $img->read(file=>"cover.jpg") or die $img->errstr; # gets type from name
2290
2291   $img = Imager->new();
2292   { local(*FH,$/); open(FH,"file.gif") or die $!; $a=<FH>; }
2293   $img->read(data=>$a,type=>'gif') or die $img->errstr;
2294
2295 The second example shows how to read an image from a scalar, this is
2296 usefull if your data originates from somewhere else than a filesystem
2297 such as a database over a DBI connection.
2298
2299 When writing to a tiff image file you can also specify the 'class'
2300 parameter, which can currently take a single value, "fax".  If class
2301 is set to fax then a tiff image which should be suitable for faxing
2302 will be written.  For the best results start with a grayscale image.
2303 By default the image is written at fine resolution you can override
2304 this by setting the "fax_fine" parameter to 0.
2305
2306 If you are reading from a gif image file, you can supply a 'colors'
2307 parameter which must be a reference to a scalar.  The referenced
2308 scalar will receive an array reference which contains the colors, each
2309 represented as an Imager::Color object.
2310
2311 If you already have an open file handle, for example a socket or a
2312 pipe, you can specify the 'fd' parameter instead of supplying a
2313 filename.  Please be aware that you need to use fileno() to retrieve
2314 the file descriptor for the file:
2315
2316   $img->read(fd=>fileno(FILE), type=>'gif') or die $img->errstr;
2317
2318 For writing using the 'fd' option you will probably want to set $| for
2319 that descriptor, since the writes to the file descriptor bypass Perl's
2320 (or the C libraries) buffering.  Setting $| should avoid out of order
2321 output.  For example a common idiom when writing a CGI script is:
2322
2323   # the $| _must_ come before you send the content-type
2324   $| = 1;
2325   print "Content-Type: image/jpeg\n\n";
2326   $img->write(fd=>fileno(STDOUT), type=>'jpeg') or die $img->errstr;
2327
2328 *Note that load() is now an alias for read but will be removed later*
2329
2330 C<$img-E<gt>write> has the same interface as C<read()>.  The earlier
2331 comments on C<read()> for autodetecting filetypes apply.  For jpegs
2332 quality can be adjusted via the 'jpegquality' parameter (0-100).  The
2333 number of colorplanes in gifs are set with 'gifplanes' and should be
2334 between 1 (2 color) and 8 (256 colors).  It is also possible to choose
2335 between two quantizing methods with the parameter 'gifquant'. If set
2336 to mc it uses the mediancut algorithm from either giflibrary. If set
2337 to lm it uses a local means algorithm. It is then possible to give
2338 some extra settings. lmdither is the dither deviation amount in pixels
2339 (manhattan distance).  lmfixed can be an array ref who holds an array
2340 of Imager::Color objects.  Note that the local means algorithm needs
2341 much more cpu time but also gives considerable better results than the
2342 median cut algorithm.
2343
2344 Currently just for gif files, you can specify various options for the
2345 conversion from Imager's internal RGB format to the target's indexed
2346 file format.  If you set the gifquant option to 'gen', you can use the
2347 options specified under L<Quantization options>.
2348
2349 To see what Imager is compiled to support the following code snippet
2350 is sufficient:
2351
2352   use Imager;
2353   print "@{[keys %Imager::formats]}";
2354
2355 When reading raw images you need to supply the width and height of the
2356 image in the xsize and ysize options:
2357
2358   $img->read(file=>'foo.raw', xsize=>100, ysize=>100)
2359     or die "Cannot read raw image\n";
2360
2361 If your input file has more channels than you want, or (as is common),
2362 junk in the fourth channel, you can use the datachannels and
2363 storechannels options to control the number of channels in your input
2364 file and the resulting channels in your image.  For example, if your
2365 input image uses 32-bits per pixel with red, green, blue and junk
2366 values for each pixel you could do:
2367
2368   $img->read(file=>'foo.raw', xsize=>100, ysize=>100, datachannels=>4,
2369              storechannels=>3)
2370     or die "Cannot read raw image\n";
2371
2372 Normally the raw image is expected to have the value for channel 1
2373 immediately following channel 0 and channel 2 immediately following
2374 channel 1 for each pixel.  If your input image has all the channel 0
2375 values for the first line of the image, followed by all the channel 1
2376 values for the first line and so on, you can use the interleave option:
2377
2378   $img->read(file=>'foo.raw', xsize=100, ysize=>100, interleave=>1)
2379     or die "Cannot read raw image\n";
2380
2381 =head2 Multi-image files
2382
2383 Currently just for gif files, you can create files that contain more
2384 than one image.
2385
2386 To do this:
2387
2388   Imager->write_multi(\%opts, @images)
2389
2390 Where %opts describes 4 possible types of outputs:
2391
2392 =over 5
2393
2394 =item type
2395
2396 This is C<gif> for gif animations.
2397
2398 =item callback
2399
2400 A code reference which is called with a single parameter, the data to
2401 be written.  You can also specify $opts{maxbuffer} which is the
2402 maximum amount of data buffered.  Note that there can be larger writes
2403 than this if the file library writes larger blocks.  A smaller value
2404 maybe useful for writing to a socket for incremental display.
2405
2406 =item fd
2407
2408 The file descriptor to save the images to.
2409
2410 =item file
2411
2412 The name of the file to write to.
2413
2414 %opts may also include the keys from L<Gif options> and L<Quantization
2415 options>.
2416
2417 =back
2418
2419 You must also specify the file format using the 'type' option.
2420
2421 The current aim is to support other multiple image formats in the
2422 future, such as TIFF, and to support reading multiple images from a
2423 single file.
2424
2425 A simple example:
2426
2427     my @images;
2428     # ... code to put images in @images
2429     Imager->write_multi({type=>'gif',
2430                          file=>'anim.gif',
2431                          gif_delays=>[ (10) x @images ] },
2432                         @images)
2433     or die "Oh dear!";
2434
2435 You can read multi-image files (currently only GIF files) using the
2436 read_multi() method:
2437
2438   my @imgs = Imager->read_multi(file=>'foo.gif')
2439     or die "Cannot read images: ",Imager->errstr;
2440
2441 The possible parameters for read_multi() are:
2442
2443 =over
2444
2445 =item file
2446
2447 The name of the file to read in.
2448
2449 =item fh
2450
2451 A filehandle to read in.  This can be the name of a filehandle, but it
2452 will need the package name, no attempt is currently made to adjust
2453 this to the caller's package.
2454
2455 =item fd
2456
2457 The numeric file descriptor of an open file (or socket).
2458
2459 =item callback
2460
2461 A function to be called to read in data, eg. reading a blob from a
2462 database incrementally.
2463
2464 =item data
2465
2466 The data of the input file in memory.
2467
2468 =item type
2469
2470 The type of file.  If the file is parameter is given and provides
2471 enough information to guess the type, then this parameter is optional.
2472
2473 =back
2474
2475 Note: you cannot use the callback or data parameter with giflib
2476 versions before 4.0.
2477
2478 When reading from a GIF file with read_multi() the images are returned
2479 as paletted images.
2480
2481 =head2 Gif options
2482
2483 These options can be specified when calling write_multi() for gif
2484 files, when writing a single image with the gifquant option set to
2485 'gen', or for direct calls to i_writegif_gen and i_writegif_callback.
2486
2487 Note that some viewers will ignore some of these options
2488 (gif_user_input in particular).
2489
2490 =over 4
2491
2492 =item gif_each_palette
2493
2494 Each image in the gif file has it's own palette if this is non-zero.
2495 All but the first image has a local colour table (the first uses the
2496 global colour table.
2497
2498 =item interlace
2499
2500 The images are written interlaced if this is non-zero.
2501
2502 =item gif_delays
2503
2504 A reference to an array containing the delays between images, in 1/100
2505 seconds.
2506
2507 If you want the same delay for every frame you can simply set this to
2508 the delay in 1/100 seconds.
2509
2510 =item gif_user_input
2511
2512 A reference to an array contains user input flags.  If the given flag
2513 is non-zero the image viewer should wait for input before displaying
2514 the next image.
2515
2516 =item gif_disposal
2517
2518 A reference to an array of image disposal methods.  These define what
2519 should be done to the image before displaying the next one.  These are
2520 integers, where 0 means unspecified, 1 means the image should be left
2521 in place, 2 means restore to background colour and 3 means restore to
2522 the previous value.
2523
2524 =item gif_tran_color
2525
2526 A reference to an Imager::Color object, which is the colour to use for
2527 the palette entry used to represent transparency in the palette.  You
2528 need to set the transp option (see L<Quantization options>) for this
2529 value to be used.
2530
2531 =item gif_positions
2532
2533 A reference to an array of references to arrays which represent screen
2534 positions for each image.
2535
2536 =item gif_loop_count
2537
2538 If this is non-zero the Netscape loop extension block is generated,
2539 which makes the animation of the images repeat.
2540
2541 This is currently unimplemented due to some limitations in giflib.
2542
2543 =item gif_eliminate_unused
2544
2545 If this is true, when you write a paletted image any unused colors
2546 will be eliminated from its palette.  This is set by default.
2547
2548 =back
2549
2550 =head2 Quantization options
2551
2552 These options can be specified when calling write_multi() for gif
2553 files, when writing a single image with the gifquant option set to
2554 'gen', or for direct calls to i_writegif_gen and i_writegif_callback.
2555
2556 =over 4
2557
2558 =item colors
2559
2560 A arrayref of colors that are fixed.  Note that some color generators
2561 will ignore this.
2562
2563 =item transp
2564
2565 The type of transparency processing to perform for images with an
2566 alpha channel where the output format does not have a proper alpha
2567 channel (eg. gif).  This can be any of:
2568
2569 =over 4
2570
2571 =item none
2572
2573 No transparency processing is done. (default)
2574
2575 =item threshold
2576
2577 Pixels more transparent that tr_threshold are rendered as transparent.
2578
2579 =item errdiff
2580
2581 An error diffusion dither is done on the alpha channel.  Note that
2582 this is independent of the translation performed on the colour
2583 channels, so some combinations may cause undesired artifacts.
2584
2585 =item ordered
2586
2587 The ordered dither specified by tr_orddith is performed on the alpha
2588 channel.
2589
2590 =back
2591
2592 This will only be used if the image has an alpha channel, and if there
2593 is space in the palette for a transparency colour.
2594
2595 =item tr_threshold
2596
2597 The highest alpha value at which a pixel will be made transparent when
2598 transp is 'threshold'. (0-255, default 127)
2599
2600 =item tr_errdiff
2601
2602 The type of error diffusion to perform on the alpha channel when
2603 transp is 'errdiff'.  This can be any defined error diffusion type
2604 except for custom (see errdiff below).
2605
2606 =item tr_orddith
2607
2608 The type of ordered dither to perform on the alpha channel when transp
2609 is 'ordered'.  Possible values are:
2610
2611 =over 4
2612
2613 =item random
2614
2615 A semi-random map is used.  The map is the same each time.
2616
2617 =item dot8
2618
2619 8x8 dot dither.
2620
2621 =item dot4
2622
2623 4x4 dot dither
2624
2625 =item hline
2626
2627 horizontal line dither.
2628
2629 =item vline
2630
2631 vertical line dither.
2632
2633 =item "/line"
2634
2635 =item slashline
2636
2637 diagonal line dither
2638
2639 =item '\line'
2640
2641 =item backline
2642
2643 diagonal line dither
2644
2645 =item tiny
2646
2647 dot matrix dither (currently the default).  This is probably the best
2648 for displays (like web pages).
2649
2650 =item custom
2651
2652 A custom dither matrix is used - see tr_map
2653
2654 =back
2655
2656 =item tr_map
2657
2658 When tr_orddith is custom this defines an 8 x 8 matrix of integers
2659 representing the transparency threshold for pixels corresponding to
2660 each position.  This should be a 64 element array where the first 8
2661 entries correspond to the first row of the matrix.  Values should be
2662 betweern 0 and 255.
2663
2664 =item make_colors
2665
2666 Defines how the quantization engine will build the palette(s).
2667 Currently this is ignored if 'translate' is 'giflib', but that may
2668 change.  Possible values are:
2669
2670 =over 4
2671
2672 =item none
2673
2674 Only colors supplied in 'colors' are used.
2675
2676 =item webmap
2677
2678 The web color map is used (need url here.)
2679
2680 =item addi
2681
2682 The original code for generating the color map (Addi's code) is used.
2683
2684 =back
2685
2686 Other methods may be added in the future.
2687
2688 =item colors
2689
2690 A arrayref containing Imager::Color objects, which represents the
2691 starting set of colors to use in translating the images.  webmap will
2692 ignore this.  The final colors used are copied back into this array
2693 (which is expanded if necessary.)
2694
2695 =item max_colors
2696
2697 The maximum number of colors to use in the image.
2698
2699 =item translate
2700
2701 The method used to translate the RGB values in the source image into
2702 the colors selected by make_colors.  Note that make_colors is ignored
2703 whene translate is 'giflib'.
2704
2705 Possible values are:
2706
2707 =over 4
2708
2709 =item giflib
2710
2711 The giflib native quantization function is used.
2712
2713 =item closest
2714
2715 The closest color available is used.
2716
2717 =item perturb
2718
2719 The pixel color is modified by perturb, and the closest color is chosen.
2720
2721 =item errdiff
2722
2723 An error diffusion dither is performed.
2724
2725 =back
2726
2727 It's possible other transate values will be added.
2728
2729 =item errdiff
2730
2731 The type of error diffusion dither to perform.  These values (except
2732 for custom) can also be used in tr_errdif.
2733
2734 =over 4
2735
2736 =item floyd
2737
2738 Floyd-Steinberg dither
2739
2740 =item jarvis
2741
2742 Jarvis, Judice and Ninke dither
2743
2744 =item stucki
2745
2746 Stucki dither
2747
2748 =item custom
2749
2750 Custom.  If you use this you must also set errdiff_width,
2751 errdiff_height and errdiff_map.
2752
2753 =back
2754
2755 =item errdiff_width
2756
2757 =item errdiff_height
2758
2759 =item errdiff_orig
2760
2761 =item errdiff_map
2762
2763 When translate is 'errdiff' and errdiff is 'custom' these define a
2764 custom error diffusion map.  errdiff_width and errdiff_height define
2765 the size of the map in the arrayref in errdiff_map.  errdiff_orig is
2766 an integer which indicates the current pixel position in the top row
2767 of the map.
2768
2769 =item perturb
2770
2771 When translate is 'perturb' this is the magnitude of the random bias
2772 applied to each channel of the pixel before it is looked up in the
2773 color table.
2774
2775 =back
2776
2777 =head2 Obtaining/setting attributes of images
2778
2779 To get the size of an image in pixels the C<$img-E<gt>getwidth()> and
2780 C<$img-E<gt>getheight()> are used.
2781
2782 To get the number of channels in
2783 an image C<$img-E<gt>getchannels()> is used.  $img-E<gt>getmask() and
2784 $img-E<gt>setmask() are used to get/set the channel mask of the image.
2785
2786   $mask=$img->getmask();
2787   $img->setmask(mask=>1+2); # modify red and green only
2788   $img->setmask(mask=>8); # modify alpha only
2789   $img->setmask(mask=>$mask); # restore previous mask
2790
2791 The mask of an image describes which channels are updated when some
2792 operation is performed on an image.  Naturally it is not possible to
2793 apply masks to operations like scaling that alter the dimensions of
2794 images.
2795
2796 It is possible to have Imager find the number of colors in an image
2797 by using C<$img-E<gt>getcolorcount()>. It requires memory proportionally
2798 to the number of colors in the image so it is possible to have it
2799 stop sooner if you only need to know if there are more than a certain number
2800 of colors in the image.  If there are more colors than asked for
2801 the function return undef.  Examples:
2802
2803   if (!defined($img->getcolorcount(maxcolors=>512)) {
2804     print "Less than 512 colors in image\n";
2805   }
2806
2807 The bits() method retrieves the number of bits used to represent each
2808 channel in a pixel, 8 for a normal image, 16 for 16-bit image and
2809 'double' for a double/channel image.  The type() method returns either
2810 'direct' for truecolor images or 'paletted' for paletted images.  The
2811 virtual() method returns non-zero if the image contains no actual
2812 pixels, for example masked images.
2813
2814 =head2 Paletted Images
2815
2816 In general you can work with paletted images in the same way as RGB
2817 images, except that if you attempt to draw to a paletted image with a
2818 color that is not in the image's palette, the image will be converted
2819 to an RGB image.  This means that drawing on a paletted image with
2820 anti-aliasing enabled will almost certainly convert the image to RGB.
2821
2822 You can add colors to a paletted image with the addcolors() method:
2823
2824    my @colors = ( Imager::Color->new(255, 0, 0), 
2825                   Imager::Color->new(0, 255, 0) );
2826    my $index = $img->addcolors(colors=>\@colors);
2827
2828 The return value is the index of the first color added, or undef if
2829 adding the colors would overflow the palette.
2830
2831 Once you have colors in the palette you can overwrite them with the
2832 setcolors() method:
2833
2834   $img->setcolors(start=>$start, colors=>\@colors);
2835
2836 Returns true on success.
2837
2838 To retrieve existing colors from the palette use the getcolors() method:
2839
2840   # get the whole palette
2841   my @colors = $img->getcolors();
2842   # get a single color
2843   my $color = $img->getcolors(start=>$index);
2844   # get a range of colors
2845   my @colors = $img->getcolors(start=>$index, count=>$count);
2846
2847 To quickly find a color in the palette use findcolor():
2848
2849   my $index = $img->findcolor(color=>$color);
2850
2851 which returns undef on failure, or the index of the color.
2852
2853 You can get the current palette size with $img->colorcount, and the
2854 maximum size of the palette with $img->maxcolors.
2855
2856 =head2 Drawing Methods
2857
2858 IMPLEMENTATION MORE OR LESS DONE CHECK THE TESTS
2859 DOCUMENTATION OF THIS SECTION OUT OF SYNC
2860
2861 It is possible to draw with graphics primitives onto images.  Such
2862 primitives include boxes, arcs, circles and lines.  A reference
2863 oriented list follows.
2864
2865 Box:
2866   $img->box(color=>$blue,xmin=>10,ymin=>30,xmax=>200,ymax=>300,filled=>1);
2867
2868 The above example calls the C<box> method for the image and the box
2869 covers the pixels with in the rectangle specified.  If C<filled> is
2870 ommited it is drawn as an outline.  If any of the edges of the box are
2871 ommited it will snap to the outer edge of the image in that direction.
2872 Also if a color is omitted a color with (255,255,255,255) is used
2873 instead.
2874
2875 Arc:
2876   $img->arc(color=>$red, r=20, x=>200, y=>100, d1=>10, d2=>20 );
2877
2878 This creates a filled red arc with a 'center' at (200, 100) and spans
2879 10 degrees and the slice has a radius of 20. SEE section on BUGS.
2880
2881 Both the arc() and box() methods can take a C<fill> parameter which
2882 can either be an Imager::Fill object, or a reference to a hash
2883 containing the parameters used to create the fill:
2884
2885   $img->box(xmin=>10, ymin=>30, xmax=>150, ymax=>60,
2886             fill => { hatch=>'cross2' });
2887   use Imager::Fill;
2888   my $fill = Imager::Fill->new(hatch=>'stipple');
2889   $img->box(fill=>$fill);
2890
2891 See L<Imager::Fill> for the type of fills you can use.
2892
2893 Circle:
2894   $img->circle(color=>$green, r=50, x=>200, y=>100);
2895
2896 This creates a green circle with its center at (200, 100) and has a
2897 radius of 20.
2898
2899 Line:
2900   $img->line(color=>$green, x1=10, x2=>100, 
2901                             y1=>20, y2=>50, antialias=>1 );
2902
2903 That draws an antialiased line from (10,100) to (20,50).
2904
2905 Polyline:
2906   $img->polyline(points=>[[$x0,$y0],[$x1,$y1],[$x2,$y2]],color=>$red);
2907   $img->polyline(x=>[$x0,$x1,$x2], y=>[$y0,$y1,$y2], antialias=>1);
2908
2909 Polyline is used to draw multilple lines between a series of points.
2910 The point set can either be specified as an arrayref to an array of
2911 array references (where each such array represents a point).  The
2912 other way is to specify two array references.
2913
2914 You can fill a region that all has the same color using the
2915 flood_fill() method, for example:
2916
2917   $img->flood_fill(x=>50, y=>50, color=>$color);
2918
2919 will fill all regions the same color connected to the point (50, 50).
2920
2921 You can also use a general fill, so you could fill the same region
2922 with a check pattern using:
2923
2924   $img->flood_fill(x=>50, y=>50, fill=>{ hatch=>'check2x2' });
2925
2926 See L<Imager::Fill> for more information on general fills.
2927
2928 =head2 Text rendering
2929
2930 Text rendering is described in the Imager::Font manpage.
2931
2932 =head2 Image resizing
2933
2934 To scale an image so porportions are maintained use the
2935 C<$img-E<gt>scale()> method.  if you give either a xpixels or ypixels
2936 parameter they will determine the width or height respectively.  If
2937 both are given the one resulting in a larger image is used.  example:
2938 C<$img> is 700 pixels wide and 500 pixels tall.
2939
2940   $img->scale(xpixels=>400); # 400x285
2941   $img->scale(ypixels=>400); # 560x400
2942
2943   $img->scale(xpixels=>400,ypixels=>400); # 560x400
2944   $img->scale(xpixels=>400,ypixels=>400,type=>min); # 400x285
2945
2946   $img->scale(scalefactor=>0.25); 175x125 $img->scale(); # 350x250
2947
2948 if you want to create low quality previews of images you can pass
2949 C<qtype=E<gt>'preview'> to scale and it will use nearest neighbor
2950 sampling instead of filtering. It is much faster but also generates
2951 worse looking images - especially if the original has a lot of sharp
2952 variations and the scaled image is by more than 3-5 times smaller than
2953 the original.
2954
2955 If you need to scale images per axis it is best to do it simply by
2956 calling scaleX and scaleY.  You can pass either 'scalefactor' or
2957 'pixels' to both functions.
2958
2959 Another way to resize an image size is to crop it.  The parameters
2960 to crop are the edges of the area that you want in the returned image.
2961 If a parameter is omited a default is used instead.
2962
2963   $newimg = $img->crop(left=>50, right=>100, top=>10, bottom=>100); 
2964   $newimg = $img->crop(left=>50, top=>10, width=>50, height=>90);
2965   $newimg = $img->crop(left=>50, right=>100); # top 
2966
2967 You can also specify width and height parameters which will produce a
2968 new image cropped from the center of the input image, with the given
2969 width and height.
2970
2971   $newimg = $img->crop(width=>50, height=>50);
2972
2973 The width and height parameters take precedence over the left/right
2974 and top/bottom parameters respectively.
2975
2976 =head2 Copying images
2977
2978 To create a copy of an image use the C<copy()> method.  This is usefull
2979 if you want to keep an original after doing something that changes the image
2980 inplace like writing text.
2981
2982   $img=$orig->copy();
2983
2984 To copy an image to onto another image use the C<paste()> method.
2985
2986   $dest->paste(left=>40,top=>20,img=>$logo);
2987
2988 That copies the entire C<$logo> image onto the C<$dest> image so that the
2989 upper left corner of the C<$logo> image is at (40,20).
2990
2991
2992 =head2 Flipping images
2993
2994 An inplace horizontal or vertical flip is possible by calling the
2995 C<flip()> method.  If the original is to be preserved it's possible to
2996 make a copy first.  The only parameter it takes is the C<dir>
2997 parameter which can take the values C<h>, C<v>, C<vh> and C<hv>.
2998
2999   $img->flip(dir=>"h");       # horizontal flip
3000   $img->flip(dir=>"vh");      # vertical and horizontal flip
3001   $nimg = $img->copy->flip(dir=>"v"); # make a copy and flip it vertically
3002
3003 =head2 Rotating images
3004
3005 Use the rotate() method to rotate an image.  This method will return a
3006 new, rotated image.
3007
3008 To rotate by an exact amount in degrees or radians, use the 'degrees'
3009 or 'radians' parameter:
3010
3011   my $rot20 = $img->rotate(degrees=>20);
3012   my $rotpi4 = $img->rotate(radians=>3.14159265/4);
3013
3014 Exact image rotation uses the same underlying transformation engine as
3015 the matrix_transform() method.
3016
3017 To rotate in steps of 90 degrees, use the 'right' parameter:
3018
3019   my $rotated = $img->rotate(right=>270);
3020
3021 Rotations are clockwise for positive values.
3022
3023 =head2 Blending Images
3024
3025 To put an image or a part of an image directly
3026 into another it is best to call the C<paste()> method on the image you
3027 want to add to.
3028
3029   $img->paste(img=>$srcimage,left=>30,top=>50);
3030
3031 That will take paste C<$srcimage> into C<$img> with the upper
3032 left corner at (30,50).  If no values are given for C<left>
3033 or C<top> they will default to 0.
3034
3035 A more complicated way of blending images is where one image is
3036 put 'over' the other with a certain amount of opaqueness.  The
3037 method that does this is rubthrough.
3038
3039   $img->rubthrough(src=>$srcimage,tx=>30,ty=>50);
3040
3041 That will take the image C<$srcimage> and overlay it with the upper
3042 left corner at (30,50).  You can rub 2 or 4 channel images onto a 3
3043 channel image, or a 2 channel image onto a 1 channel image.  The last
3044 channel is used as an alpha channel.
3045
3046
3047 =head2 Filters
3048
3049 A special image method is the filter method. An example is:
3050
3051   $img->filter(type=>'autolevels');
3052
3053 This will call the autolevels filter.  Here is a list of the filters
3054 that are always avaliable in Imager.  This list can be obtained by
3055 running the C<filterlist.perl> script that comes with the module
3056 source.
3057
3058   Filter          Arguments
3059   autolevels      lsat(0.1) usat(0.1) skew(0)
3060   bumpmap         bump elevation(0) lightx lighty st(2)
3061   bumpmap_complex bump channel(0) tx(0) ty(0) Lx(0.2) Ly(0.4)
3062                   Lz(-1) cd(1.0) cs(40.0) n(1.3) Ia(0 0 0) Il(255 255 255)
3063                   Is(255 255 255)
3064   contrast        intensity
3065   conv            coef
3066   fountain        xa ya xb yb ftype(linear) repeat(none) combine(none)
3067                   super_sample(none) ssample_param(4) segments(see below)
3068   gaussian        stddev
3069   gradgen         xo yo colors dist
3070   hardinvert
3071   mosaic          size(20)
3072   noise           amount(3) subtype(0)
3073   postlevels      levels(10)
3074   radnoise        xo(100) yo(100) ascale(17.0) rscale(0.02)
3075   turbnoise       xo(0.0) yo(0.0) scale(10.0)
3076   unsharpmask     stddev(2.0) scale(1.0)
3077   watermark       wmark pixdiff(10) tx(0) ty(0)
3078
3079 The default values are in parenthesis.  All parameters must have some
3080 value but if a parameter has a default value it may be omitted when
3081 calling the filter function.
3082
3083 The filters are:
3084
3085 =over
3086
3087 =item autolevels
3088
3089 scales the value of each channel so that the values in the image will
3090 cover the whole possible range for the channel.  I<lsat> and I<usat>
3091 truncate the range by the specified fraction at the top and bottom of
3092 the range respectivly..
3093
3094 =item bumpmap
3095
3096 uses the channel I<elevation> image I<bump> as a bumpmap on your
3097 image, with the light at (I<lightx>, I<lightty>), with a shadow length
3098 of I<st>.
3099
3100 =item bumpmap_complex
3101
3102 uses the channel I<channel> image I<bump> as a bumpmap on your image.
3103 If Lz<0 the three L parameters are considered to be the direction of
3104 the light.  If Lz>0 the L parameters are considered to be the light
3105 position.  I<Ia> is the ambient colour, I<Il> is the light colour,
3106 I<Is> is the color of specular highlights.  I<cd> is the diffuse
3107 coefficient and I<cs> is the specular coefficient.  I<n> is the
3108 shininess of the surface.
3109
3110 =item contrast
3111
3112 scales each channel by I<intensity>.  Values of I<intensity> < 1.0
3113 will reduce the contrast.
3114
3115 =item conv
3116
3117 performs 2 1-dimensional convolutions on the image using the values
3118 from I<coef>.  I<coef> should be have an odd length.
3119
3120 =item fountain
3121
3122 renders a fountain fill, similar to the gradient tool in most paint
3123 software.  The default fill is a linear fill from opaque black to
3124 opaque white.  The points A(xa, ya) and B(xb, yb) control the way the
3125 fill is performed, depending on the ftype parameter:
3126
3127 =over
3128
3129 =item linear
3130
3131 the fill ramps from A through to B.
3132
3133 =item bilinear
3134
3135 the fill ramps in both directions from A, where AB defines the length
3136 of the gradient.
3137
3138 =item radial
3139
3140 A is the center of a circle, and B is a point on it's circumference.
3141 The fill ramps from the center out to the circumference.
3142
3143 =item radial_square
3144
3145 A is the center of a square and B is the center of one of it's sides.
3146 This can be used to rotate the square.  The fill ramps out to the
3147 edges of the square.
3148
3149 =item revolution
3150
3151 A is the centre of a circle and B is a point on it's circumference.  B
3152 marks the 0 and 360 point on the circle, with the fill ramping
3153 clockwise.
3154
3155 =item conical
3156
3157 A is the center of a circle and B is a point on it's circumference.  B
3158 marks the 0 and point on the circle, with the fill ramping in both
3159 directions to meet opposite.
3160
3161 =back
3162
3163 The I<repeat> option controls how the fill is repeated for some
3164 I<ftype>s after it leaves the AB range:
3165
3166 =over
3167
3168 =item none
3169
3170 no repeats, points outside of each range are treated as if they were
3171 on the extreme end of that range.
3172
3173 =item sawtooth
3174
3175 the fill simply repeats in the positive direction
3176
3177 =item triangle
3178
3179 the fill repeats in reverse and then forward and so on, in the
3180 positive direction
3181
3182 =item saw_both
3183
3184 the fill repeats in both the positive and negative directions (only
3185 meaningful for a linear fill).
3186
3187 =item tri_both
3188
3189 as for triangle, but in the negative direction too (only meaningful
3190 for a linear fill).
3191
3192 =back
3193
3194 By default the fill simply overwrites the whole image (unless you have
3195 parts of the range 0 through 1 that aren't covered by a segment), if
3196 any segments of your fill have any transparency, you can set the
3197 I<combine> option to 'normal' to have the fill combined with the
3198 existing pixels.  See the description of I<combine> in L<Imager/Fill>.
3199
3200 If your fill has sharp edges, for example between steps if you use
3201 repeat set to 'triangle', you may see some aliased or ragged edges.
3202 You can enable super-sampling which will take extra samples within the
3203 pixel in an attempt anti-alias the fill.
3204
3205 The possible values for the super_sample option are:
3206
3207 =over
3208
3209 =item none
3210
3211 no super-sampling is done
3212
3213 =item grid
3214
3215 a square grid of points are sampled.  The number of points sampled is
3216 the square of ceil(0.5 + sqrt(ssample_param)).
3217
3218 =item random
3219
3220 a random set of points within the pixel are sampled.  This looks
3221 pretty bad for low ssample_param values.  
3222
3223 =item circle
3224
3225 the points on the radius of a circle within the pixel are sampled.
3226 This seems to produce the best results, but is fairly slow (for now).
3227
3228 =back
3229
3230 You can control the level of sampling by setting the ssample_param
3231 option.  This is roughly the number of points sampled, but depends on
3232 the type of sampling.
3233
3234 The segments option is an arrayref of segments.  You really should use
3235 the Imager::Fountain class to build your fountain fill.  Each segment
3236 is an array ref containing:
3237
3238 =over
3239
3240 =item start
3241
3242 a floating point number between 0 and 1, the start of the range of fill parameters covered by this segment.
3243
3244 =item middle
3245
3246 a floating point number between start and end which can be used to
3247 push the color range towards one end of the segment.
3248
3249 =item end
3250
3251 a floating point number between 0 and 1, the end of the range of fill
3252 parameters covered by this segment.  This should be greater than
3253 start.
3254
3255 =item c0 
3256
3257 =item c1
3258
3259 The colors at each end of the segment.  These can be either
3260 Imager::Color or Imager::Color::Float objects.
3261
3262 =item segment type
3263
3264 The type of segment, this controls the way the fill parameter varies
3265 over the segment. 0 for linear, 1 for curved (unimplemented), 2 for
3266 sine, 3 for sphere increasing, 4 for sphere decreasing.
3267
3268 =item color type
3269
3270 The way the color varies within the segment, 0 for simple RGB, 1 for
3271 hue increasing and 2 for hue decreasing.
3272
3273 =back
3274
3275 Don't forgot to use Imager::Fountain instead of building your own.
3276 Really.  It even loads GIMP gradient files.
3277
3278 =item gaussian
3279
3280 performs a gaussian blur of the image, using I<stddev> as the standard
3281 deviation of the curve used to combine pixels, larger values give
3282 bigger blurs.  For a definition of Gaussian Blur, see:
3283
3284   http://www.maths.abdn.ac.uk/~igc/tch/mx4002/notes/node99.html
3285
3286 =item gradgen
3287
3288 renders a gradient, with the given I<colors> at the corresponding
3289 points (x,y) in I<xo> and I<yo>.  You can specify the way distance is
3290 measured for color blendeing by setting I<dist> to 0 for Euclidean, 1
3291 for Euclidean squared, and 2 for Manhattan distance.
3292
3293 =item hardinvert
3294
3295 inverts the image, black to white, white to black.  All channels are
3296 inverted, including the alpha channel if any.
3297
3298 =item mosaic
3299
3300 produces averaged tiles of the given I<size>.
3301
3302 =item noise
3303
3304 adds noise of the given I<amount> to the image.  If I<subtype> is
3305 zero, the noise is even to each channel, otherwise noise is added to
3306 each channel independently.
3307
3308 =item radnoise
3309
3310 renders radiant Perlin turbulent noise.  The centre of the noise is at
3311 (I<xo>, I<yo>), I<ascale> controls the angular scale of the noise ,
3312 and I<rscale> the radial scale, higher numbers give more detail.
3313
3314 =item postlevels
3315
3316 alters the image to have only I<levels> distinct level in each
3317 channel.
3318
3319 =item turbnoise
3320
3321 renders Perlin turbulent noise.  (I<xo>, I<yo>) controls the origin of
3322 the noise, and I<scale> the scale of the noise, with lower numbers
3323 giving more detail.
3324
3325 =item unsharpmask
3326
3327 performs an unsharp mask on the image.  This is the result of
3328 subtracting a gaussian blurred version of the image from the original.
3329 I<stddev> controls the stddev parameter of the gaussian blur.  Each
3330 output pixel is: in + I<scale> * (in - blurred).
3331
3332 =item watermark
3333
3334 applies I<wmark> as a watermark on the image with strength I<pixdiff>,
3335 with an origin at (I<tx>, I<ty>)
3336
3337 =back
3338
3339 A demonstration of most of the filters can be found at:
3340
3341   http://www.develop-help.com/imager/filters.html
3342
3343 (This is a slow link.)
3344
3345 =head2 Color transformations
3346
3347 You can use the convert method to transform the color space of an
3348 image using a matrix.  For ease of use some presets are provided.
3349
3350 The convert method can be used to:
3351
3352 =over 4
3353
3354 =item *
3355
3356 convert an RGB or RGBA image to grayscale.
3357
3358 =item *
3359
3360 convert a grayscale image to RGB.
3361
3362 =item *
3363
3364 extract a single channel from an image.
3365
3366 =item *
3367
3368 set a given channel to a particular value (or from another channel)
3369
3370 =back
3371
3372 The currently defined presets are:
3373
3374 =over
3375
3376 =item gray
3377
3378 =item grey
3379
3380 converts an RGBA image into a grayscale image with alpha channel, or
3381 an RGB image into a grayscale image without an alpha channel.
3382
3383 This weights the RGB channels at 22.2%, 70.7% and 7.1% respectively.
3384
3385 =item noalpha
3386
3387 removes the alpha channel from a 2 or 4 channel image.  An identity
3388 for other images.
3389
3390 =item red
3391
3392 =item channel0
3393
3394 extracts the first channel of the image into a single channel image
3395
3396 =item green
3397
3398 =item channel1
3399
3400 extracts the second channel of the image into a single channel image
3401
3402 =item blue
3403
3404 =item channel2
3405
3406 extracts the third channel of the image into a single channel image
3407
3408 =item alpha
3409
3410 extracts the alpha channel of the image into a single channel image.
3411
3412 If the image has 1 or 3 channels (assumed to be grayscale of RGB) then
3413 the resulting image will be all white.
3414
3415 =item rgb
3416
3417 converts a grayscale image to RGB, preserving the alpha channel if any
3418
3419 =item addalpha
3420
3421 adds an alpha channel to a grayscale or RGB image.  Preserves an
3422 existing alpha channel for a 2 or 4 channel image.
3423
3424 =back
3425
3426 For example, to convert an RGB image into a greyscale image:
3427
3428   $new = $img->convert(preset=>'grey'); # or gray
3429
3430 or to convert a grayscale image to an RGB image:
3431
3432   $new = $img->convert(preset=>'rgb');
3433
3434 The presets aren't necessary simple constants in the code, some are
3435 generated based on the number of channels in the input image.
3436
3437 If you want to perform some other colour transformation, you can use
3438 the 'matrix' parameter.
3439
3440 For each output pixel the following matrix multiplication is done:
3441
3442      channel[0]       [ [ $c00, $c01, ...  ]        inchannel[0]
3443    [     ...      ] =          ...              x [     ...        ]
3444      channel[n-1]       [ $cn0, ...,  $cnn ] ]      inchannel[max]
3445                                                           1
3446
3447 So if you want to swap the red and green channels on a 3 channel image:
3448
3449   $new = $img->convert(matrix=>[ [ 0, 1, 0 ],
3450                                  [ 1, 0, 0 ],
3451                                  [ 0, 0, 1 ] ]);
3452
3453 or to convert a 3 channel image to greyscale using equal weightings:
3454
3455   $new = $img->convert(matrix=>[ [ 0.333, 0.333, 0.334 ] ])
3456
3457 =head2 Color Mappings
3458
3459 You can use the map method to map the values of each channel of an
3460 image independently using a list of lookup tables.  It's important to
3461 realize that the modification is made inplace.  The function simply
3462 returns the input image again or undef on failure.
3463
3464 Each channel is mapped independently through a lookup table with 256
3465 entries.  The elements in the table should not be less than 0 and not
3466 greater than 255.  If they are out of the 0..255 range they are
3467 clamped to the range.  If a table does not contain 256 entries it is
3468 silently ignored.
3469
3470 Single channels can mapped by specifying their name and the mapping
3471 table.  The channel names are C<red>, C<green>, C<blue>, C<alpha>.
3472
3473   @map = map { int( $_/2 } 0..255;
3474   $img->map( red=>\@map );
3475
3476 It is also possible to specify a single map that is applied to all
3477 channels, alpha channel included.  For example this applies a gamma
3478 correction with a gamma of 1.4 to the input image.
3479
3480   $gamma = 1.4;
3481   @map = map { int( 0.5 + 255*($_/255)**$gamma ) } 0..255;
3482   $img->map(all=> \@map);
3483
3484 The C<all> map is used as a default channel, if no other map is
3485 specified for a channel then the C<all> map is used instead.  If we
3486 had not wanted to apply gamma to the alpha channel we would have used:
3487
3488   $img->map(all=> \@map, alpha=>[]);
3489
3490 Since C<[]> contains fewer than 256 element the gamma channel is
3491 unaffected.
3492
3493 It is also possible to simply specify an array of maps that are
3494 applied to the images in the rgba order.  For example to apply
3495 maps to the C<red> and C<blue> channels one would use:
3496
3497   $img->map(maps=>[\@redmap, [], \@bluemap]);
3498
3499
3500
3501 =head2 Transformations
3502
3503 Another special image method is transform.  It can be used to generate
3504 warps and rotations and such features.  It can be given the operations
3505 in postfix notation or the module Affix::Infix2Postfix can be used.
3506 Look in the test case t/t55trans.t for an example.
3507
3508 transform() needs expressions (or opcodes) that determine the source
3509 pixel for each target pixel.  Source expressions are infix expressions
3510 using any of the +, -, *, / or ** binary operators, the - unary
3511 operator, ( and ) for grouping and the sin() and cos() functions.  The
3512 target pixel is input as the variables x and y.
3513
3514 You specify the x and y expressions as xexpr and yexpr respectively.
3515 You can also specify opcodes directly, but that's magic deep enough
3516 that you can look at the source code.
3517
3518 You can still use the transform() function, but the transform2()
3519 function is just as fast and is more likely to be enhanced and
3520 maintained.
3521
3522 Later versions of Imager also support a transform2() class method
3523 which allows you perform a more general set of operations, rather than
3524 just specifying a spatial transformation as with the transform()
3525 method, you can also perform colour transformations, image synthesis
3526 and image combinations.
3527
3528 transform2() takes an reference to an options hash, and a list of
3529 images to operate one (this list may be empty):
3530
3531   my %opts;
3532   my @imgs;
3533   ...
3534   my $img = Imager::transform2(\%opts, @imgs)
3535       or die "transform2 failed: $Imager::ERRSTR";
3536
3537 The options hash may define a transformation function, and optionally:
3538
3539 =over 4
3540
3541 =item *
3542
3543 width - the width of the image in pixels.  If this isn't supplied the
3544 width of the first input image is used.  If there are no input images
3545 an error occurs.
3546
3547 =item *
3548
3549 height - the height of the image in pixels.  If this isn't supplied
3550 the height of the first input image is used.  If there are no input
3551 images an error occurs.
3552
3553 =item *
3554
3555 constants - a reference to hash of constants to define for the
3556 expression engine.  Some extra constants are defined by Imager
3557
3558 =back
3559
3560 The tranformation function is specified using either the expr or
3561 rpnexpr member of the options.
3562
3563 =over 4
3564
3565 =item Infix expressions
3566
3567 You can supply infix expressions to transform 2 with the expr keyword.
3568
3569 $opts{expr} = 'return getp1(w-x, h-y)'
3570
3571 The 'expression' supplied follows this general grammar:
3572
3573    ( identifier '=' expr ';' )* 'return' expr
3574
3575 This allows you to simplify your expressions using variables.
3576
3577 A more complex example might be:
3578
3579 $opts{expr} = 'pix = getp1(x,y); return if(value(pix)>0.8,pix*0.8,pix)'
3580
3581 Currently to use infix expressions you must have the Parse::RecDescent
3582 module installed (available from CPAN).  There is also what might be a
3583 significant delay the first time you run the infix expression parser
3584 due to the compilation of the expression grammar.
3585
3586 =item Postfix expressions
3587
3588 You can supply postfix or reverse-polish notation expressions to
3589 transform2() through the rpnexpr keyword.
3590
3591 The parser for rpnexpr emulates a stack machine, so operators will
3592 expect to see their parameters on top of the stack.  A stack machine
3593 isn't actually used during the image transformation itself.
3594
3595 You can store the value at the top of the stack in a variable called
3596 foo using !foo and retrieve that value again using @foo.  The !foo
3597 notation will pop the value from the stack.
3598
3599 An example equivalent to the infix expression above:
3600
3601  $opts{rpnexpr} = 'x y getp1 !pix @pix value 0.8 gt @pix 0.8 * @pix ifp'
3602
3603 =back
3604
3605 transform2() has a fairly rich range of operators.
3606
3607 =over 4
3608
3609 =item +, *, -, /, %, **
3610
3611 multiplication, addition, subtraction, division, remainder and
3612 exponentiation.  Multiplication, addition and subtraction can be used
3613 on colour values too - though you need to be careful - adding 2 white
3614 values together and multiplying by 0.5 will give you grey, not white.
3615
3616 Division by zero (or a small number) just results in a large number.
3617 Modulo zero (or a small number) results in zero.
3618
3619 =item sin(N), cos(N), atan2(y,x)
3620
3621 Some basic trig functions.  They work in radians, so you can't just
3622 use the hue values.
3623
3624 =item distance(x1, y1, x2, y2)
3625
3626 Find the distance between two points.  This is handy (along with
3627 atan2()) for producing circular effects.
3628
3629 =item sqrt(n)
3630
3631 Find the square root.  I haven't had much use for this since adding
3632 the distance() function.
3633
3634 =item abs(n)
3635
3636 Find the absolute value.
3637
3638 =item getp1(x,y), getp2(x,y), getp3(x, y)
3639
3640 Get the pixel at position (x,y) from the first, second or third image
3641 respectively.  I may add a getpn() function at some point, but this
3642 prevents static checking of the instructions against the number of
3643 images actually passed in.
3644
3645 =item value(c), hue(c), sat(c), hsv(h,s,v)
3646
3647 Separates a colour value into it's value (brightness), hue (colour)
3648 and saturation elements.  Use hsv() to put them back together (after
3649 suitable manipulation).
3650
3651 =item red(c), green(c), blue(c), rgb(r,g,b)
3652
3653 Separates a colour value into it's red, green and blue colours.  Use
3654 rgb(r,g,b) to put it back together.
3655
3656 =item int(n)
3657
3658 Convert a value to an integer.  Uses a C int cast, so it may break on
3659 large values.
3660
3661 =item if(cond,ntrue,nfalse), if(cond,ctrue,cfalse)
3662
3663 A simple (and inefficient) if function.
3664
3665 =item <=,<,==,>=,>,!=
3666
3667 Relational operators (typically used with if()).  Since we're working
3668 with floating point values the equalities are 'near equalities' - an
3669 epsilon value is used.
3670
3671 =item &&, ||, not(n)
3672
3673 Basic logical operators.
3674
3675 =back
3676
3677 A few examples:
3678
3679 =over 4
3680
3681 =item rpnexpr=>'x 25 % 15 * y 35 % 10 * getp1 !pat x y getp1 !pix @pix sat 0.7 gt @pat @pix ifp'
3682
3683 tiles a smaller version of the input image over itself where the
3684 colour has a saturation over 0.7.
3685
3686 =item rpnexpr=>'x 25 % 15 * y 35 % 10 * getp1 !pat y 360 / !rat x y getp1 1 @rat - pmult @pat @rat pmult padd'
3687
3688 tiles the input image over itself so that at the top of the image the
3689 full-size image is at full strength and at the bottom the tiling is
3690 most visible.
3691
3692 =item rpnexpr=>'x y getp1 !pix @pix value 0.96 gt @pix sat 0.1 lt and 128 128 255 rgb @pix ifp'
3693
3694 replace pixels that are white or almost white with a palish blue
3695
3696 =item rpnexpr=>'x 35 % 10 * y 45 % 8 * getp1 !pat x y getp1 !pix @pix sat 0.2 lt @pix value 0.9 gt and @pix @pat @pix value 2 / 0.5 + pmult ifp'
3697
3698 Tiles the input image overitself where the image isn't white or almost
3699 white.
3700
3701 =item rpnexpr=>'x y 160 180 distance !d y 180 - x 160 - atan2 !a @d 10 / @a + 3.1416 2 * % !a2 @a2 180 * 3.1416 / 1 @a2 sin 1 + 2 / hsv'
3702
3703 Produces a spiral.
3704
3705 =item rpnexpr=>'x y 160 180 distance !d y 180 - x 160 - atan2 !a @d 10 / @a + 3.1416 2 * % !a2 @a 180 * 3.1416 / 1 @a2 sin 1 + 2 / hsv'
3706
3707 A spiral built on top of a colour wheel.
3708
3709 =back
3710
3711 For details on expression parsing see L<Imager::Expr>.  For details on
3712 the virtual machine used to transform the images, see
3713 L<Imager::regmach.pod>.
3714
3715 =head2 Matrix Transformations
3716
3717 Rather than having to write code in a little language, you can use a
3718 matrix to perform transformations, using the matrix_transform()
3719 method:
3720
3721   my $im2 = $im->matrix_transform(matrix=>[ -1, 0, $im->getwidth-1,
3722                                             0,  1, 0,
3723                                             0,  0, 1 ]);
3724
3725 By default the output image will be the same size as the input image,
3726 but you can supply the xsize and ysize parameters to change the size.
3727
3728 Rather than building matrices by hand you can use the Imager::Matrix2d
3729 module to build the matrices.  This class has methods to allow you to
3730 scale, shear, rotate, translate and reflect, and you can combine these
3731 with an overloaded multiplication operator.
3732
3733 WARNING: the matrix you provide in the matrix operator transforms the
3734 co-ordinates within the B<destination> image to the co-ordinates
3735 within the I<source> image.  This can be confusing.
3736
3737 Since Imager has 3 different fairly general ways of transforming an
3738 image spatially, this method also has a yatf() alias.  Yet Another
3739 Transformation Function.
3740
3741 =head2 Masked Images
3742
3743 Masked images let you control which pixels are modified in an
3744 underlying image.  Where the first channel is completely black in the
3745 mask image, writes to the underlying image are ignored.
3746
3747 For example, given a base image called $img:
3748
3749   my $mask = Imager->new(xsize=>$img->getwidth, ysize=>getheight,
3750                          channels=>1);
3751   # ... draw something on the mask
3752   my $maskedimg = $img->masked(mask=>$mask);
3753
3754 You can specifiy the region of the underlying image that is masked
3755 using the left, top, right and bottom options.
3756
3757 If you just want a subset of the image, without masking, just specify
3758 the region without specifying a mask.
3759
3760 =head2 Plugins
3761
3762 It is possible to add filters to the module without recompiling the
3763 module itself.  This is done by using DSOs (Dynamic shared object)
3764 avaliable on most systems.  This way you can maintain our own filters
3765 and not have to get me to add it, or worse patch every new version of
3766 the Module.  Modules can be loaded AND UNLOADED at runtime.  This
3767 means that you can have a server/daemon thingy that can do something
3768 like:
3769
3770   load_plugin("dynfilt/dyntest.so")  || die "unable to load plugin\n";
3771   %hsh=(a=>35,b=>200,type=>lin_stretch);
3772   $img->filter(%hsh);
3773   unload_plugin("dynfilt/dyntest.so") || die "unable to load plugin\n";
3774   $img->write(type=>'pnm',file=>'testout/t60.jpg')
3775     || die "error in write()\n";
3776
3777 Someone decides that the filter is not working as it should -
3778 dyntest.c modified and recompiled.
3779
3780   load_plugin("dynfilt/dyntest.so") || die "unable to load plugin\n";
3781   $img->filter(%hsh); 
3782
3783 An example plugin comes with the module - Please send feedback to 
3784 addi@umich.edu if you test this.
3785
3786 Note: This seems to test ok on the following systems:
3787 Linux, Solaris, HPUX, OpenBSD, FreeBSD, TRU64/OSF1, AIX.
3788 If you test this on other systems please let me know.
3789
3790 =head2 Tags
3791
3792 Image tags contain meta-data about the image, ie. information not
3793 stored as pixels of the image.
3794
3795 At the perl level each tag has a name or code and a value, which is an
3796 integer or an arbitrary string.  An image can contain more than one
3797 tag with the same name or code.
3798
3799 You can retrieve tags from an image using the tags() method, you can
3800 get all of the tags in an image, as a list of array references, with
3801 the code or name of the tag followed by the value of the tag:
3802
3803   my @alltags = $img->tags;
3804
3805 or you can get all tags that have a given name:
3806
3807   my @namedtags = $img->tags(name=>$name);
3808
3809 or a given code:
3810
3811   my @tags = $img->tags(code=>$code);
3812
3813 You can add tags using the addtag() method, either by name:
3814
3815   my $index = $img->addtag(name=>$name, value=>$value);
3816
3817 or by code:
3818
3819   my $index = $img->addtag(code=>$code, value=>$value);
3820
3821 You can remove tags with the deltag() method, either by index:
3822
3823   $img->deltag(index=>$index);
3824
3825 or by name:
3826
3827   $img->deltag(name=>$name);
3828
3829 or by code:
3830
3831   $img->deltag(code=>$code);
3832
3833 In each case deltag() returns the number of tags deleted.
3834
3835 When you read a GIF image using read_multi(), each image can include
3836 the following tags:
3837
3838 =over
3839
3840 =item gif_left
3841
3842 the offset of the image from the left of the "screen" ("Image Left
3843 Position")
3844
3845 =item gif_top
3846
3847 the offset of the image from the top of the "screen" ("Image Top Position")
3848
3849 =item gif_interlace
3850
3851 non-zero if the image was interlaced ("Interlace Flag")
3852
3853 =item gif_screen_width
3854
3855 =item gif_screen_height
3856
3857 the size of the logical screen ("Logical Screen Width", 
3858 "Logical Screen Height")
3859
3860 =item gif_local_map
3861
3862 Non-zero if this image had a local color map.
3863
3864 =item gif_background
3865
3866 The index in the global colormap of the logical screen's background
3867 color.  This is only set if the current image uses the global
3868 colormap.
3869
3870 =item gif_trans_index
3871
3872 The index of the color in the colormap used for transparency.  If the
3873 image has a transparency then it is returned as a 4 channel image with
3874 the alpha set to zero in this palette entry. ("Transparent Color Index")
3875
3876 =item gif_delay
3877
3878 The delay until the next frame is displayed, in 1/100 of a second. 
3879 ("Delay Time").
3880
3881 =item gif_user_input
3882
3883 whether or not a user input is expected before continuing (view dependent) 
3884 ("User Input Flag").
3885
3886 =item gif_disposal
3887
3888 how the next frame is displayed ("Disposal Method")
3889
3890 =item gif_loop
3891
3892 the number of loops from the Netscape Loop extension.  This may be zero.
3893
3894 =item gif_comment
3895
3896 the first block of the first gif comment before each image.
3897
3898 =back
3899
3900 Where applicable, the ("name") is the name of that field from the GIF89 
3901 standard.
3902
3903 The following tags are set in a TIFF image when read, and can be set
3904 to control output:
3905
3906 =over
3907
3908 =item tiff_resolutionunit
3909
3910 The value of the ResolutionUnit tag.  This is ignored on writing if
3911 the i_aspect_only tag is non-zero.
3912
3913 =back
3914
3915 The following tags are set when a Windows BMP file is read:
3916
3917 =over
3918
3919 =item bmp_compression
3920
3921 The type of compression, if any.
3922
3923 =item bmp_important_colors
3924
3925 The number of important colors as defined by the writer of the image.
3926
3927 =back
3928
3929 Some standard tags will be implemented as time goes by:
3930
3931 =over
3932
3933 =item i_xres
3934
3935 =item i_yres
3936
3937 The spatial resolution of the image in pixels per inch.  If the image
3938 format uses a different scale, eg. pixels per meter, then this value
3939 is converted.  A floating point number stored as a string.
3940
3941 =item i_aspect_only
3942
3943 If this is non-zero then the values in i_xres and i_yres are treated
3944 as a ratio only.  If the image format does not support aspect ratios
3945 then this is scaled so the smaller value is 72dpi.
3946
3947 =back
3948
3949 =head1 BUGS
3950
3951 box, arc, circle do not support antialiasing yet.  arc, is only filled
3952 as of yet.  Some routines do not return $self where they should.  This
3953 affects code like this, C<$img-E<gt>box()-E<gt>arc()> where an object
3954 is expected.
3955
3956 When saving Gif images the program does NOT try to shave of extra
3957 colors if it is possible.  If you specify 128 colors and there are
3958 only 2 colors used - it will have a 128 colortable anyway.
3959
3960 =head1 AUTHOR
3961
3962 Arnar M. Hrafnkelsson, addi@umich.edu, and recently lots of assistance
3963 from Tony Cook.  See the README for a complete list.
3964
3965 =head1 SEE ALSO
3966
3967 perl(1), Imager::Color(3), Imager::Font(3), Imager::Matrix2d(3), 
3968 Affix::Infix2Postfix(3), Parse::RecDescent(3) 
3969 http://www.eecs.umich.edu/~addi/perl/Imager/
3970
3971 =cut