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