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