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