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