projects / imager.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
skip the right number of tests when gif not available
[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;
b13bf7e8 887 warn "to_rgb8() called in void context - to_rgb8() returns the converted image at $caller[1] line $caller[2]\n";
34b3f7e6
TC		 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;
658f724e 1966 my %opts=('type'=>'max',qtype=>'normal',@_);
02d1d628
AMH		 1967 my $img = Imager->new();
1968 my $tmp = Imager->new();
658f724e 1969 my ($x_scale, $y_scale);
4f579313 1970
ace46df2 1971 unless (defined wantarray) {
1501d9b3
TC		 1972 my @caller = caller;
1973 warn "scale() called in void context - scale() returns the scaled image at $caller[1] line $caller[2]\n";
ace46df2
TC		 1974 return;
1975 }
1976
5168ca3a
TC		 1977 unless ($self->{IMG}) {
1978 $self->_set_error('empty input image');
1979 return undef;
1980 }
02d1d628 1981
658f724e
TC		 1982 if ($opts{'xscalefactor'} && $opts{'yscalefactor'}) {
1983 $x_scale = $opts{'xscalefactor'};
1984 $y_scale = $opts{'yscalefactor'};
1985 }
1986 elsif ($opts{'xscalefactor'}) {
1987 $x_scale = $opts{'xscalefactor'};
1988 $y_scale = $opts{'scalefactor'} || $x_scale;
1989 }
1990 elsif ($opts{'yscalefactor'}) {
1991 $y_scale = $opts{'yscalefactor'};
1992 $x_scale = $opts{'scalefactor'} || $y_scale;
1993 }
1994 else {
1995 $x_scale = $y_scale = $opts{'scalefactor'} || 0.5;
1996 }
1997
5168ca3a 1998 # work out the scaling
9d540150 1999 if ($opts{xpixels} and $opts{ypixels} and $opts{'type'}) {
4f579313
TC		 2000 my ($xpix, $ypix)=( $opts{xpixels} / $self->getwidth() ,
2001 $opts{ypixels} / $self->getheight() );
5168ca3a 2002 if ($opts{'type'} eq 'min') {
658f724e 2003 $x_scale = $y_scale = _min($xpix,$ypix);
5168ca3a
TC		 2004 }
2005 elsif ($opts{'type'} eq 'max') {
658f724e
TC		 2006 $x_scale = $y_scale = _max($xpix,$ypix);
2007 }
2008 elsif ($opts{'type'} eq 'nonprop' || $opts{'type'} eq 'non-proportional') {
2009 $x_scale = $xpix;
2010 $y_scale = $ypix;
5168ca3a
TC		 2011 }
2012 else {
2013 $self->_set_error('invalid value for type parameter');
2014 return undef;
2015 }
2016 } elsif ($opts{xpixels}) {
658f724e 2017 $x_scale = $y_scale = $opts{xpixels} / $self->getwidth();
5168ca3a
TC		 2018 }
2019 elsif ($opts{ypixels}) {
658f724e 2020 $x_scale = $y_scale = $opts{ypixels}/$self->getheight();
5168ca3a 2021 }
41c7d053
TC		 2022 elsif ($opts{constrain} && ref $opts{constrain}
2023 && $opts{constrain}->can('constrain')) {
2024 # we've been passed an Image::Math::Constrain object or something
2025 # that looks like one
658f724e 2026 my $scalefactor;
4f579313 2027 (undef, undef, $scalefactor)
41c7d053 2028 = $opts{constrain}->constrain($self->getwidth, $self->getheight);
4f579313 2029 unless ($scalefactor) {
41c7d053
TC		 2030 $self->_set_error('constrain method failed on constrain parameter');
2031 return undef;
2032 }
658f724e 2033 $x_scale = $y_scale = $scalefactor;
41c7d053 2034 }
02d1d628
AMH		 2035
2036 if ($opts{qtype} eq 'normal') {
658f724e 2037 $tmp->{IMG} = i_scaleaxis($self->{IMG}, $x_scale, 0);
5168ca3a 2038 if ( !defined($tmp->{IMG}) ) {
4f579313 2039 $self->{ERRSTR} = 'unable to scale image';
5168ca3a
TC		 2040 return undef;
2041 }
658f724e 2042 $img->{IMG}=i_scaleaxis($tmp->{IMG}, $y_scale, 1);
5168ca3a
TC		 2043 if ( !defined($img->{IMG}) ) {
2044 $self->{ERRSTR}='unable to scale image';
2045 return undef;
2046 }
2047
02d1d628
AMH		 2048 return $img;
2049 }
5168ca3a 2050 elsif ($opts{'qtype'} eq 'preview') {
658f724e 2051 $img->{IMG} = i_scale_nn($self->{IMG}, $x_scale, $y_scale);
5168ca3a
TC		 2052 if ( !defined($img->{IMG}) ) {
2053 $self->{ERRSTR}='unable to scale image';
2054 return undef;
2055 }
02d1d628
AMH		 2056 return $img;
2057 }
658f724e
TC		 2058 elsif ($opts{'qtype'} eq 'mixing') {
2059 my $new_width = int(0.5 + $self->getwidth * $x_scale);
2060 my $new_height = int(0.5 + $self->getheight * $y_scale);
2061 $new_width >= 1 or $new_width = 1;
2062 $new_height >= 1 or $new_height = 1;
2063 $img->{IMG} = i_scale_mixing($self->{IMG}, $new_width, $new_height);
2064 unless ($img->{IMG}) {
2065 $self->_set_error(Imager->_error_as_meg);
2066 return;
2067 }
2068 return $img;
2069 }
5168ca3a
TC		 2070 else {
2071 $self->_set_error('invalid value for qtype parameter');
2072 return undef;
2073 }
02d1d628
AMH		 2074}
2075
2076# Scales only along the X axis
2077
2078sub scaleX {
15327bf5
TC		 2079 my $self = shift;
2080 my %opts = ( scalefactor=>0.5, @_ );
02d1d628 2081
34b3f7e6
TC		 2082 unless (defined wantarray) {
2083 my @caller = caller;
2084 warn "scaleX() called in void context - scaleX() returns the scaled image at $caller[1] line $caller[2]\n";
2085 return;
2086 }
2087
15327bf5
TC		 2088 unless ($self->{IMG}) {
2089 $self->{ERRSTR} = 'empty input image';
2090 return undef;
2091 }
02d1d628
AMH		 2092
2093 my $img = Imager->new();
2094
15327bf5 2095 my $scalefactor = $opts{scalefactor};
02d1d628 2096
15327bf5
TC		 2097 if ($opts{pixels}) {
2098 $scalefactor = $opts{pixels} / $self->getwidth();
2099 }
2100
2101 unless ($self->{IMG}) {
2102 $self->{ERRSTR}='empty input image';
2103 return undef;
2104 }
2105
2106 $img->{IMG} = i_scaleaxis($self->{IMG}, $scalefactor, 0);
2107
2108 if ( !defined($img->{IMG}) ) {
2109 $self->{ERRSTR} = 'unable to scale image';
2110 return undef;
2111 }
02d1d628 2112
02d1d628
AMH		 2113 return $img;
2114}
2115
2116# Scales only along the Y axis
2117
2118sub scaleY {
15327bf5
TC		 2119 my $self = shift;
2120 my %opts = ( scalefactor => 0.5, @_ );
02d1d628 2121
34b3f7e6
TC		 2122 unless (defined wantarray) {
2123 my @caller = caller;
2124 warn "scaleY() called in void context - scaleY() returns the scaled image at $caller[1] line $caller[2]\n";
2125 return;
2126 }
2127
02d1d628
AMH		 2128 unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2129
2130 my $img = Imager->new();
2131
15327bf5 2132 my $scalefactor = $opts{scalefactor};
02d1d628 2133
15327bf5
TC		 2134 if ($opts{pixels}) {
2135 $scalefactor = $opts{pixels} / $self->getheight();
2136 }
2137
2138 unless ($self->{IMG}) {
2139 $self->{ERRSTR} = 'empty input image';
2140 return undef;
2141 }
2142 $img->{IMG}=i_scaleaxis($self->{IMG}, $scalefactor, 1);
2143
2144 if ( !defined($img->{IMG}) ) {
2145 $self->{ERRSTR} = 'unable to scale image';
2146 return undef;
2147 }
02d1d628 2148
02d1d628
AMH		 2149 return $img;
2150}
2151
02d1d628
AMH		 2152# Transform returns a spatial transformation of the input image
2153# this moves pixels to a new location in the returned image.
2154# NOTE - should make a utility function to check transforms for
2155# stack overruns
2156
2157sub transform {
2158 my $self=shift;
2159 unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2160 my %opts=@_;
2161 my (@op,@ropx,@ropy,$iop,$or,@parm,$expr,@xt,@yt,@pt,$numre);
2162
2163# print Dumper(\%opts);
2164# xopcopdes
2165
2166 if ( $opts{'xexpr'} and $opts{'yexpr'} ) {
2167 if (!$I2P) {
2168 eval ("use Affix::Infix2Postfix;");
2169 print $@;
2170 if ( $@ ) {
2171 $self->{ERRSTR}='transform: expr given and Affix::Infix2Postfix is not avaliable.';
2172 return undef;
2173 }
2174 $I2P=Affix::Infix2Postfix->new('ops'=>[{op=>'+',trans=>'Add'},
2175 {op=>'-',trans=>'Sub'},
2176 {op=>'*',trans=>'Mult'},
2177 {op=>'/',trans=>'Div'},
9d540150 2178 {op=>'-','type'=>'unary',trans=>'u-'},
02d1d628 2179 {op=>'**'},
9d540150 2180 {op=>'func','type'=>'unary'}],
02d1d628
AMH		 2181 'grouping'=>[qw( \( \) )],
2182 'func'=>[qw( sin cos )],
2183 'vars'=>[qw( x y )]
2184 );
2185 }
2186
2187 @xt=$I2P->translate($opts{'xexpr'});
2188 @yt=$I2P->translate($opts{'yexpr'});
2189
2190 $numre=$I2P->{'numre'};
2191 @pt=(0,0);
2192
2193 for(@xt) { if (/$numre/) { push(@pt,$_); push(@{$opts{'xopcodes'}},'Parm',$#pt); } else { push(@{$opts{'xopcodes'}},$_); } }
2194 for(@yt) { if (/$numre/) { push(@pt,$_); push(@{$opts{'yopcodes'}},'Parm',$#pt); } else { push(@{$opts{'yopcodes'}},$_); } }
2195 @{$opts{'parm'}}=@pt;
2196 }
2197
2198# print Dumper(\%opts);
2199
2200 if ( !exists $opts{'xopcodes'} or @{$opts{'xopcodes'}}==0) {
2201 $self->{ERRSTR}='transform: no xopcodes given.';
2202 return undef;
2203 }
2204
2205 @op=@{$opts{'xopcodes'}};
2206 for $iop (@op) {
2207 if (!defined ($OPCODES{$iop}) and ($iop !~ /^\d+$/) ) {
2208 $self->{ERRSTR}="transform: illegal opcode '$_'.";
2209 return undef;
2210 }
2211 push(@ropx,(exists $OPCODES{$iop}) ? @{$OPCODES{$iop}} : $iop );
2212 }
2213
2214
2215# yopcopdes
2216
2217 if ( !exists $opts{'yopcodes'} or @{$opts{'yopcodes'}}==0) {
2218 $self->{ERRSTR}='transform: no yopcodes given.';
2219 return undef;
2220 }
2221
2222 @op=@{$opts{'yopcodes'}};
2223 for $iop (@op) {
2224 if (!defined ($OPCODES{$iop}) and ($iop !~ /^\d+$/) ) {
2225 $self->{ERRSTR}="transform: illegal opcode '$_'.";
2226 return undef;
2227 }
2228 push(@ropy,(exists $OPCODES{$iop}) ? @{$OPCODES{$iop}} : $iop );
2229 }
2230
2231#parameters
2232
2233 if ( !exists $opts{'parm'}) {
2234 $self->{ERRSTR}='transform: no parameter arg given.';
2235 return undef;
2236 }
2237
2238# print Dumper(\@ropx);
2239# print Dumper(\@ropy);
2240# print Dumper(\@ropy);
2241
2242 my $img = Imager->new();
2243 $img->{IMG}=i_transform($self->{IMG},\@ropx,\@ropy,$opts{'parm'});
2244 if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='transform: failed'; return undef; }
2245 return $img;
2246}
2247
2248
bf94b653
TC		 2249sub transform2 {
2250 my ($opts, @imgs) = @_;
2251
2252 require "Imager/Expr.pm";
2253
2254 $opts->{variables} = [ qw(x y) ];
2255 my ($width, $height) = @{$opts}{qw(width height)};
2256 if (@imgs) {
2257 $width ||= $imgs[0]->getwidth();
2258 $height ||= $imgs[0]->getheight();
2259 my $img_num = 1;
2260 for my $img (@imgs) {
2261 $opts->{constants}{"w$img_num"} = $img->getwidth();
2262 $opts->{constants}{"h$img_num"} = $img->getheight();
2263 $opts->{constants}{"cx$img_num"} = $img->getwidth()/2;
2264 $opts->{constants}{"cy$img_num"} = $img->getheight()/2;
2265 ++$img_num;
02d1d628 2266 }
02d1d628 2267 }
bf94b653
TC		 2268 if ($width) {
2269 $opts->{constants}{w} = $width;
2270 $opts->{constants}{cx} = $width/2;
2271 }
2272 else {
2273 $Imager::ERRSTR = "No width supplied";
2274 return;
2275 }
2276 if ($height) {
2277 $opts->{constants}{h} = $height;
2278 $opts->{constants}{cy} = $height/2;
2279 }
2280 else {
2281 $Imager::ERRSTR = "No height supplied";
2282 return;
2283 }
2284 my $code = Imager::Expr->new($opts);
2285 if (!$code) {
2286 $Imager::ERRSTR = Imager::Expr::error();
2287 return;
2288 }
e5744e01
TC		 2289 my $channels = $opts->{channels} || 3;
2290 unless ($channels >= 1 && $channels <= 4) {
2291 return Imager->_set_error("channels must be an integer between 1 and 4");
2292 }
9982a307 2293
bf94b653 2294 my $img = Imager->new();
e5744e01
TC		 2295 $img->{IMG} = i_transform2($opts->{width}, $opts->{height},
2296 $channels, $code->code(),
bf94b653
TC		 2297 $code->nregs(), $code->cregs(),
2298 [ map { $_->{IMG} } @imgs ]);
2299 if (!defined $img->{IMG}) {
2300 $Imager::ERRSTR = Imager->_error_as_msg();
2301 return;
2302 }
9982a307 2303
bf94b653 2304 return $img;
02d1d628
AMH		 2305}
2306
02d1d628
AMH		 2307sub rubthrough {
2308 my $self=shift;
71dc4a83 2309 my %opts=(tx => 0,ty => 0, @_);
02d1d628 2310
e7b95388
TC		 2311 unless ($self->{IMG}) {
2312 $self->{ERRSTR}='empty input image';
2313 return undef;
2314 }
2315 unless ($opts{src} && $opts{src}->{IMG}) {
2316 $self->{ERRSTR}='empty input image for src';
2317 return undef;
2318 }
02d1d628 2319
71dc4a83
AMH		 2320 %opts = (src_minx => 0,
2321 src_miny => 0,
2322 src_maxx => $opts{src}->getwidth(),
2323 src_maxy => $opts{src}->getheight(),
2324 %opts);
2325
2326 unless (i_rubthru($self->{IMG}, $opts{src}->{IMG}, $opts{tx}, $opts{ty},
e7b95388
TC		 2327 $opts{src_minx}, $opts{src_miny},
2328 $opts{src_maxx}, $opts{src_maxy})) {
2329 $self->_set_error($self->_error_as_msg());
faa9b3e7
TC		 2330 return undef;
2331 }
02d1d628
AMH		 2332 return $self;
2333}
2334
2335
142c26ff
AMH		 2336sub flip {
2337 my $self = shift;
2338 my %opts = @_;
9191e525 2339 my %xlate = (h=>0, v=>1, hv=>2, vh=>2);
142c26ff
AMH		 2340 my $dir;
2341 return () unless defined $opts{'dir'} and defined $xlate{$opts{'dir'}};
2342 $dir = $xlate{$opts{'dir'}};
2343 return $self if i_flipxy($self->{IMG}, $dir);
2344 return ();
2345}
2346
faa9b3e7
TC		 2347sub rotate {
2348 my $self = shift;
2349 my %opts = @_;
34b3f7e6
TC		 2350
2351 unless (defined wantarray) {
2352 my @caller = caller;
2353 warn "rotate() called in void context - rotate() returns the rotated image at $caller[1] line $caller[2]\n";
2354 return;
2355 }
2356
faa9b3e7
TC		 2357 if (defined $opts{right}) {
2358 my $degrees = $opts{right};
2359 if ($degrees < 0) {
2360 $degrees += 360 * int(((-$degrees)+360)/360);
2361 }
2362 $degrees = $degrees % 360;
2363 if ($degrees == 0) {
2364 return $self->copy();
2365 }
2366 elsif ($degrees == 90 || $degrees == 180 || $degrees == 270) {
2367 my $result = Imager->new();
2368 if ($result->{IMG} = i_rotate90($self->{IMG}, $degrees)) {
2369 return $result;
2370 }
2371 else {
2372 $self->{ERRSTR} = $self->_error_as_msg();
2373 return undef;
2374 }
2375 }
2376 else {
2377 $self->{ERRSTR} = "Parameter 'right' must be a multiple of 90 degrees";
2378 return undef;
2379 }
2380 }
2381 elsif (defined $opts{radians} || defined $opts{degrees}) {
2382 my $amount = $opts{radians} || $opts{degrees} * 3.1415926535 / 180;
2383
7f627571 2384 my $back = $opts{back};
faa9b3e7 2385 my $result = Imager->new;
7f627571
TC		 2386 if ($back) {
2387 $back = _color($back);
2388 unless ($back) {
2389 $self->_set_error(Imager->errstr);
2390 return undef;
2391 }
2392
2393 $result->{IMG} = i_rotate_exact($self->{IMG}, $amount, $back);
0d3b936e
TC		 2394 }
2395 else {
2396 $result->{IMG} = i_rotate_exact($self->{IMG}, $amount);
2397 }
2398 if ($result->{IMG}) {
faa9b3e7
TC		 2399 return $result;
2400 }
2401 else {
2402 $self->{ERRSTR} = $self->_error_as_msg();
2403 return undef;
2404 }
2405 }
2406 else {
0d3b936e 2407 $self->{ERRSTR} = "Only the 'right', 'radians' and 'degrees' parameters are available";
faa9b3e7
TC		 2408 return undef;
2409 }
2410}
2411
2412sub matrix_transform {
2413 my $self = shift;
2414 my %opts = @_;
2415
34b3f7e6
TC		 2416 unless (defined wantarray) {
2417 my @caller = caller;
2418 warn "copy() called in void context - copy() returns the copied image at $caller[1] line $caller[2]\n";
2419 return;
2420 }
2421
faa9b3e7
TC		 2422 if ($opts{matrix}) {
2423 my $xsize = $opts{xsize} || $self->getwidth;
2424 my $ysize = $opts{ysize} || $self->getheight;
142c26ff 2425
faa9b3e7 2426 my $result = Imager->new;
0d3b936e
TC		 2427 if ($opts{back}) {
2428 $result->{IMG} = i_matrix_transform($self->{IMG}, $xsize, $ysize,
2429 $opts{matrix}, $opts{back})
2430 or return undef;
2431 }
2432 else {
2433 $result->{IMG} = i_matrix_transform($self->{IMG}, $xsize, $ysize,
2434 $opts{matrix})
2435 or return undef;
2436 }
faa9b3e7
TC		 2437
2438 return $result;
2439 }
2440 else {
2441 $self->{ERRSTR} = "matrix parameter required";
2442 return undef;
2443 }
2444}
2445
2446# blame Leolo :)
2447*yatf = \&matrix_transform;
02d1d628
AMH		 2448
2449# These two are supported for legacy code only
2450
2451sub i_color_new {
faa9b3e7 2452 return Imager::Color->new(@_);
02d1d628
AMH		 2453}
2454
2455sub i_color_set {
faa9b3e7 2456 return Imager::Color::set(@_);
02d1d628
AMH		 2457}
2458
02d1d628 2459# Draws a box between the specified corner points.
02d1d628
AMH		 2460sub box {
2461 my $self=shift;
2462 unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2463 my $dflcl=i_color_new(255,255,255,255);
2464 my %opts=(color=>$dflcl,xmin=>0,ymin=>0,xmax=>$self->getwidth()-1,ymax=>$self->getheight()-1,@_);
2465
2466 if (exists $opts{'box'}) {
bf1573f9
TC		 2467 $opts{'xmin'} = _min($opts{'box'}->[0],$opts{'box'}->[2]);
2468 $opts{'xmax'} = _max($opts{'box'}->[0],$opts{'box'}->[2]);
2469 $opts{'ymin'} = _min($opts{'box'}->[1],$opts{'box'}->[3]);
2470 $opts{'ymax'} = _max($opts{'box'}->[1],$opts{'box'}->[3]);
02d1d628
AMH		 2471 }
2472
f1ac5027 2473 if ($opts{filled}) {
3a9a4241
TC		 2474 my $color = _color($opts{'color'});
2475 unless ($color) {
2476 $self->{ERRSTR} = $Imager::ERRSTR;
2477 return;
2478 }
f1ac5027 2479 i_box_filled($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},
3a9a4241 2480 $opts{ymax}, $color);
f1ac5027
TC		 2481 }
2482 elsif ($opts{fill}) {
2483 unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
2484 # assume it's a hash ref
2485 require 'Imager/Fill.pm';
141a6114
TC		 2486 unless ($opts{fill} = Imager::Fill->new(%{$opts{fill}})) {
2487 $self->{ERRSTR} = $Imager::ERRSTR;
2488 return undef;
2489 }
f1ac5027
TC		 2490 }
2491 i_box_cfill($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},
2492 $opts{ymax},$opts{fill}{fill});
2493 }
cdd23610 2494 else {
3a9a4241
TC		 2495 my $color = _color($opts{'color'});
2496 unless ($color) {
cdd23610
AMH		 2497 $self->{ERRSTR} = $Imager::ERRSTR;
2498 return;
3a9a4241
TC		 2499 }
2500 i_box($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},$opts{ymax},
2501 $color);
f1ac5027 2502 }
02d1d628
AMH		 2503 return $self;
2504}
2505
02d1d628
AMH		 2506sub arc {
2507 my $self=shift;
2508 unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2509 my $dflcl=i_color_new(255,255,255,255);
2510 my %opts=(color=>$dflcl,
bf1573f9 2511 'r'=>_min($self->getwidth(),$self->getheight())/3,
02d1d628
AMH		 2512 'x'=>$self->getwidth()/2,
2513 'y'=>$self->getheight()/2,
2514 'd1'=>0, 'd2'=>361, @_);
a8652edf
TC		 2515 if ($opts{aa}) {
2516 if ($opts{fill}) {
2517 unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
2518 # assume it's a hash ref
2519 require 'Imager/Fill.pm';
2520 unless ($opts{fill} = Imager::Fill->new(%{$opts{fill}})) {
2521 $self->{ERRSTR} = $Imager::ERRSTR;
2522 return;
2523 }
2524 }
2525 i_arc_aa_cfill($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},$opts{'d1'},
2526 $opts{'d2'}, $opts{fill}{fill});
2527 }
2528 else {
2529 my $color = _color($opts{'color'});
2530 unless ($color) {
2531 $self->{ERRSTR} = $Imager::ERRSTR;
2532 return;
2533 }
2534 if ($opts{d1} == 0 && $opts{d2} == 361 && $opts{aa}) {
2535 i_circle_aa($self->{IMG}, $opts{'x'}, $opts{'y'}, $opts{'r'},
2536 $color);
2537 }
2538 else {
2539 i_arc_aa($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},
2540 $opts{'d1'}, $opts{'d2'}, $color);
569795e8 2541 }
f1ac5027 2542 }
f1ac5027
TC		 2543 }
2544 else {
a8652edf
TC		 2545 if ($opts{fill}) {
2546 unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
2547 # assume it's a hash ref
2548 require 'Imager/Fill.pm';
2549 unless ($opts{fill} = Imager::Fill->new(%{$opts{fill}})) {
2550 $self->{ERRSTR} = $Imager::ERRSTR;
2551 return;
2552 }
2553 }
2554 i_arc_cfill($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},$opts{'d1'},
2555 $opts{'d2'}, $opts{fill}{fill});
0d321238
TC		 2556 }
2557 else {
a8652edf
TC		 2558 my $color = _color($opts{'color'});
2559 unless ($color) {
2560 $self->{ERRSTR} = $Imager::ERRSTR;
2561 return;
2562 }
c5baef69
TC		 2563 i_arc($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},
2564 $opts{'d1'}, $opts{'d2'}, $color);
0d321238 2565 }
f1ac5027
TC		 2566 }
2567
02d1d628
AMH		 2568 return $self;
2569}
2570
aa833c97
AMH		 2571# Draws a line from one point to the other
2572# the endpoint is set if the endp parameter is set which it is by default.
2573# to turn of the endpoint being set use endp=>0 when calling line.
02d1d628
AMH		 2574
2575sub line {
2576 my $self=shift;
2577 my $dflcl=i_color_new(0,0,0,0);
aa833c97
AMH		 2578 my %opts=(color=>$dflcl,
2579 endp => 1,
2580 @_);
02d1d628
AMH		 2581 unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2582
2583 unless (exists $opts{x1} and exists $opts{y1}) { $self->{ERRSTR}='missing begining coord'; return undef; }
2584 unless (exists $opts{x2} and exists $opts{y2}) { $self->{ERRSTR}='missing ending coord'; return undef; }
2585
3a9a4241 2586 my $color = _color($opts{'color'});
aa833c97
AMH		 2587 unless ($color) {
2588 $self->{ERRSTR} = $Imager::ERRSTR;
2589 return;
3a9a4241 2590 }
aa833c97 2591
3a9a4241 2592 $opts{antialias} = $opts{aa} if defined $opts{aa};
02d1d628 2593 if ($opts{antialias}) {
aa833c97 2594 i_line_aa($self->{IMG},$opts{x1}, $opts{y1}, $opts{x2}, $opts{y2},
b437ce0a 2595 $color, $opts{endp});
02d1d628 2596 } else {
aa833c97
AMH		 2597 i_line($self->{IMG},$opts{x1}, $opts{y1}, $opts{x2}, $opts{y2},
2598 $color, $opts{endp});
02d1d628
AMH		 2599 }
2600 return $self;
2601}
2602
2603# Draws a line between an ordered set of points - It more or less just transforms this
2604# into a list of lines.
2605
2606sub polyline {
2607 my $self=shift;
2608 my ($pt,$ls,@points);
2609 my $dflcl=i_color_new(0,0,0,0);
2610 my %opts=(color=>$dflcl,@_);
2611
2612 unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2613
2614 if (exists($opts{points})) { @points=@{$opts{points}}; }
2615 if (!exists($opts{points}) and exists($opts{'x'}) and exists($opts{'y'}) ) {
2616 @points=map { [ $opts{'x'}->[$_],$opts{'y'}->[$_] ] } (0..(scalar @{$opts{'x'}}-1));
2617 }
2618
2619# print Dumper(\@points);
2620
3a9a4241
TC		 2621 my $color = _color($opts{'color'});
2622 unless ($color) {
2623 $self->{ERRSTR} = $Imager::ERRSTR;
2624 return;
2625 }
2626 $opts{antialias} = $opts{aa} if defined $opts{aa};
02d1d628
AMH		 2627 if ($opts{antialias}) {
2628 for $pt(@points) {
3a9a4241 2629 if (defined($ls)) {
b437ce0a 2630 i_line_aa($self->{IMG},$ls->[0],$ls->[1],$pt->[0],$pt->[1],$color, 1);
3a9a4241 2631 }
02d1d628
AMH		 2632 $ls=$pt;
2633 }
2634 } else {
2635 for $pt(@points) {
3a9a4241 2636 if (defined($ls)) {
aa833c97 2637 i_line($self->{IMG},$ls->[0],$ls->[1],$pt->[0],$pt->[1],$color,1);
3a9a4241 2638 }
02d1d628
AMH		 2639 $ls=$pt;
2640 }
2641 }
2642 return $self;
2643}
2644
d0e7bfee
AMH		 2645sub polygon {
2646 my $self = shift;
2647 my ($pt,$ls,@points);
2648 my $dflcl = i_color_new(0,0,0,0);
2649 my %opts = (color=>$dflcl, @_);
2650
2651 unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2652
2653 if (exists($opts{points})) {
2654 $opts{'x'} = [ map { $_->[0] } @{$opts{points}} ];
2655 $opts{'y'} = [ map { $_->[1] } @{$opts{points}} ];
2656 }
2657
2658 if (!exists $opts{'x'} or !exists $opts{'y'}) {
2659 $self->{ERRSTR} = 'no points array, or x and y arrays.'; return undef;
2660 }
2661
43c5dacb
TC		 2662 if ($opts{'fill'}) {
2663 unless (UNIVERSAL::isa($opts{'fill'}, 'Imager::Fill')) {
2664 # assume it's a hash ref
2665 require 'Imager/Fill.pm';
2666 unless ($opts{'fill'} = Imager::Fill->new(%{$opts{'fill'}})) {
2667 $self->{ERRSTR} = $Imager::ERRSTR;
2668 return undef;
2669 }
2670 }
2671 i_poly_aa_cfill($self->{IMG}, $opts{'x'}, $opts{'y'},
2672 $opts{'fill'}{'fill'});
2673 }
2674 else {
3a9a4241
TC		 2675 my $color = _color($opts{'color'});
2676 unless ($color) {
2677 $self->{ERRSTR} = $Imager::ERRSTR;
2678 return;
2679 }
2680 i_poly_aa($self->{IMG}, $opts{'x'}, $opts{'y'}, $color);
43c5dacb
TC		 2681 }
2682
d0e7bfee
AMH		 2683 return $self;
2684}
2685
2686
2687# this the multipoint bezier curve
02d1d628
AMH		 2688# this is here more for testing that actual usage since
2689# this is not a good algorithm. Usually the curve would be
2690# broken into smaller segments and each done individually.
2691
2692sub polybezier {
2693 my $self=shift;
2694 my ($pt,$ls,@points);
2695 my $dflcl=i_color_new(0,0,0,0);
2696 my %opts=(color=>$dflcl,@_);
2697
2698 unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2699
2700 if (exists $opts{points}) {
2701 $opts{'x'}=map { $_->[0]; } @{$opts{'points'}};
2702 $opts{'y'}=map { $_->[1]; } @{$opts{'points'}};
2703 }
2704
2705 unless ( @{$opts{'x'}} and @{$opts{'x'}} == @{$opts{'y'}} ) {
2706 $self->{ERRSTR}='Missing or invalid points.';
2707 return;
2708 }
2709
3a9a4241
TC		 2710 my $color = _color($opts{'color'});
2711 unless ($color) {
2712 $self->{ERRSTR} = $Imager::ERRSTR;
2713 return;
2714 }
2715 i_bezier_multi($self->{IMG},$opts{'x'},$opts{'y'},$color);
02d1d628
AMH		 2716 return $self;
2717}
2718
cc6483e0
TC		 2719sub flood_fill {
2720 my $self = shift;
2721 my %opts = ( color=>Imager::Color->new(255, 255, 255), @_ );
aa833c97
AMH		 2722 my $rc;
2723
9d540150 2724 unless (exists $opts{'x'} && exists $opts{'y'}) {
cc6483e0
TC		 2725 $self->{ERRSTR} = "missing seed x and y parameters";
2726 return undef;
2727 }
07d70837 2728
3efb0915
TC		 2729 if ($opts{border}) {
2730 my $border = _color($opts{border});
2731 unless ($border) {
2732 $self->_set_error($Imager::ERRSTR);
2733 return;
2734 }
2735 if ($opts{fill}) {
2736 unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
2737 # assume it's a hash ref
2738 require Imager::Fill;
2739 unless ($opts{fill} = Imager::Fill->new(%{$opts{fill}})) {
2740 $self->{ERRSTR} = $Imager::ERRSTR;
2741 return;
2742 }
569795e8 2743 }
3efb0915
TC		 2744 $rc = i_flood_cfill_border($self->{IMG}, $opts{'x'}, $opts{'y'},
2745 $opts{fill}{fill}, $border);
2746 }
2747 else {
2748 my $color = _color($opts{'color'});
2749 unless ($color) {
2750 $self->{ERRSTR} = $Imager::ERRSTR;
2751 return;
2752 }
2753 $rc = i_flood_fill_border($self->{IMG}, $opts{'x'}, $opts{'y'},
2754 $color, $border);
2755 }
2756 if ($rc) {
2757 return $self;
2758 }
2759 else {
2760 $self->{ERRSTR} = $self->_error_as_msg();
2761 return;
cc6483e0 2762 }
cc6483e0
TC		 2763 }
2764 else {
3efb0915
TC		 2765 if ($opts{fill}) {
2766 unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
2767 # assume it's a hash ref
2768 require 'Imager/Fill.pm';
2769 unless ($opts{fill} = Imager::Fill->new(%{$opts{fill}})) {
2770 $self->{ERRSTR} = $Imager::ERRSTR;
2771 return;
2772 }
2773 }
2774 $rc = i_flood_cfill($self->{IMG}, $opts{'x'}, $opts{'y'}, $opts{fill}{fill});
2775 }
2776 else {
2777 my $color = _color($opts{'color'});
2778 unless ($color) {
2779 $self->{ERRSTR} = $Imager::ERRSTR;
2780 return;
2781 }
2782 $rc = i_flood_fill($self->{IMG}, $opts{'x'}, $opts{'y'}, $color);
2783 }
2784 if ($rc) {
2785 return $self;
2786 }
2787 else {
2788 $self->{ERRSTR} = $self->_error_as_msg();
aa833c97 2789 return;
3a9a4241 2790 }
3efb0915 2791 }
cc6483e0
TC		 2792}
2793
591b5954
TC		 2794sub setpixel {
2795 my $self = shift;
2796
2797 my %opts = ( color=>$self->{fg} || NC(255, 255, 255), @_);
2798
2799 unless (exists $opts{'x'} && exists $opts{'y'}) {
2800 $self->{ERRSTR} = 'missing x and y parameters';
2801 return undef;
2802 }
2803
2804 my $x = $opts{'x'};
2805 my $y = $opts{'y'};
2806 my $color = _color($opts{color})
2807 or return undef;
2808 if (ref $x && ref $y) {
2809 unless (@$x == @$y) {
9650c424 2810 $self->{ERRSTR} = 'length of x and y mismatch';
591b5954
TC		 2811 return undef;
2812 }
2813 if ($color->isa('Imager::Color')) {
2814 for my $i (0..$#{$opts{'x'}}) {
2815 i_ppix($self->{IMG}, $x->[$i], $y->[$i], $color);
2816 }
2817 }
2818 else {
2819 for my $i (0..$#{$opts{'x'}}) {
2820 i_ppixf($self->{IMG}, $x->[$i], $y->[$i], $color);
2821 }
2822 }
2823 }
2824 else {
2825 if ($color->isa('Imager::Color')) {
2826 i_ppix($self->{IMG}, $x, $y, $color);
2827 }
2828 else {
2829 i_ppixf($self->{IMG}, $x, $y, $color);
2830 }
2831 }
2832
2833 $self;
2834}
2835
2836sub getpixel {
2837 my $self = shift;
2838
a9fa203f 2839 my %opts = ( "type"=>'8bit', @_);
591b5954
TC		 2840
2841 unless (exists $opts{'x'} && exists $opts{'y'}) {
2842 $self->{ERRSTR} = 'missing x and y parameters';
2843 return undef;
2844 }
2845
2846 my $x = $opts{'x'};
2847 my $y = $opts{'y'};
2848 if (ref $x && ref $y) {
2849 unless (@$x == @$y) {
2850 $self->{ERRSTR} = 'length of x and y mismatch';
2851 return undef;
2852 }
2853 my @result;
a9fa203f 2854 if ($opts{"type"} eq '8bit') {
591b5954
TC		 2855 for my $i (0..$#{$opts{'x'}}) {
2856 push(@result, i_get_pixel($self->{IMG}, $x->[$i], $y->[$i]));
2857 }
2858 }
2859 else {
2860 for my $i (0..$#{$opts{'x'}}) {
2861 push(@result, i_gpixf($self->{IMG}, $x->[$i], $y->[$i]));
2862 }
2863 }
2864 return wantarray ? @result : \@result;
2865 }
2866 else {
a9fa203f 2867 if ($opts{"type"} eq '8bit') {
591b5954
TC		 2868 return i_get_pixel($self->{IMG}, $x, $y);
2869 }
2870 else {
2871 return i_gpixf($self->{IMG}, $x, $y);
2872 }
2873 }
2874
2875 $self;
2876}
2877
ca4d914e
TC		 2878sub getscanline {
2879 my $self = shift;
2880 my %opts = ( type => '8bit', x=>0, @_);
2881
4cda4e76
TC		 2882 $self->_valid_image or return;
2883
ca4d914e
TC		 2884 defined $opts{width} or $opts{width} = $self->getwidth - $opts{x};
2885
2886 unless (defined $opts{'y'}) {
2887 $self->_set_error("missing y parameter");
2888 return;
2889 }
2890
2891 if ($opts{type} eq '8bit') {
2892 return i_glin($self->{IMG}, $opts{x}, $opts{x}+$opts{width},
4cda4e76 2893 $opts{'y'});
ca4d914e
TC		 2894 }
2895 elsif ($opts{type} eq 'float') {
2896 return i_glinf($self->{IMG}, $opts{x}, $opts{x}+$opts{width},
4cda4e76
TC		 2897 $opts{'y'});
2898 }
2899 elsif ($opts{type} eq 'index') {
2900 unless (i_img_type($self->{IMG})) {
2901 $self->_set_error("type => index only valid on paletted images");
2902 return;
2903 }
2904 return i_gpal($self->{IMG}, $opts{x}, $opts{x} + $opts{width},
2905 $opts{'y'});
ca4d914e
TC		 2906 }
2907 else {
2908 $self->_set_error("invalid type parameter - must be '8bit' or 'float'");
2909 return;
2910 }
2911}
2912
2913sub setscanline {
2914 my $self = shift;
2915 my %opts = ( x=>0, @_);
2916
4cda4e76
TC		 2917 $self->_valid_image or return;
2918
ca4d914e
TC		 2919 unless (defined $opts{'y'}) {
2920 $self->_set_error("missing y parameter");
2921 return;
2922 }
2923
2924 if (!$opts{type}) {
2925 if (ref $opts{pixels} && @{$opts{pixels}}) {
2926 # try to guess the type
2927 if ($opts{pixels}[0]->isa('Imager::Color')) {
2928 $opts{type} = '8bit';
2929 }
2930 elsif ($opts{pixels}[0]->isa('Imager::Color::Float')) {
2931 $opts{type} = 'float';
2932 }
2933 else {
2934 $self->_set_error("missing type parameter and could not guess from pixels");
2935 return;
2936 }
2937 }
2938 else {
2939 # default
2940 $opts{type} = '8bit';
2941 }
2942 }
2943
2944 if ($opts{type} eq '8bit') {
2945 if (ref $opts{pixels}) {
2946 return i_plin($self->{IMG}, $opts{x}, $opts{'y'}, @{$opts{pixels}});
2947 }
2948 else {
2949 return i_plin($self->{IMG}, $opts{x}, $opts{'y'}, $opts{pixels});
2950 }
2951 }
2952 elsif ($opts{type} eq 'float') {
2953 if (ref $opts{pixels}) {
2954 return i_plinf($self->{IMG}, $opts{x}, $opts{'y'}, @{$opts{pixels}});
2955 }
2956 else {
2957 return i_plinf($self->{IMG}, $opts{x}, $opts{'y'}, $opts{pixels});
2958 }
2959 }
4cda4e76
TC		 2960 elsif ($opts{type} eq 'index') {
2961 if (ref $opts{pixels}) {
2962 return i_ppal($self->{IMG}, $opts{x}, $opts{'y'}, @{$opts{pixels}});
2963 }
2964 else {
2965 return i_ppal_p($self->{IMG}, $opts{x}, $opts{'y'}, $opts{pixels});
2966 }
2967 }
ca4d914e
TC		 2968 else {
2969 $self->_set_error("invalid type parameter - must be '8bit' or 'float'");
2970 return;
2971 }
2972}
2973
2974sub getsamples {
2975 my $self = shift;
2976 my %opts = ( type => '8bit', x=>0, @_);
2977
2978 defined $opts{width} or $opts{width} = $self->getwidth - $opts{x};
2979
2980 unless (defined $opts{'y'}) {
2981 $self->_set_error("missing y parameter");
2982 return;
2983 }
2984
2985 unless ($opts{channels}) {
2986 $opts{channels} = [ 0 .. $self->getchannels()-1 ];
2987 }
2988
2989 if ($opts{type} eq '8bit') {
2990 return i_gsamp($self->{IMG}, $opts{x}, $opts{x}+$opts{width},
2991 $opts{y}, @{$opts{channels}});
2992 }
2993 elsif ($opts{type} eq 'float') {
2994 return i_gsampf($self->{IMG}, $opts{x}, $opts{x}+$opts{width},
2995 $opts{y}, @{$opts{channels}});
2996 }
2997 else {
2998 $self->_set_error("invalid type parameter - must be '8bit' or 'float'");
2999 return;
3000 }
3001}
3002
f5991c03
TC		 3003# make an identity matrix of the given size
3004sub _identity {
3005 my ($size) = @_;
3006
3007 my $matrix = [ map { [ (0) x $size ] } 1..$size ];
3008 for my $c (0 .. ($size-1)) {
3009 $matrix->[$c][$c] = 1;
3010 }
3011 return $matrix;
3012}
3013
3014# general function to convert an image
3015sub convert {
3016 my ($self, %opts) = @_;
3017 my $matrix;
3018
34b3f7e6
TC		 3019 unless (defined wantarray) {
3020 my @caller = caller;
3021 warn "convert() called in void context - convert() returns the converted image at $caller[1] line $caller[2]\n";
3022 return;
3023 }
3024
f5991c03
TC		 3025 # the user can either specify a matrix or preset
3026 # the matrix overrides the preset
3027 if (!exists($opts{matrix})) {
3028 unless (exists($opts{preset})) {
3029 $self->{ERRSTR} = "convert() needs a matrix or preset";
3030 return;
3031 }
3032 else {
3033 if ($opts{preset} eq 'gray' || $opts{preset} eq 'grey') {
3034 # convert to greyscale, keeping the alpha channel if any
3035 if ($self->getchannels == 3) {
3036 $matrix = [ [ 0.222, 0.707, 0.071 ] ];
3037 }
3038 elsif ($self->getchannels == 4) {
3039 # preserve the alpha channel
3040 $matrix = [ [ 0.222, 0.707, 0.071, 0 ],
3041 [ 0, 0, 0, 1 ] ];
3042 }
3043 else {
3044 # an identity
3045 $matrix = _identity($self->getchannels);
3046 }
3047 }
3048 elsif ($opts{preset} eq 'noalpha') {
3049 # strip the alpha channel
3050 if ($self->getchannels == 2 or $self->getchannels == 4) {
3051 $matrix = _identity($self->getchannels);
3052 pop(@$matrix); # lose the alpha entry
3053 }
3054 else {
3055 $matrix = _identity($self->getchannels);
3056 }
3057 }
3058 elsif ($opts{preset} eq 'red' || $opts{preset} eq 'channel0') {
3059 # extract channel 0
3060 $matrix = [ [ 1 ] ];
3061 }
3062 elsif ($opts{preset} eq 'green' || $opts{preset} eq 'channel1') {
3063 $matrix = [ [ 0, 1 ] ];
3064 }
3065 elsif ($opts{preset} eq 'blue' || $opts{preset} eq 'channel2') {
3066 $matrix = [ [ 0, 0, 1 ] ];
3067 }
3068 elsif ($opts{preset} eq 'alpha') {
3069 if ($self->getchannels == 2 or $self->getchannels == 4) {
3070 $matrix = [ [ (0) x ($self->getchannels-1), 1 ] ];
3071 }
3072 else {
3073 # the alpha is just 1 <shrug>
3074 $matrix = [ [ (0) x $self->getchannels, 1 ] ];
3075 }
3076 }
3077 elsif ($opts{preset} eq 'rgb') {
3078 if ($self->getchannels == 1) {
3079 $matrix = [ [ 1 ], [ 1 ], [ 1 ] ];
3080 }
3081 elsif ($self->getchannels == 2) {
3082 # preserve the alpha channel
3083 $matrix = [ [ 1, 0 ], [ 1, 0 ], [ 1, 0 ], [ 0, 1 ] ];
3084 }
3085 else {
3086 $matrix = _identity($self->getchannels);
3087 }
3088 }
3089 elsif ($opts{preset} eq 'addalpha') {
3090 if ($self->getchannels == 1) {
3091 $matrix = _identity(2);
3092 }
3093 elsif ($self->getchannels == 3) {
3094 $matrix = _identity(4);
3095 }
3096 else {
3097 $matrix = _identity($self->getchannels);
3098 }
3099 }
3100 else {
3101 $self->{ERRSTR} = "Unknown convert preset $opts{preset}";
3102 return undef;
3103 }
3104 }
3105 }
3106 else {
3107 $matrix = $opts{matrix};
3108 }
3109
3110 my $new = Imager->new();
3111 $new->{IMG} = i_img_new();
3112 unless (i_convert($new->{IMG}, $self->{IMG}, $matrix)) {
3113 # most likely a bad matrix
3114 $self->{ERRSTR} = _error_as_msg();
3115 return undef;
3116 }
3117 return $new;
3118}
40eba1ea
AMH		 3119
3120
40eba1ea 3121# general function to map an image through lookup tables
9495ee93 3122
40eba1ea
AMH		 3123sub map {
3124 my ($self, %opts) = @_;
9495ee93 3125 my @chlist = qw( red green blue alpha );
40eba1ea
AMH		 3126
3127 if (!exists($opts{'maps'})) {
3128 # make maps from channel maps
3129 my $chnum;
3130 for $chnum (0..$#chlist) {
9495ee93
AMH		 3131 if (exists $opts{$chlist[$chnum]}) {
3132 $opts{'maps'}[$chnum] = $opts{$chlist[$chnum]};
3133 } elsif (exists $opts{'all'}) {
3134 $opts{'maps'}[$chnum] = $opts{'all'};
3135 }
40eba1ea
AMH		 3136 }
3137 }
3138 if ($opts{'maps'} and $self->{IMG}) {
3139 i_map($self->{IMG}, $opts{'maps'} );
3140 }
3141 return $self;
3142}
3143
dff75dee
TC		 3144sub difference {
3145 my ($self, %opts) = @_;
3146
3147 defined $opts{mindist} or $opts{mindist} = 0;
3148
3149 defined $opts{other}
3150 or return $self->_set_error("No 'other' parameter supplied");
3151 defined $opts{other}{IMG}
3152 or return $self->_set_error("No image data in 'other' image");
3153
3154 $self->{IMG}
3155 or return $self->_set_error("No image data");
3156
3157 my $result = Imager->new;
3158 $result->{IMG} = i_diff_image($self->{IMG}, $opts{other}{IMG},
3159 $opts{mindist})
3160 or return $self->_set_error($self->_error_as_msg());
3161
3162 return $result;
3163}
3164
02d1d628
AMH		 3165# destructive border - image is shrunk by one pixel all around
3166
3167sub border {
3168 my ($self,%opts)=@_;
3169 my($tx,$ty)=($self->getwidth()-1,$self->getheight()-1);
3170 $self->polyline('x'=>[0,$tx,$tx,0,0],'y'=>[0,0,$ty,$ty,0],%opts);
3171}
3172
3173
3174# Get the width of an image
3175
3176sub getwidth {
3177 my $self = shift;
3178 if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
3179 return (i_img_info($self->{IMG}))[0];
3180}
3181
3182# Get the height of an image
3183
3184sub getheight {
3185 my $self = shift;
3186 if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
3187 return (i_img_info($self->{IMG}))[1];
3188}
3189
3190# Get number of channels in an image
3191
3192sub getchannels {
3193 my $self = shift;
3194 if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
3195 return i_img_getchannels($self->{IMG});
3196}
3197
3198# Get channel mask
3199
3200sub getmask {
3201 my $self = shift;
3202 if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
3203 return i_img_getmask($self->{IMG});
3204}
3205
3206# Set channel mask
3207
3208sub setmask {
3209 my $self = shift;
3210 my %opts = @_;
35f40526
TC		 3211 if (!defined($self->{IMG})) {
3212 $self->{ERRSTR} = 'image is empty';
3213 return undef;
3214 }
3215 unless (defined $opts{mask}) {
3216 $self->_set_error("mask parameter required");
3217 return;
3218 }
02d1d628 3219 i_img_setmask( $self->{IMG} , $opts{mask} );
35f40526
TC		 3220
3221 1;
02d1d628
AMH		 3222}
3223
3224# Get number of colors in an image
3225
3226sub getcolorcount {
3227 my $self=shift;
9d540150 3228 my %opts=('maxcolors'=>2**30,@_);
02d1d628
AMH		 3229 if (!defined($self->{IMG})) { $self->{ERRSTR}='image is empty'; return undef; }
3230 my $rc=i_count_colors($self->{IMG},$opts{'maxcolors'});
3231 return ($rc==-1? undef : $rc);
3232}
3233
3234# draw string to an image
3235
3236sub string {
3237 my $self = shift;
3238 unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
3239
3240 my %input=('x'=>0, 'y'=>0, @_);
3241 $input{string}||=$input{text};
3242
e922ae66 3243 unless(defined $input{string}) {
02d1d628
AMH		 3244 $self->{ERRSTR}="missing required parameter 'string'";
3245 return;
3246 }
3247
3248 unless($input{font}) {
3249 $self->{ERRSTR}="missing required parameter 'font'";
3250 return;
3251 }
3252
faa9b3e7 3253 unless ($input{font}->draw(image=>$self, %input)) {
faa9b3e7
TC		 3254 return;
3255 }
02d1d628
AMH		 3256
3257 return $self;
3258}
3259
a7ccc5e2
TC		 3260sub align_string {
3261 my $self = shift;
e922ae66
TC		 3262
3263 my $img;
3264 if (ref $self) {
3265 unless ($self->{IMG}) {
3266 $self->{ERRSTR}='empty input image';
3267 return;
3268 }
c9cb3397 3269 $img = $self;
e922ae66
TC		 3270 }
3271 else {
3272 $img = undef;
3273 }
a7ccc5e2
TC		 3274
3275 my %input=('x'=>0, 'y'=>0, @_);
3276 $input{string}||=$input{text};
3277
3278 unless(exists $input{string}) {
e922ae66 3279 $self->_set_error("missing required parameter 'string'");
a7ccc5e2
TC		 3280 return;
3281 }
3282
3283 unless($input{font}) {
e922ae66 3284 $self->_set_error("missing required parameter 'font'");
a7ccc5e2
TC		 3285 return;
3286 }
3287
3288 my @result;
e922ae66 3289 unless (@result = $input{font}->align(image=>$img, %input)) {
a7ccc5e2
TC		 3290 return;
3291 }
3292
3293 return wantarray ? @result : $result[0];
3294}
3295
77157728
TC		 3296my @file_limit_names = qw/width height bytes/;
3297
3298sub set_file_limits {
3299 shift;
3300
3301 my %opts = @_;
3302 my %values;
3303
3304 if ($opts{reset}) {
3305 @values{@file_limit_names} = (0) x @file_limit_names;
3306 }
3307 else {
3308 @values{@file_limit_names} = i_get_image_file_limits();
3309 }
3310
3311 for my $key (keys %values) {
3312 defined $opts{$key} and $values{$key} = $opts{$key};
3313 }
3314
3315 i_set_image_file_limits($values{width}, $values{height}, $values{bytes});
3316}
3317
3318sub get_file_limits {
3319 i_get_image_file_limits();
3320}
3321
02d1d628
AMH		 3322# Shortcuts that can be exported
3323
3324sub newcolor { Imager::Color->new(@_); }
3325sub newfont { Imager::Font->new(@_); }
3326
3327*NC=*newcolour=*newcolor;
3328*NF=*newfont;
3329
3330*open=\&read;
3331*circle=\&arc;
3332
3333
3334#### Utility routines
3335
faa9b3e7
TC		 3336sub errstr {
3337 ref $_[0] ? $_[0]->{ERRSTR} : $ERRSTR
3338}
02d1d628 3339
10461f9a
TC		 3340sub _set_error {
3341 my ($self, $msg) = @_;
3342
3343 if (ref $self) {
3344 $self->{ERRSTR} = $msg;
3345 }
3346 else {
3347 $ERRSTR = $msg;
3348 }
dff75dee 3349 return;
10461f9a
TC		 3350}
3351
02d1d628
AMH		 3352# Default guess for the type of an image from extension
3353
3354sub def_guess_type {
3355 my $name=lc(shift);
3356 my $ext;
3357 $ext=($name =~ m/\.([^\.]+)$/)[0];
3358 return 'tiff' if ($ext =~ m/^tiff?$/);
3359 return 'jpeg' if ($ext =~ m/^jpe?g$/);
3360 return 'pnm' if ($ext =~ m/^p[pgb]m$/);
3361 return 'png' if ($ext eq "png");
705fd961 3362 return 'bmp' if ($ext eq "bmp" || $ext eq "dib");
1ec86afa 3363 return 'tga' if ($ext eq "tga");
737a830c 3364 return 'rgb' if ($ext eq "rgb");
02d1d628 3365 return 'gif' if ($ext eq "gif");
10461f9a 3366 return 'raw' if ($ext eq "raw");
2b405c9e 3367 return lc $ext; # best guess
02d1d628
AMH		 3368 return ();
3369}
3370
3371# get the minimum of a list
3372
bf1573f9 3373sub _min {
02d1d628
AMH		 3374 my $mx=shift;
3375 for(@_) { if ($_<$mx) { $mx=$_; }}
3376 return $mx;
3377}
3378
3379# get the maximum of a list
3380
bf1573f9 3381sub _max {
02d1d628
AMH		 3382 my $mx=shift;
3383 for(@_) { if ($_>$mx) { $mx=$_; }}
3384 return $mx;
3385}
3386
3387# string stuff for iptc headers
3388
bf1573f9 3389sub _clean {
02d1d628
AMH		 3390 my($str)=$_[0];
3391 $str = substr($str,3);
3392 $str =~ s/[\n\r]//g;
3393 $str =~ s/\s+/ /g;
3394 $str =~ s/^\s//;
3395 $str =~ s/\s$//;
3396 return $str;
3397}
3398
3399# A little hack to parse iptc headers.
3400
3401sub parseiptc {
3402 my $self=shift;
3403 my(@sar,$item,@ar);
3404 my($caption,$photogr,$headln,$credit);
3405
3406 my $str=$self->{IPTCRAW};
3407
24ae6325
TC		 3408 defined $str
3409 or return;
02d1d628
AMH		 3410
3411 @ar=split(/8BIM/,$str);
3412
3413 my $i=0;
3414 foreach (@ar) {
3415 if (/^\004\004/) {
3416 @sar=split(/\034\002/);
3417 foreach $item (@sar) {
cdd23610 3418 if ($item =~ m/^x/) {
bf1573f9 3419 $caption = _clean($item);
02d1d628
AMH		 3420 $i++;
3421 }
cdd23610 3422 if ($item =~ m/^P/) {
bf1573f9 3423 $photogr = _clean($item);
02d1d628
AMH		 3424 $i++;
3425 }
cdd23610 3426 if ($item =~ m/^i/) {
bf1573f9 3427 $headln = _clean($item);
02d1d628
AMH		 3428 $i++;
3429 }
cdd23610 3430 if ($item =~ m/^n/) {
bf1573f9 3431 $credit = _clean($item);
02d1d628
AMH		 3432 $i++;
3433 }
3434 }
3435 }
3436 }
3437 return (caption=>$caption,photogr=>$photogr,headln=>$headln,credit=>$credit);
3438}
3439
92bda632
TC		 3440sub Inline {
3441 my ($lang) = @_;
3442
3443 $lang eq 'C'
3444 or die "Only C language supported";
3445
3446 require Imager::ExtUtils;
3447 return Imager::ExtUtils->inline_config;
3448}
02d1d628
AMH		 3449
34501;
3451__END__
3452# Below is the stub of documentation for your module. You better edit it!
3453
3454=head1 NAME
3455
3456Imager - Perl extension for Generating 24 bit Images
3457
3458=head1 SYNOPSIS
3459
0e418f1e
AMH		 3460 # Thumbnail example
3461
3462 #!/usr/bin/perl -w
3463 use strict;
10461f9a 3464 use Imager;
02d1d628 3465
0e418f1e
AMH		 3466 die "Usage: thumbmake.pl filename\n" if !-f $ARGV[0];
3467 my $file = shift;
3468
3469 my $format;
3470
3471 my $img = Imager->new();
e36d02ad
TC		 3472 # see Imager::Files for information on the read() method
3473 $img->read(file=>$file) or die $img->errstr();
0e418f1e
AMH		 3474
3475 $file =~ s/\.[^.]*$//;
3476
3477 # Create smaller version
cf7a7d18 3478 # documented in Imager::Transformations
0e418f1e
AMH		 3479 my $thumb = $img->scale(scalefactor=>.3);
3480
3481 # Autostretch individual channels
3482 $thumb->filter(type=>'autolevels');
3483
3484 # try to save in one of these formats
3485 SAVE:
3486
3487 for $format ( qw( png gif jpg tiff ppm ) ) {
3488 # Check if given format is supported
3489 if ($Imager::formats{$format}) {
3490 $file.="_low.$format";
3491 print "Storing image as: $file\n";
cf7a7d18 3492 # documented in Imager::Files
0e418f1e
AMH		 3493 $thumb->write(file=>$file) or
3494 die $thumb->errstr;
3495 last SAVE;
3496 }
3497 }
3498
02d1d628
AMH		 3499=head1 DESCRIPTION
3500
0e418f1e
AMH		 3501Imager is a module for creating and altering images. It can read and
3502write various image formats, draw primitive shapes like lines,and
3503polygons, blend multiple images together in various ways, scale, crop,
3504render text and more.
02d1d628 3505
5df0fac7
AMH		 3506=head2 Overview of documentation
3507
3508=over
3509
cf7a7d18 3510=item *
5df0fac7 3511
d5556805 3512Imager - This document - Synopsis, Example, Table of Contents and
cf7a7d18 3513Overview.
5df0fac7 3514
cf7a7d18 3515=item *
5df0fac7 3516
985bda61
TC		 3517L<Imager::Tutorial> - a brief introduction to Imager.
3518
3519=item *
3520
e1d57e9d
TC		 3521L<Imager::Cookbook> - how to do various things with Imager.
3522
3523=item *
3524
cf7a7d18
TC		 3525L<Imager::ImageTypes> - Basics of constructing image objects with
3526C<new()>: Direct type/virtual images, RGB(A)/paletted images,
35278/16/double bits/channel, color maps, channel masks, image tags, color
6d0ed98a 3528quantization. Also discusses basic image information methods.
5df0fac7 3529
cf7a7d18 3530=item *
5df0fac7 3531
cf7a7d18
TC		 3532L<Imager::Files> - IO interaction, reading/writing images, format
3533specific tags.
5df0fac7 3534
cf7a7d18 3535=item *
5df0fac7 3536
cf7a7d18
TC		 3537L<Imager::Draw> - Drawing Primitives, lines, boxes, circles, arcs,
3538flood fill.
5df0fac7 3539
cf7a7d18 3540=item *
5df0fac7 3541
cf7a7d18 3542L<Imager::Color> - Color specification.
5df0fac7 3543
cf7a7d18 3544=item *
f5fd108b 3545
cf7a7d18 3546L<Imager::Fill> - Fill pattern specification.
f5fd108b 3547
cf7a7d18 3548=item *
5df0fac7 3549
cf7a7d18
TC		 3550L<Imager::Font> - General font rendering, bounding boxes and font
3551metrics.
5df0fac7 3552
cf7a7d18 3553=item *
5df0fac7 3554
cf7a7d18
TC		 3555L<Imager::Transformations> - Copying, scaling, cropping, flipping,
3556blending, pasting, convert and map.
5df0fac7 3557
cf7a7d18 3558=item *
5df0fac7 3559
cf7a7d18
TC		 3560L<Imager::Engines> - Programmable transformations through
3561C<transform()>, C<transform2()> and C<matrix_transform()>.
5df0fac7 3562
cf7a7d18 3563=item *
5df0fac7 3564
cf7a7d18
TC		 3565L<Imager::Filters> - Filters, sharpen, blur, noise, convolve etc. and
3566filter plugins.
5df0fac7 3567
cf7a7d18 3568=item *
5df0fac7 3569
cf7a7d18
TC		 3570L<Imager::Expr> - Expressions for evaluation engine used by
3571transform2().
5df0fac7 3572
cf7a7d18 3573=item *
5df0fac7 3574
cf7a7d18 3575L<Imager::Matrix2d> - Helper class for affine transformations.
5df0fac7 3576
cf7a7d18 3577=item *
5df0fac7 3578
cf7a7d18 3579L<Imager::Fountain> - Helper for making gradient profiles.
5df0fac7 3580
92bda632
TC		 3581=item *
3582
3583L<Imager::API> - using Imager's C API
3584
3585=item *
3586
3587L<Imager::APIRef> - API function reference
3588
3589=item *
3590
3591L<Imager::Inline> - using Imager's C API from Inline::C
3592
3593=item *
3594
3595L<Imager::ExtUtils> - tools to get access to Imager's C API.
3596
5df0fac7
AMH		 3597=back
3598
0e418f1e 3599=head2 Basic Overview
02d1d628 3600
55b287f5
AMH		 3601An Image object is created with C<$img = Imager-E<gt>new()>.
3602Examples:
02d1d628 3603
55b287f5 3604 $img=Imager->new(); # create empty image
e36d02ad 3605 $img->read(file=>'lena.png',type=>'png') or # read image from file
55b287f5
AMH		 3606 die $img->errstr(); # give an explanation
3607 # if something failed
02d1d628
AMH		 3608
3609or if you want to create an empty image:
3610
3611 $img=Imager->new(xsize=>400,ysize=>300,channels=>4);
3612
0e418f1e
AMH		 3613This example creates a completely black image of width 400 and height
3614300 and 4 channels.
3615
d5556805 3616=head1 ERROR HANDLING
55b287f5 3617
d5556805
TC		 3618In general a method will return false when it fails, if it does use the errstr() method to find out why:
3619
3620=over
3621
3622=item errstr
3623
3624Returns the last error message in that context.
3625
3626If the last error you received was from calling an object method, such
3627as read, call errstr() as an object method to find out why:
3628
3629 my $image = Imager->new;
3630 $image->read(file => 'somefile.gif')
3631 or die $image->errstr;
3632
3633If it was a class method then call errstr() as a class method:
3634
3635 my @imgs = Imager->read_multi(file => 'somefile.gif')
3636 or die Imager->errstr;
3637
3638Note that in some cases object methods are implemented in terms of
3639class methods so a failing object method may set both.
3640
3641=back
55b287f5 3642
cf7a7d18
TC		 3643The C<Imager-E<gt>new> method is described in detail in
3644L<Imager::ImageTypes>.
4b4f5319 3645
13fc481e
TC		 3646=head1 METHOD INDEX
3647
3648Where to find information on methods for Imager class objects.
3649
4b3408a5 3650addcolors() - L<Imager::ImageTypes/addcolors>
13fc481e 3651
4b3408a5 3652addtag() - L<Imager::ImageTypes/addtag> - add image tags
13fc481e 3653
a7ccc5e2
TC		 3654align_string() - L<Imager::Draw/align_string>
3655
7fca1e9e
TC		 3656arc() - L<Imager::Draw/arc>
3657
4b3408a5 3658bits() - L<Imager::ImageTypes/bits> - number of bits per sample for the
13fc481e
TC		 3659image
3660
3661box() - L<Imager::Draw/box>
3662
3663circle() - L<Imager::Draw/circle>
3664
feac660c
TC		 3665colorcount() - L<Imager::Draw/colorcount>
3666
13fc481e
TC		 3667convert() - L<Imager::Transformations/"Color transformations"> -
3668transform the color space
3669
3670copy() - L<Imager::Transformations/copy>
3671
3672crop() - L<Imager::Transformations/crop> - extract part of an image
3673
d5556805
TC		 3674def_guess_type() - L<Imager::Files/def_guess_type>
3675
4b3408a5 3676deltag() - L<Imager::ImageTypes/deltag> - delete image tags
13fc481e
TC		 3677
3678difference() - L<Imager::Filters/"Image Difference">
3679
e922ae66 3680errstr() - L<"Basic Overview">
99958502 3681
13fc481e
TC		 3682filter() - L<Imager::Filters>
3683
4b3408a5 3684findcolor() - L<Imager::ImageTypes/findcolor> - search the image palette, if it
13fc481e
TC		 3685has one
3686
3687flip() - L<Imager::Transformations/flip>
3688
3689flood_fill() - L<Imager::Draw/flood_fill>
3690
4b3408a5 3691getchannels() - L<Imager::ImageTypes/getchannels>
13fc481e 3692
4b3408a5 3693getcolorcount() - L<Imager::ImageTypes/getcolorcount>
13fc481e 3694
4b3408a5 3695getcolors() - L<Imager::ImageTypes/getcolors> - get colors from the image
13fc481e
TC		 3696palette, if it has one
3697
77157728
TC		 3698get_file_limits() - L<Imager::Files/"Limiting the sizes of images you read">
3699
4b3408a5 3700getheight() - L<Imager::ImageTypes/getwidth>
13fc481e 3701
7fca1e9e
TC		 3702getmask() - L<Imager::ImageTypes/getmask>
3703
a7ccc5e2 3704getpixel() - L<Imager::Draw/getpixel>
13fc481e 3705
ca4d914e
TC		 3706getsamples() - L<Imager::Draw/getsamples>
3707
3708getscanline() - L<Imager::Draw/getscanline>
3709
4b3408a5 3710getwidth() - L<Imager::ImageTypes/getwidth>
13fc481e 3711
4b3408a5 3712img_set() - L<Imager::ImageTypes/img_set>
13fc481e 3713
7fca1e9e
TC		 3714init() - L<Imager::ImageTypes/init>
3715
13fc481e
TC		 3716line() - L<Imager::Draw/line>
3717
7fca1e9e
TC		 3718load_plugin() - L<Imager::Filters/load_plugin>
3719
13fc481e
TC		 3720map() - L<Imager::Transformations/"Color Mappings"> - remap color
3721channel values
3722
4b3408a5 3723masked() - L<Imager::ImageTypes/masked> - make a masked image
13fc481e 3724
58a9ba58 3725matrix_transform() - L<Imager::Engines/matrix_transform>
13fc481e 3726
4b3408a5 3727maxcolors() - L<Imager::ImageTypes/maxcolors>
feac660c 3728
7fca1e9e
TC		 3729NC() - L<Imager::Handy/NC>
3730
4b3408a5 3731new() - L<Imager::ImageTypes/new>
13fc481e 3732
7fca1e9e
TC		 3733newcolor() - L<Imager::Handy/newcolor>
3734
3735newcolour() - L<Imager::Handy/newcolour>
3736
3737newfont() - L<Imager::Handy/newfont>
3738
3739NF() - L<Imager::Handy/NF>
3740
e36d02ad
TC		 3741open() - L<Imager::Files> - an alias for read()
3742
f0fe9c14
TC		 3743parseiptc() - L<Imager::Files/parseiptc> - parse IPTC data from a JPEG
3744image
3745
13fc481e
TC		 3746paste() - L<Imager::Transformations/paste> - draw an image onto an image
3747
3748polygon() - L<Imager::Draw/polygon>
3749
3750polyline() - L<Imager::Draw/polyline>
3751
e36d02ad 3752read() - L<Imager::Files> - read a single image from an image file
13fc481e 3753
e36d02ad
TC		 3754read_multi() - L<Imager::Files> - read multiple images from an image
3755file
13fc481e 3756
7fca1e9e
TC		 3757register_filter() - L<Imager::Filters/register_filter>
3758
3759register_reader() - L<Imager::Filters/register_reader>
3760
3761register_writer() - L<Imager::Filters/register_writer>
3762
13fc481e
TC		 3763rotate() - L<Imager::Transformations/rotate>
3764
3765rubthrough() - L<Imager::Transformations/rubthrough> - draw an image onto an
3766image and use the alpha channel
3767
3768scale() - L<Imager::Transformations/scale>
1adb5500
TC		 3769
3770scaleX() - L<Imager::Transformations/scaleX>
3771
3772scaleY() - L<Imager::Transformations/scaleY>
13fc481e 3773
4b3408a5
TC		 3774setcolors() - L<Imager::ImageTypes/setcolors> - set palette colors in
3775a paletted image
13fc481e 3776
7fca1e9e
TC		 3777set_file_limits() - L<Imager::Files/"Limiting the sizes of images you read">
3778
3779setmask() - L<Imager::ImageTypes/setmask>
3780
a7ccc5e2 3781setpixel() - L<Imager::Draw/setpixel>
13fc481e 3782
58a9ba58
TC		 3783setscanline() - L<Imager::Draw/setscanline>
3784
3785settag() - L<Imager::ImageTypes/settag>
3786
a7ccc5e2 3787string() - L<Imager::Draw/string> - draw text on an image
13fc481e 3788
4b3408a5 3789tags() - L<Imager::ImageTypes/tags> - fetch image tags
13fc481e 3790
4b3408a5 3791to_paletted() - L<Imager::ImageTypes/to_paletted>
13fc481e 3792
4b3408a5 3793to_rgb8() - L<Imager::ImageTypes/to_rgb8>
13fc481e
TC		 3794
3795transform() - L<Imager::Engines/"transform">
3796
3797transform2() - L<Imager::Engines/"transform2">
3798
4b3408a5 3799type() - L<Imager::ImageTypes/type> - type of image (direct vs paletted)
13fc481e 3800
7fca1e9e
TC		 3801unload_plugin() - L<Imager::Filters/unload_plugin>
3802
4b3408a5 3803virtual() - L<Imager::ImageTypes/virtual> - whether the image has it's own
13fc481e
TC		 3804data
3805
e36d02ad 3806write() - L<Imager::Files> - write an image to a file
13fc481e 3807
e36d02ad
TC		 3808write_multi() - L<Imager::Files> - write multiple image to an image
3809file.
13fc481e 3810
dc67bc2f
TC		 3811=head1 CONCEPT INDEX
3812
3813animated GIF - L<Imager::File/"Writing an animated GIF">
3814
3815aspect ratio - L<Imager::ImageTypes/i_xres>,
3816L<Imager::ImageTypes/i_yres>, L<Imager::ImageTypes/i_aspect_only>
3817
cad360aa
TC		 3818blend - alpha blending one image onto another
3819L<Imager::Transformations/rubthrough>
3820
dc67bc2f
TC		 3821blur - L<Imager::Filters/guassian>, L<Imager::Filters/conv>
3822
3823boxes, drawing - L<Imager::Draw/box>
3824
a8652edf
TC		 3825changes between image - L<Imager::Filter/"Image Difference">
3826
dc67bc2f
TC		 3827color - L<Imager::Color>
3828
3829color names - L<Imager::Color>, L<Imager::Color::Table>
3830
3831combine modes - L<Imager::Fill/combine>
3832
a8652edf
TC		 3833compare images - L<Imager::Filter/"Image Difference">
3834
a4e6485d
TC		 3835contrast - L<Imager::Filter/contrast>, L<Imager::Filter/autolevels>
3836
3837convolution - L<Imager::Filter/conv>
3838
dc67bc2f
TC		 3839cropping - L<Imager::Transformations/crop>
3840
a8652edf
TC		 3841C<diff> images - L<Imager::Filter/"Image Difference">
3842
c2d1dd13
TC		 3843dpi - L<Imager::ImageTypes/i_xres>,
3844L<Imager::Cookbook/"Image spatial resolution">
dc67bc2f
TC		 3845
3846drawing boxes - L<Imager::Draw/box>
3847
3848drawing lines - L<Imager::Draw/line>
3849
c2d1dd13 3850drawing text - L<Imager::Draw/string>, L<Imager::Draw/align_string>
dc67bc2f 3851
e922ae66 3852error message - L<"Basic Overview">
dc67bc2f
TC		 3853
3854files, font - L<Imager::Font>
3855
3856files, image - L<Imager::Files>
3857
3858filling, types of fill - L<Imager::Fill>
3859
3860filling, boxes - L<Imager::Draw/box>
3861
3862filling, flood fill - L<Imager::Draw/flood_fill>
3863
3864flood fill - L<Imager::Draw/flood_fill>
3865
3866fonts - L<Imager::Font>
3867
c2d1dd13
TC		 3868fonts, drawing with - L<Imager::Draw/string>,
3869L<Imager::Draw/align_string>, L<Imager::Font::Wrap>
dc67bc2f
TC		 3870
3871fonts, metrics - L<Imager::Font/bounding_box>, L<Imager::Font::BBox>
3872
3873fonts, multiple master - L<Imager::Font/"MULTIPLE MASTER FONTS">
3874
3875fountain fill - L<Imager::Fill/"Fountain fills">,
3876L<Imager::Filters/fountain>, L<Imager::Fountain>,
3877L<Imager::Filters/gradgen>
3878
a4e6485d
TC		 3879GIF files - L<Imager::Files/"GIF">
3880
3881GIF files, animated - L<Imager::File/"Writing an animated GIF">
3882
dc67bc2f
TC		 3883gradient fill - L<Imager::Fill/"Fountain fills">,
3884L<Imager::Filters/fountain>, L<Imager::Fountain>,
3885L<Imager::Filters/gradgen>
3886
a4e6485d
TC		 3887guassian blur - L<Imager::Filter/guassian>
3888
dc67bc2f
TC		 3889hatch fills - L<Imager::Fill/"Hatched fills">
3890
a4e6485d
TC		 3891invert image - L<Imager::Filter/hardinvert>
3892
dc67bc2f
TC		 3893JPEG - L<Imager::Files/"JPEG">
3894
77157728
TC		 3895limiting image sizes - L<Imager::Files/"Limiting the sizes of images you read">
3896
dc67bc2f
TC		 3897lines, drawing - L<Imager::Draw/line>
3898
a4e6485d
TC		 3899matrix - L<Imager::Matrix2d>,
3900L<Imager::Transformations/"Matrix Transformations">,
3901L<Imager::Font/transform>
3902
dc67bc2f
TC		 3903metadata, image - L<Imager::ImageTypes/"Tags">
3904
a4e6485d
TC		 3905mosaic - L<Imager::Filter/mosaic>
3906
3907noise, filter - L<Imager::Filter/noise>
3908
3909noise, rendered - L<Imager::Filter/turbnoise>,
3910L<Imager::Filter/radnoise>
3911
cad360aa
TC		 3912paste - L<Imager::Transformations/paste>,
3913L<Imager::Transformations/rubthrough>
3914
4b3408a5
TC		 3915pseudo-color image - L<Imager::ImageTypes/to_paletted>,
3916L<Imager::ImageTypes/new>
3917
a4e6485d
TC		 3918posterize - L<Imager::Filter/postlevels>
3919
3920png files - L<Imager::Files>, L<Imager::Files/"PNG">
dc67bc2f 3921
f75c1aeb 3922pnm - L<Imager::Files/"PNM (Portable aNy Map)">
dc67bc2f
TC		 3923
3924rectangles, drawing - L<Imager::Draw/box>
3925
3926resizing an image - L<Imager::Transformations/scale>,
3927L<Imager::Transformations/crop>
3928
3929saving an image - L<Imager::Files>
3930
3931scaling - L<Imager::Transformations/scale>
3932
3933sharpen - L<Imager::Filters/unsharpmask>, L<Imager::Filters/conv>
3934
3935size, image - L<Imager::ImageTypes/getwidth>,
3936L<Imager::ImageTypes/getheight>
3937
3938size, text - L<Imager::Font/bounding_box>
3939
4b3408a5
TC		 3940tags, image metadata - L<Imager::ImageTypes/"Tags">
3941
a7ccc5e2 3942text, drawing - L<Imager::Draw/string>, L<Imager::Draw/align_string>,
dc67bc2f
TC		 3943L<Imager::Font::Wrap>
3944
3945text, wrapping text in an area - L<Imager::Font::Wrap>
3946
3947text, measuring - L<Imager::Font/bounding_box>, L<Imager::Font::BBox>
3948
a4e6485d
TC		 3949tiles, color - L<Imager::Filter/mosaic>
3950
3951unsharp mask - L<Imager::Filter/unsharpmask>
3952
3953watermark - L<Imager::Filter/watermark>
3954
a7ccc5e2 3955writing an image to a file - L<Imager::Files>
dc67bc2f 3956
f64132d2 3957=head1 SUPPORT
0e418f1e 3958
b6228d02 3959The best place to get help with Imager is the mailing list.
02d1d628 3960
f64132d2
TC		 3961To subscribe send a message with C<subscribe> in the body to:
3962
3963 imager-devel+request@molar.is
3964
3965or use the form at:
3966
e922ae66
TC		 3967=over
3968
3969L<http://www.molar.is/en/lists/imager-devel/>
3970
3971=back
f64132d2
TC		 3972
3973where you can also find the mailing list archive.
10461f9a 3974
f6acebd0 3975You can report bugs by pointing your browser at:
8f22b8d8 3976
e922ae66
TC		 3977=over
3978
3979L<https://rt.cpan.org/NoAuth/ReportBug.html?Queue=Imager>
3980
3981=back
8f22b8d8
TC		 3982
3983Please remember to include the versions of Imager, perl, supporting
3984libraries, and any relevant code. If you have specific images that
3985cause the problems, please include those too.
3ed96cd3 3986
02d1d628
AMH		 3987=head1 BUGS
3988
0e418f1e 3989Bugs are listed individually for relevant pod pages.
02d1d628
AMH		 3990
3991=head1 AUTHOR
3992
4b3408a5
TC		 3993Arnar M. Hrafnkelsson and Tony Cook (tony@imager.perl.org) among
3994others. See the README for a complete list.
02d1d628 3995
9495ee93 3996=head1 SEE ALSO
02d1d628 3997
e922ae66
TC		 3998L<perl>(1), L<Imager::ImageTypes>(3), L<Imager::Files>(3),
3999L<Imager::Draw>(3), L<Imager::Color>(3), L<Imager::Fill>(3),
4000L<Imager::Font>(3), L<Imager::Transformations>(3),
4001L<Imager::Engines>(3), L<Imager::Filters>(3), L<Imager::Expr>(3),
4002L<Imager::Matrix2d>(3), L<Imager::Fountain>(3)
4003
4004L<http://imager.perl.org/>
009db950 4005
e922ae66 4006L<Affix::Infix2Postfix>(3), L<Parse::RecDescent>(3)
02d1d628 4007
35f40526
TC		 4008Other perl imaging modules include:
4009
e922ae66 4010L<GD>(3), L<Image::Magick>(3), L<Graphics::Magick>(3).
35f40526 4011
02d1d628 4012=cut
Image manipulation for perl