This is primarily a feature release:
[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);
21e7d90c 158 $VERSION = '0.54';
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
e7ff1cf7
TC
1126 if ($input->{io}) {
1127 return $input->{io}, undef;
1128 }
84e51293 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
e7ff1cf7
TC
1177 if ($input->{io}) {
1178 return $input->{io};
1179 }
1180 elsif ($input->{fd}) {
10461f9a
TC
1181 return io_new_fd($input->{fd});
1182 }
1183 elsif ($input->{fh}) {
1184 my $fd = fileno($input->{fh});
1185 unless ($fd) {
1186 $self->_set_error("Handle in fh option not opened");
1187 return;
1188 }
9d1c4956
TC
1189 # flush it
1190 my $oldfh = select($input->{fh});
1191 # flush anything that's buffered, and make sure anything else is flushed
1192 $| = 1;
1193 select($oldfh);
10461f9a
TC
1194 return io_new_fd($fd);
1195 }
1196 elsif ($input->{file}) {
1197 my $fh = new IO::File($input->{file},"w+");
1198 unless ($fh) {
1199 $self->_set_error("Could not open file $input->{file}: $!");
1200 return;
1201 }
1202 binmode($fh) or die;
1203 return (io_new_fd(fileno($fh)), $fh);
1204 }
1205 elsif ($input->{data}) {
1206 return io_new_bufchain();
1207 }
1208 elsif ($input->{callback} || $input->{writecb}) {
1209 if ($input->{maxbuffer}) {
1210 return io_new_cb($input->{callback} || $input->{writecb},
1211 $input->{readcb},
1212 $input->{seekcb}, $input->{closecb},
1213 $input->{maxbuffer});
1214 }
1215 else {
1216 return io_new_cb($input->{callback} || $input->{writecb},
1217 $input->{readcb},
1218 $input->{seekcb}, $input->{closecb});
1219 }
1220 }
1221 else {
1222 $self->_set_error("file/fd/fh/data/callback parameter missing");
1223 return;
1224 }
1225}
1226
02d1d628
AMH
1227# Read an image from file
1228
1229sub read {
1230 my $self = shift;
1231 my %input=@_;
02d1d628
AMH
1232
1233 if (defined($self->{IMG})) {
faa9b3e7
TC
1234 # let IIM_DESTROY do the destruction, since the image may be
1235 # referenced from elsewhere
1236 #i_img_destroy($self->{IMG});
02d1d628
AMH
1237 undef($self->{IMG});
1238 }
1239
84e51293
AMH
1240 my ($IO, $fh) = $self->_get_reader_io(\%input) or return;
1241
10461f9a 1242 unless ($input{'type'}) {
66614d6e
TC
1243 $input{'type'} = i_test_format_probe($IO, -1);
1244 }
84e51293
AMH
1245
1246 unless ($input{'type'}) {
1247 $self->_set_error('type parameter missing and not possible to guess from extension');
10461f9a
TC
1248 return undef;
1249 }
02d1d628 1250
53a6bbd4
TC
1251 _reader_autoload($input{type});
1252
1253 if ($readers{$input{type}} && $readers{$input{type}}{single}) {
1254 return $readers{$input{type}}{single}->($self, $IO, %input);
1255 }
1256
66614d6e
TC
1257 unless ($formats{$input{'type'}}) {
1258 $self->_set_error("format '$input{'type'}' not supported");
1259 return;
1260 }
1261
2fe0b227 1262 # Setup data source
2fe0b227 1263 if ( $input{'type'} eq 'jpeg' ) {
527c0c3e 1264 ($self->{IMG},$self->{IPTCRAW}) = i_readjpeg_wiol( $IO );
2fe0b227 1265 if ( !defined($self->{IMG}) ) {
77157728 1266 $self->{ERRSTR}=$self->_error_as_msg(); return undef;
02d1d628 1267 }
2fe0b227
AMH
1268 $self->{DEBUG} && print "loading a jpeg file\n";
1269 return $self;
1270 }
02d1d628 1271
2fe0b227 1272 if ( $input{'type'} eq 'tiff' ) {
8f8bd9aa
TC
1273 my $page = $input{'page'};
1274 defined $page or $page = 0;
1275 # Fixme, check if that length parameter is ever needed
1276 $self->{IMG}=i_readtiff_wiol( $IO, -1, $page );
2fe0b227
AMH
1277 if ( !defined($self->{IMG}) ) {
1278 $self->{ERRSTR}=$self->_error_as_msg(); return undef;
02d1d628 1279 }
2fe0b227
AMH
1280 $self->{DEBUG} && print "loading a tiff file\n";
1281 return $self;
1282 }
02d1d628 1283
2fe0b227
AMH
1284 if ( $input{'type'} eq 'pnm' ) {
1285 $self->{IMG}=i_readpnm_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed
1286 if ( !defined($self->{IMG}) ) {
2691d220
TC
1287 $self->{ERRSTR}='unable to read pnm image: '._error_as_msg();
1288 return undef;
790923a4 1289 }
2fe0b227
AMH
1290 $self->{DEBUG} && print "loading a pnm file\n";
1291 return $self;
1292 }
790923a4 1293
2fe0b227
AMH
1294 if ( $input{'type'} eq 'png' ) {
1295 $self->{IMG}=i_readpng_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed
1296 if ( !defined($self->{IMG}) ) {
77157728 1297 $self->{ERRSTR} = $self->_error_as_msg();
2fe0b227 1298 return undef;
705fd961 1299 }
2fe0b227
AMH
1300 $self->{DEBUG} && print "loading a png file\n";
1301 }
705fd961 1302
2fe0b227
AMH
1303 if ( $input{'type'} eq 'bmp' ) {
1304 $self->{IMG}=i_readbmp_wiol( $IO );
1305 if ( !defined($self->{IMG}) ) {
1306 $self->{ERRSTR}=$self->_error_as_msg();
1307 return undef;
10461f9a 1308 }
2fe0b227
AMH
1309 $self->{DEBUG} && print "loading a bmp file\n";
1310 }
10461f9a 1311
2fe0b227
AMH
1312 if ( $input{'type'} eq 'gif' ) {
1313 if ($input{colors} && !ref($input{colors})) {
1314 # must be a reference to a scalar that accepts the colour map
1315 $self->{ERRSTR} = "option 'colors' must be a scalar reference";
1316 return undef;
1ec86afa 1317 }
f1adece7
TC
1318 if ($input{'gif_consolidate'}) {
1319 if ($input{colors}) {
1320 my $colors;
1321 ($self->{IMG}, $colors) =i_readgif_wiol( $IO );
1322 if ($colors) {
1323 ${ $input{colors} } = [ map { NC(@$_) } @$colors ];
1324 }
1325 }
1326 else {
1327 $self->{IMG} =i_readgif_wiol( $IO );
737a830c 1328 }
737a830c 1329 }
2fe0b227 1330 else {
f1adece7
TC
1331 my $page = $input{'page'};
1332 defined $page or $page = 0;
1333 $self->{IMG} = i_readgif_single_wiol( $IO, $page );
1334 if ($input{colors}) {
1335 ${ $input{colors} } =
1336 [ i_getcolors($self->{IMG}, 0, i_colorcount($self->{IMG})) ];
1337 }
895dbd34 1338 }
f1adece7 1339
2fe0b227
AMH
1340 if ( !defined($self->{IMG}) ) {
1341 $self->{ERRSTR}=$self->_error_as_msg();
1342 return undef;
895dbd34 1343 }
2fe0b227
AMH
1344 $self->{DEBUG} && print "loading a gif file\n";
1345 }
895dbd34 1346
2fe0b227
AMH
1347 if ( $input{'type'} eq 'tga' ) {
1348 $self->{IMG}=i_readtga_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed
1349 if ( !defined($self->{IMG}) ) {
1350 $self->{ERRSTR}=$self->_error_as_msg();
1351 return undef;
895dbd34 1352 }
2fe0b227
AMH
1353 $self->{DEBUG} && print "loading a tga file\n";
1354 }
02d1d628 1355
2fe0b227
AMH
1356 if ( $input{'type'} eq 'rgb' ) {
1357 $self->{IMG}=i_readrgb_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed
1358 if ( !defined($self->{IMG}) ) {
1359 $self->{ERRSTR}=$self->_error_as_msg();
a59ffd27
TC
1360 return undef;
1361 }
2fe0b227
AMH
1362 $self->{DEBUG} && print "loading a tga file\n";
1363 }
895dbd34 1364
895dbd34 1365
2fe0b227
AMH
1366 if ( $input{'type'} eq 'raw' ) {
1367 my %params=(datachannels=>3,storechannels=>3,interleave=>1,%input);
1368
1369 if ( !($params{xsize} && $params{ysize}) ) {
1370 $self->{ERRSTR}='missing xsize or ysize parameter for raw';
1371 return undef;
895dbd34
AMH
1372 }
1373
2fe0b227
AMH
1374 $self->{IMG} = i_readraw_wiol( $IO,
1375 $params{xsize},
1376 $params{ysize},
1377 $params{datachannels},
1378 $params{storechannels},
1379 $params{interleave});
1380 if ( !defined($self->{IMG}) ) {
5f8f8e17 1381 $self->{ERRSTR}=$self->_error_as_msg();
2fe0b227 1382 return undef;
dd55acc8 1383 }
2fe0b227 1384 $self->{DEBUG} && print "loading a raw file\n";
02d1d628 1385 }
2fe0b227 1386
02d1d628 1387 return $self;
02d1d628
AMH
1388}
1389
53a6bbd4
TC
1390sub register_reader {
1391 my ($class, %opts) = @_;
1392
1393 defined $opts{type}
1394 or die "register_reader called with no type parameter\n";
1395
1396 my $type = $opts{type};
1397
1398 defined $opts{single} || defined $opts{multiple}
1399 or die "register_reader called with no single or multiple parameter\n";
1400
1401 $readers{$type} = { };
1402 if ($opts{single}) {
1403 $readers{$type}{single} = $opts{single};
1404 }
1405 if ($opts{multiple}) {
1406 $readers{$type}{multiple} = $opts{multiple};
1407 }
1408
1409 return 1;
1410}
1411
2b405c9e
TC
1412sub register_writer {
1413 my ($class, %opts) = @_;
1414
1415 defined $opts{type}
1416 or die "register_writer called with no type parameter\n";
1417
1418 my $type = $opts{type};
1419
1420 defined $opts{single} || defined $opts{multiple}
1421 or die "register_writer called with no single or multiple parameter\n";
1422
1423 $writers{$type} = { };
1424 if ($opts{single}) {
1425 $writers{$type}{single} = $opts{single};
1426 }
1427 if ($opts{multiple}) {
1428 $writers{$type}{multiple} = $opts{multiple};
1429 }
1430
1431 return 1;
1432}
1433
53a6bbd4
TC
1434# probes for an Imager::File::whatever module
1435sub _reader_autoload {
1436 my $type = shift;
1437
1438 return if $formats{$type} || $readers{$type};
1439
1440 return unless $type =~ /^\w+$/;
1441
1442 my $file = "Imager/File/\U$type\E.pm";
1443
1444 unless ($attempted_to_load{$file}) {
1445 eval {
1446 ++$attempted_to_load{$file};
1447 require $file;
1448 };
2b405c9e
TC
1449 if ($@) {
1450 # try to get a reader specific module
1451 my $file = "Imager/File/\U$type\EReader.pm";
1452 unless ($attempted_to_load{$file}) {
1453 eval {
1454 ++$attempted_to_load{$file};
1455 require $file;
1456 };
1457 }
1458 }
1459 }
1460}
1461
1462# probes for an Imager::File::whatever module
1463sub _writer_autoload {
1464 my $type = shift;
1465
1466 return if $formats{$type} || $readers{$type};
1467
1468 return unless $type =~ /^\w+$/;
1469
1470 my $file = "Imager/File/\U$type\E.pm";
1471
1472 unless ($attempted_to_load{$file}) {
1473 eval {
1474 ++$attempted_to_load{$file};
1475 require $file;
1476 };
1477 if ($@) {
1478 # try to get a writer specific module
1479 my $file = "Imager/File/\U$type\EWriter.pm";
1480 unless ($attempted_to_load{$file}) {
1481 eval {
1482 ++$attempted_to_load{$file};
1483 require $file;
1484 };
1485 }
1486 }
53a6bbd4
TC
1487 }
1488}
1489
97c4effc
TC
1490sub _fix_gif_positions {
1491 my ($opts, $opt, $msg, @imgs) = @_;
2fe0b227 1492
97c4effc
TC
1493 my $positions = $opts->{'gif_positions'};
1494 my $index = 0;
1495 for my $pos (@$positions) {
1496 my ($x, $y) = @$pos;
1497 my $img = $imgs[$index++];
9d1c4956
TC
1498 $img->settag(name=>'gif_left', value=>$x);
1499 $img->settag(name=>'gif_top', value=>$y) if defined $y;
97c4effc
TC
1500 }
1501 $$msg .= "replaced with the gif_left and gif_top tags";
1502}
1503
1504my %obsolete_opts =
1505 (
1506 gif_each_palette=>'gif_local_map',
1507 interlace => 'gif_interlace',
1508 gif_delays => 'gif_delay',
1509 gif_positions => \&_fix_gif_positions,
1510 gif_loop_count => 'gif_loop',
1511 );
1512
1513sub _set_opts {
1514 my ($self, $opts, $prefix, @imgs) = @_;
1515
1516 for my $opt (keys %$opts) {
1517 my $tagname = $opt;
1518 if ($obsolete_opts{$opt}) {
1519 my $new = $obsolete_opts{$opt};
1520 my $msg = "Obsolete option $opt ";
1521 if (ref $new) {
1522 $new->($opts, $opt, \$msg, @imgs);
1523 }
1524 else {
1525 $msg .= "replaced with the $new tag ";
1526 $tagname = $new;
1527 }
1528 $msg .= "line ".(caller(2))[2]." of file ".(caller(2))[1];
1529 warn $msg if $warn_obsolete && $^W;
1530 }
1531 next unless $tagname =~ /^\Q$prefix/;
1532 my $value = $opts->{$opt};
1533 if (ref $value) {
1534 if (UNIVERSAL::isa($value, "Imager::Color")) {
1535 my $tag = sprintf("color(%d,%d,%d,%d)", $value->rgba);
1536 for my $img (@imgs) {
1537 $img->settag(name=>$tagname, value=>$tag);
1538 }
1539 }
1540 elsif (ref($value) eq 'ARRAY') {
1541 for my $i (0..$#$value) {
1542 my $val = $value->[$i];
1543 if (ref $val) {
1544 if (UNIVERSAL::isa($val, "Imager::Color")) {
1545 my $tag = sprintf("color(%d,%d,%d,%d)", $value->rgba);
1546 $i < @imgs and
1547 $imgs[$i]->settag(name=>$tagname, value=>$tag);
1548 }
1549 else {
1550 $self->_set_error("Unknown reference type " . ref($value) .
1551 " supplied in array for $opt");
1552 return;
1553 }
1554 }
1555 else {
1556 $i < @imgs
1557 and $imgs[$i]->settag(name=>$tagname, value=>$val);
1558 }
1559 }
1560 }
1561 else {
1562 $self->_set_error("Unknown reference type " . ref($value) .
1563 " supplied for $opt");
1564 return;
1565 }
1566 }
1567 else {
1568 # set it as a tag for every image
1569 for my $img (@imgs) {
1570 $img->settag(name=>$tagname, value=>$value);
1571 }
1572 }
1573 }
1574
1575 return 1;
1576}
1577
02d1d628 1578# Write an image to file
02d1d628
AMH
1579sub write {
1580 my $self = shift;
2fe0b227
AMH
1581 my %input=(jpegquality=>75,
1582 gifquant=>'mc',
1583 lmdither=>6.0,
febba01f
AMH
1584 lmfixed=>[],
1585 idstring=>"",
1586 compress=>1,
1587 wierdpack=>0,
4c2d6970 1588 fax_fine=>1, @_);
10461f9a 1589 my $rc;
02d1d628 1590
97c4effc
TC
1591 $self->_set_opts(\%input, "i_", $self)
1592 or return undef;
1593
02d1d628
AMH
1594 unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1595
9d540150
TC
1596 if (!$input{'type'} and $input{file}) {
1597 $input{'type'}=$FORMATGUESS->($input{file});
1598 }
1599 if (!$input{'type'}) {
1600 $self->{ERRSTR}='type parameter missing and not possible to guess from extension';
1601 return undef;
1602 }
02d1d628 1603
2b405c9e 1604 _writer_autoload($input{type});
02d1d628 1605
2b405c9e
TC
1606 my ($IO, $fh);
1607 if ($writers{$input{type}} && $writers{$input{type}}{single}) {
1608 ($IO, $fh) = $self->_get_writer_io(\%input, $input{'type'})
2fe0b227 1609 or return undef;
febba01f 1610
2b405c9e 1611 $writers{$input{type}}{single}->($self, $IO, %input)
2fe0b227 1612 or return undef;
2b405c9e
TC
1613 }
1614 else {
1615 if (!$formats{$input{'type'}}) {
1616 $self->{ERRSTR}='format not supported';
2fe0b227 1617 return undef;
930c67c8 1618 }
2b405c9e
TC
1619
1620 ($IO, $fh) = $self->_get_writer_io(\%input, $input{'type'})
2fe0b227 1621 or return undef;
2b405c9e
TC
1622
1623 if ($input{'type'} eq 'tiff') {
1624 $self->_set_opts(\%input, "tiff_", $self)
1625 or return undef;
1626 $self->_set_opts(\%input, "exif_", $self)
1627 or return undef;
1628
1629 if (defined $input{class} && $input{class} eq 'fax') {
1630 if (!i_writetiff_wiol_faxable($self->{IMG}, $IO, $input{fax_fine})) {
1631 $self->{ERRSTR} = $self->_error_as_msg();
1632 return undef;
1633 }
1634 } else {
1635 if (!i_writetiff_wiol($self->{IMG}, $IO)) {
1636 $self->{ERRSTR} = $self->_error_as_msg();
1637 return undef;
1638 }
1639 }
1640 } elsif ( $input{'type'} eq 'pnm' ) {
1641 $self->_set_opts(\%input, "pnm_", $self)
1642 or return undef;
1643 if ( ! i_writeppm_wiol($self->{IMG},$IO) ) {
1644 $self->{ERRSTR} = $self->_error_as_msg();
1645 return undef;
1646 }
1647 $self->{DEBUG} && print "writing a pnm file\n";
1648 } elsif ( $input{'type'} eq 'raw' ) {
1649 $self->_set_opts(\%input, "raw_", $self)
1650 or return undef;
1651 if ( !i_writeraw_wiol($self->{IMG},$IO) ) {
1652 $self->{ERRSTR} = $self->_error_as_msg();
1653 return undef;
1654 }
1655 $self->{DEBUG} && print "writing a raw file\n";
1656 } elsif ( $input{'type'} eq 'png' ) {
1657 $self->_set_opts(\%input, "png_", $self)
1658 or return undef;
1659 if ( !i_writepng_wiol($self->{IMG}, $IO) ) {
1660 $self->{ERRSTR}='unable to write png image';
1661 return undef;
1662 }
1663 $self->{DEBUG} && print "writing a png file\n";
1664 } elsif ( $input{'type'} eq 'jpeg' ) {
1665 $self->_set_opts(\%input, "jpeg_", $self)
1666 or return undef;
1667 $self->_set_opts(\%input, "exif_", $self)
1668 or return undef;
1669 if ( !i_writejpeg_wiol($self->{IMG}, $IO, $input{jpegquality})) {
1670 $self->{ERRSTR} = $self->_error_as_msg();
1671 return undef;
1672 }
1673 $self->{DEBUG} && print "writing a jpeg file\n";
1674 } elsif ( $input{'type'} eq 'bmp' ) {
1675 $self->_set_opts(\%input, "bmp_", $self)
1676 or return undef;
1677 if ( !i_writebmp_wiol($self->{IMG}, $IO) ) {
1678 $self->{ERRSTR}='unable to write bmp image';
1679 return undef;
1680 }
1681 $self->{DEBUG} && print "writing a bmp file\n";
1682 } elsif ( $input{'type'} eq 'tga' ) {
1683 $self->_set_opts(\%input, "tga_", $self)
1684 or return undef;
1685
1686 if ( !i_writetga_wiol($self->{IMG}, $IO, $input{wierdpack}, $input{compress}, $input{idstring}) ) {
1687 $self->{ERRSTR}=$self->_error_as_msg();
1688 return undef;
1689 }
1690 $self->{DEBUG} && print "writing a tga file\n";
1691 } elsif ( $input{'type'} eq 'gif' ) {
1692 $self->_set_opts(\%input, "gif_", $self)
1693 or return undef;
1694 # compatibility with the old interfaces
1695 if ($input{gifquant} eq 'lm') {
1696 $input{make_colors} = 'addi';
1697 $input{translate} = 'perturb';
1698 $input{perturb} = $input{lmdither};
1699 } elsif ($input{gifquant} eq 'gen') {
1700 # just pass options through
1701 } else {
1702 $input{make_colors} = 'webmap'; # ignored
1703 $input{translate} = 'giflib';
1704 }
1705 if (!i_writegif_wiol($IO, \%input, $self->{IMG})) {
1706 $self->{ERRSTR} = $self->_error_as_msg;
1707 return;
1708 }
1501d9b3 1709 }
02d1d628 1710 }
10461f9a 1711
2fe0b227
AMH
1712 if (exists $input{'data'}) {
1713 my $data = io_slurp($IO);
1714 if (!$data) {
1715 $self->{ERRSTR}='Could not slurp from buffer';
1716 return undef;
1717 }
1718 ${$input{data}} = $data;
1719 }
02d1d628
AMH
1720 return $self;
1721}
1722
1723sub write_multi {
1724 my ($class, $opts, @images) = @_;
1725
2b405c9e
TC
1726 my $type = $opts->{type};
1727
1728 if (!$type && $opts->{'file'}) {
1729 $type = $FORMATGUESS->($opts->{'file'});
10461f9a 1730 }
2b405c9e 1731 unless ($type) {
10461f9a
TC
1732 $class->_set_error('type parameter missing and not possible to guess from extension');
1733 return;
1734 }
1735 # translate to ImgRaw
1736 if (grep !UNIVERSAL::isa($_, 'Imager') || !$_->{IMG}, @images) {
1737 $class->_set_error('Usage: Imager->write_multi({ options }, @images)');
1738 return 0;
1739 }
97c4effc
TC
1740 $class->_set_opts($opts, "i_", @images)
1741 or return;
10461f9a 1742 my @work = map $_->{IMG}, @images;
2b405c9e
TC
1743
1744 _writer_autoload($type);
1745
1746 my ($IO, $file);
1747 if ($writers{$type} && $writers{$type}{multiple}) {
1748 ($IO, $file) = $class->_get_writer_io($opts, $type)
1749 or return undef;
1750
1751 $writers{$type}{multiple}->($class, $IO, $opts, @images)
1752 or return undef;
1753 }
1754 else {
1755 if (!$formats{$type}) {
1756 $class->_set_error("format $type not supported");
1757 return undef;
1758 }
1759
1760 ($IO, $file) = $class->_get_writer_io($opts, $type)
1761 or return undef;
1762
1763 if ($type eq 'gif') {
1764 $class->_set_opts($opts, "gif_", @images)
1765 or return;
1766 my $gif_delays = $opts->{gif_delays};
1767 local $opts->{gif_delays} = $gif_delays;
1768 if ($opts->{gif_delays} && !ref $opts->{gif_delays}) {
1769 # assume the caller wants the same delay for each frame
1770 $opts->{gif_delays} = [ ($gif_delays) x @images ];
1771 }
1772 unless (i_writegif_wiol($IO, $opts, @work)) {
1773 $class->_set_error($class->_error_as_msg());
1774 return undef;
1775 }
1776 }
1777 elsif ($type eq 'tiff') {
1778 $class->_set_opts($opts, "tiff_", @images)
1779 or return;
1780 $class->_set_opts($opts, "exif_", @images)
1781 or return;
1782 my $res;
1783 $opts->{fax_fine} = 1 unless exists $opts->{fax_fine};
1784 if ($opts->{'class'} && $opts->{'class'} eq 'fax') {
1785 $res = i_writetiff_multi_wiol_faxable($IO, $opts->{fax_fine}, @work);
1786 }
1787 else {
1788 $res = i_writetiff_multi_wiol($IO, @work);
1789 }
1790 unless ($res) {
1791 $class->_set_error($class->_error_as_msg());
1792 return undef;
1793 }
02d1d628
AMH
1794 }
1795 else {
e7ff1cf7
TC
1796 if (@images == 1) {
1797 unless ($images[0]->write(%$opts, io => $IO, type => $type)) {
1798 return 1;
1799 }
1800 }
1801 else {
1802 $ERRSTR = "Sorry, write_multi doesn't support $type yet";
1803 return 0;
1804 }
02d1d628
AMH
1805 }
1806 }
2b405c9e
TC
1807
1808 if (exists $opts->{'data'}) {
1809 my $data = io_slurp($IO);
1810 if (!$data) {
1811 Imager->_set_error('Could not slurp from buffer');
1812 return undef;
1813 }
1814 ${$opts->{data}} = $data;
02d1d628 1815 }
2b405c9e 1816 return 1;
02d1d628
AMH
1817}
1818
faa9b3e7
TC
1819# read multiple images from a file
1820sub read_multi {
1821 my ($class, %opts) = @_;
1822
53a6bbd4
TC
1823 my ($IO, $file) = $class->_get_reader_io(\%opts, $opts{'type'})
1824 or return;
1825
1826 my $type = $opts{'type'};
1827 unless ($type) {
1828 $type = i_test_format_probe($IO, -1);
1829 }
1830
1831 if ($opts{file} && !$type) {
faa9b3e7 1832 # guess the type
53a6bbd4 1833 $type = $FORMATGUESS->($opts{file});
faa9b3e7 1834 }
53a6bbd4
TC
1835
1836 unless ($type) {
faa9b3e7
TC
1837 $ERRSTR = "No type parameter supplied and it couldn't be guessed";
1838 return;
1839 }
faa9b3e7 1840
53a6bbd4
TC
1841 _reader_autoload($type);
1842
1843 if ($readers{$type} && $readers{$type}{multiple}) {
1844 return $readers{$type}{multiple}->($IO, %opts);
1845 }
1846
1847 if ($type eq 'gif') {
faa9b3e7 1848 my @imgs;
10461f9a
TC
1849 @imgs = i_readgif_multi_wiol($IO);
1850 if (@imgs) {
1851 return map {
1852 bless { IMG=>$_, DEBUG=>$DEBUG, ERRSTR=>undef }, 'Imager'
1853 } @imgs;
faa9b3e7
TC
1854 }
1855 else {
10461f9a
TC
1856 $ERRSTR = _error_as_msg();
1857 return;
faa9b3e7 1858 }
10461f9a 1859 }
53a6bbd4 1860 elsif ($type eq 'tiff') {
10461f9a 1861 my @imgs = i_readtiff_multi_wiol($IO, -1);
faa9b3e7
TC
1862 if (@imgs) {
1863 return map {
1864 bless { IMG=>$_, DEBUG=>$DEBUG, ERRSTR=>undef }, 'Imager'
1865 } @imgs;
1866 }
1867 else {
1868 $ERRSTR = _error_as_msg();
1869 return;
1870 }
1871 }
e7ff1cf7
TC
1872 else {
1873 my $img = Imager->new;
1874 if ($img->read(%opts, io => $IO, type => $type)) {
1875 return ( $img );
1876 }
1877 }
faa9b3e7 1878
2b405c9e 1879 $ERRSTR = "Cannot read multiple images from $type files";
faa9b3e7
TC
1880 return;
1881}
1882
02d1d628
AMH
1883# Destroy an Imager object
1884
1885sub DESTROY {
1886 my $self=shift;
1887 # delete $instances{$self};
1888 if (defined($self->{IMG})) {
faa9b3e7
TC
1889 # the following is now handled by the XS DESTROY method for
1890 # Imager::ImgRaw object
1891 # Re-enabling this will break virtual images
1892 # tested for in t/t020masked.t
1893 # i_img_destroy($self->{IMG});
02d1d628
AMH
1894 undef($self->{IMG});
1895 } else {
1896# print "Destroy Called on an empty image!\n"; # why did I put this here??
1897 }
1898}
1899
1900# Perform an inplace filter of an image
1901# that is the image will be overwritten with the data
1902
1903sub filter {
1904 my $self=shift;
1905 my %input=@_;
1906 my %hsh;
1907 unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1908
9d540150 1909 if (!$input{'type'}) { $self->{ERRSTR}='type parameter missing'; return undef; }
02d1d628 1910
9d540150 1911 if ( (grep { $_ eq $input{'type'} } keys %filters) != 1) {
02d1d628
AMH
1912 $self->{ERRSTR}='type parameter not matching any filter'; return undef;
1913 }
1914
9d540150
TC
1915 if ($filters{$input{'type'}}{names}) {
1916 my $names = $filters{$input{'type'}}{names};
6607600c
TC
1917 for my $name (keys %$names) {
1918 if (defined $input{$name} && exists $names->{$name}{$input{$name}}) {
1919 $input{$name} = $names->{$name}{$input{$name}};
1920 }
1921 }
1922 }
9d540150 1923 if (defined($filters{$input{'type'}}{defaults})) {
7327d4b0
TC
1924 %hsh=( image => $self->{IMG},
1925 imager => $self,
1926 %{$filters{$input{'type'}}{defaults}},
1927 %input );
02d1d628 1928 } else {
7327d4b0
TC
1929 %hsh=( image => $self->{IMG},
1930 imager => $self,
1931 %input );
02d1d628
AMH
1932 }
1933
9d540150 1934 my @cs=@{$filters{$input{'type'}}{callseq}};
02d1d628
AMH
1935
1936 for(@cs) {
1937 if (!defined($hsh{$_})) {
9d540150 1938 $self->{ERRSTR}="missing parameter '$_' for filter ".$input{'type'}; return undef;
02d1d628
AMH
1939 }
1940 }
1941
109bec2d
TC
1942 eval {
1943 local $SIG{__DIE__}; # we don't want this processed by confess, etc
1944 &{$filters{$input{'type'}}{callsub}}(%hsh);
1945 };
1946 if ($@) {
1947 chomp($self->{ERRSTR} = $@);
1948 return;
1949 }
02d1d628
AMH
1950
1951 my @b=keys %hsh;
1952
1953 $self->{DEBUG} && print "callseq is: @cs\n";
1954 $self->{DEBUG} && print "matching callseq is: @b\n";
1955
1956 return $self;
1957}
1958
92bda632
TC
1959sub register_filter {
1960 my $class = shift;
1961 my %hsh = ( defaults => {}, @_ );
1962
1963 defined $hsh{type}
1964 or die "register_filter() with no type\n";
1965 defined $hsh{callsub}
1966 or die "register_filter() with no callsub\n";
1967 defined $hsh{callseq}
1968 or die "register_filter() with no callseq\n";
1969
1970 exists $filters{$hsh{type}}
1971 and return;
1972
1973 $filters{$hsh{type}} = \%hsh;
1974
1975 return 1;
1976}
1977
02d1d628
AMH
1978# Scale an image to requested size and return the scaled version
1979
1980sub scale {
1981 my $self=shift;
658f724e 1982 my %opts=('type'=>'max',qtype=>'normal',@_);
02d1d628
AMH
1983 my $img = Imager->new();
1984 my $tmp = Imager->new();
658f724e 1985 my ($x_scale, $y_scale);
4f579313 1986
ace46df2 1987 unless (defined wantarray) {
1501d9b3
TC
1988 my @caller = caller;
1989 warn "scale() called in void context - scale() returns the scaled image at $caller[1] line $caller[2]\n";
ace46df2
TC
1990 return;
1991 }
1992
5168ca3a
TC
1993 unless ($self->{IMG}) {
1994 $self->_set_error('empty input image');
1995 return undef;
1996 }
02d1d628 1997
658f724e
TC
1998 if ($opts{'xscalefactor'} && $opts{'yscalefactor'}) {
1999 $x_scale = $opts{'xscalefactor'};
2000 $y_scale = $opts{'yscalefactor'};
2001 }
2002 elsif ($opts{'xscalefactor'}) {
2003 $x_scale = $opts{'xscalefactor'};
2004 $y_scale = $opts{'scalefactor'} || $x_scale;
2005 }
2006 elsif ($opts{'yscalefactor'}) {
2007 $y_scale = $opts{'yscalefactor'};
2008 $x_scale = $opts{'scalefactor'} || $y_scale;
2009 }
2010 else {
2011 $x_scale = $y_scale = $opts{'scalefactor'} || 0.5;
2012 }
2013
5168ca3a 2014 # work out the scaling
9d540150 2015 if ($opts{xpixels} and $opts{ypixels} and $opts{'type'}) {
4f579313
TC
2016 my ($xpix, $ypix)=( $opts{xpixels} / $self->getwidth() ,
2017 $opts{ypixels} / $self->getheight() );
5168ca3a 2018 if ($opts{'type'} eq 'min') {
658f724e 2019 $x_scale = $y_scale = _min($xpix,$ypix);
5168ca3a
TC
2020 }
2021 elsif ($opts{'type'} eq 'max') {
658f724e
TC
2022 $x_scale = $y_scale = _max($xpix,$ypix);
2023 }
2024 elsif ($opts{'type'} eq 'nonprop' || $opts{'type'} eq 'non-proportional') {
2025 $x_scale = $xpix;
2026 $y_scale = $ypix;
5168ca3a
TC
2027 }
2028 else {
2029 $self->_set_error('invalid value for type parameter');
2030 return undef;
2031 }
2032 } elsif ($opts{xpixels}) {
658f724e 2033 $x_scale = $y_scale = $opts{xpixels} / $self->getwidth();
5168ca3a
TC
2034 }
2035 elsif ($opts{ypixels}) {
658f724e 2036 $x_scale = $y_scale = $opts{ypixels}/$self->getheight();
5168ca3a 2037 }
41c7d053
TC
2038 elsif ($opts{constrain} && ref $opts{constrain}
2039 && $opts{constrain}->can('constrain')) {
2040 # we've been passed an Image::Math::Constrain object or something
2041 # that looks like one
658f724e 2042 my $scalefactor;
4f579313 2043 (undef, undef, $scalefactor)
41c7d053 2044 = $opts{constrain}->constrain($self->getwidth, $self->getheight);
4f579313 2045 unless ($scalefactor) {
41c7d053
TC
2046 $self->_set_error('constrain method failed on constrain parameter');
2047 return undef;
2048 }
658f724e 2049 $x_scale = $y_scale = $scalefactor;
41c7d053 2050 }
02d1d628
AMH
2051
2052 if ($opts{qtype} eq 'normal') {
658f724e 2053 $tmp->{IMG} = i_scaleaxis($self->{IMG}, $x_scale, 0);
5168ca3a 2054 if ( !defined($tmp->{IMG}) ) {
4f579313 2055 $self->{ERRSTR} = 'unable to scale image';
5168ca3a
TC
2056 return undef;
2057 }
658f724e 2058 $img->{IMG}=i_scaleaxis($tmp->{IMG}, $y_scale, 1);
5168ca3a
TC
2059 if ( !defined($img->{IMG}) ) {
2060 $self->{ERRSTR}='unable to scale image';
2061 return undef;
2062 }
2063
02d1d628
AMH
2064 return $img;
2065 }
5168ca3a 2066 elsif ($opts{'qtype'} eq 'preview') {
658f724e 2067 $img->{IMG} = i_scale_nn($self->{IMG}, $x_scale, $y_scale);
5168ca3a
TC
2068 if ( !defined($img->{IMG}) ) {
2069 $self->{ERRSTR}='unable to scale image';
2070 return undef;
2071 }
02d1d628
AMH
2072 return $img;
2073 }
658f724e
TC
2074 elsif ($opts{'qtype'} eq 'mixing') {
2075 my $new_width = int(0.5 + $self->getwidth * $x_scale);
2076 my $new_height = int(0.5 + $self->getheight * $y_scale);
2077 $new_width >= 1 or $new_width = 1;
2078 $new_height >= 1 or $new_height = 1;
2079 $img->{IMG} = i_scale_mixing($self->{IMG}, $new_width, $new_height);
2080 unless ($img->{IMG}) {
2081 $self->_set_error(Imager->_error_as_meg);
2082 return;
2083 }
2084 return $img;
2085 }
5168ca3a
TC
2086 else {
2087 $self->_set_error('invalid value for qtype parameter');
2088 return undef;
2089 }
02d1d628
AMH
2090}
2091
2092# Scales only along the X axis
2093
2094sub scaleX {
15327bf5
TC
2095 my $self = shift;
2096 my %opts = ( scalefactor=>0.5, @_ );
02d1d628 2097
34b3f7e6
TC
2098 unless (defined wantarray) {
2099 my @caller = caller;
2100 warn "scaleX() called in void context - scaleX() returns the scaled image at $caller[1] line $caller[2]\n";
2101 return;
2102 }
2103
15327bf5
TC
2104 unless ($self->{IMG}) {
2105 $self->{ERRSTR} = 'empty input image';
2106 return undef;
2107 }
02d1d628
AMH
2108
2109 my $img = Imager->new();
2110
15327bf5 2111 my $scalefactor = $opts{scalefactor};
02d1d628 2112
15327bf5
TC
2113 if ($opts{pixels}) {
2114 $scalefactor = $opts{pixels} / $self->getwidth();
2115 }
2116
2117 unless ($self->{IMG}) {
2118 $self->{ERRSTR}='empty input image';
2119 return undef;
2120 }
2121
2122 $img->{IMG} = i_scaleaxis($self->{IMG}, $scalefactor, 0);
2123
2124 if ( !defined($img->{IMG}) ) {
2125 $self->{ERRSTR} = 'unable to scale image';
2126 return undef;
2127 }
02d1d628 2128
02d1d628
AMH
2129 return $img;
2130}
2131
2132# Scales only along the Y axis
2133
2134sub scaleY {
15327bf5
TC
2135 my $self = shift;
2136 my %opts = ( scalefactor => 0.5, @_ );
02d1d628 2137
34b3f7e6
TC
2138 unless (defined wantarray) {
2139 my @caller = caller;
2140 warn "scaleY() called in void context - scaleY() returns the scaled image at $caller[1] line $caller[2]\n";
2141 return;
2142 }
2143
02d1d628
AMH
2144 unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2145
2146 my $img = Imager->new();
2147
15327bf5 2148 my $scalefactor = $opts{scalefactor};
02d1d628 2149
15327bf5
TC
2150 if ($opts{pixels}) {
2151 $scalefactor = $opts{pixels} / $self->getheight();
2152 }
2153
2154 unless ($self->{IMG}) {
2155 $self->{ERRSTR} = 'empty input image';
2156 return undef;
2157 }
2158 $img->{IMG}=i_scaleaxis($self->{IMG}, $scalefactor, 1);
2159
2160 if ( !defined($img->{IMG}) ) {
2161 $self->{ERRSTR} = 'unable to scale image';
2162 return undef;
2163 }
02d1d628 2164
02d1d628
AMH
2165 return $img;
2166}
2167
02d1d628
AMH
2168# Transform returns a spatial transformation of the input image
2169# this moves pixels to a new location in the returned image.
2170# NOTE - should make a utility function to check transforms for
2171# stack overruns
2172
2173sub transform {
2174 my $self=shift;
2175 unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2176 my %opts=@_;
2177 my (@op,@ropx,@ropy,$iop,$or,@parm,$expr,@xt,@yt,@pt,$numre);
2178
2179# print Dumper(\%opts);
2180# xopcopdes
2181
2182 if ( $opts{'xexpr'} and $opts{'yexpr'} ) {
2183 if (!$I2P) {
2184 eval ("use Affix::Infix2Postfix;");
2185 print $@;
2186 if ( $@ ) {
2187 $self->{ERRSTR}='transform: expr given and Affix::Infix2Postfix is not avaliable.';
2188 return undef;
2189 }
2190 $I2P=Affix::Infix2Postfix->new('ops'=>[{op=>'+',trans=>'Add'},
2191 {op=>'-',trans=>'Sub'},
2192 {op=>'*',trans=>'Mult'},
2193 {op=>'/',trans=>'Div'},
9d540150 2194 {op=>'-','type'=>'unary',trans=>'u-'},
02d1d628 2195 {op=>'**'},
9d540150 2196 {op=>'func','type'=>'unary'}],
02d1d628
AMH
2197 'grouping'=>[qw( \( \) )],
2198 'func'=>[qw( sin cos )],
2199 'vars'=>[qw( x y )]
2200 );
2201 }
2202
2203 @xt=$I2P->translate($opts{'xexpr'});
2204 @yt=$I2P->translate($opts{'yexpr'});
2205
2206 $numre=$I2P->{'numre'};
2207 @pt=(0,0);
2208
2209 for(@xt) { if (/$numre/) { push(@pt,$_); push(@{$opts{'xopcodes'}},'Parm',$#pt); } else { push(@{$opts{'xopcodes'}},$_); } }
2210 for(@yt) { if (/$numre/) { push(@pt,$_); push(@{$opts{'yopcodes'}},'Parm',$#pt); } else { push(@{$opts{'yopcodes'}},$_); } }
2211 @{$opts{'parm'}}=@pt;
2212 }
2213
2214# print Dumper(\%opts);
2215
2216 if ( !exists $opts{'xopcodes'} or @{$opts{'xopcodes'}}==0) {
2217 $self->{ERRSTR}='transform: no xopcodes given.';
2218 return undef;
2219 }
2220
2221 @op=@{$opts{'xopcodes'}};
2222 for $iop (@op) {
2223 if (!defined ($OPCODES{$iop}) and ($iop !~ /^\d+$/) ) {
2224 $self->{ERRSTR}="transform: illegal opcode '$_'.";
2225 return undef;
2226 }
2227 push(@ropx,(exists $OPCODES{$iop}) ? @{$OPCODES{$iop}} : $iop );
2228 }
2229
2230
2231# yopcopdes
2232
2233 if ( !exists $opts{'yopcodes'} or @{$opts{'yopcodes'}}==0) {
2234 $self->{ERRSTR}='transform: no yopcodes given.';
2235 return undef;
2236 }
2237
2238 @op=@{$opts{'yopcodes'}};
2239 for $iop (@op) {
2240 if (!defined ($OPCODES{$iop}) and ($iop !~ /^\d+$/) ) {
2241 $self->{ERRSTR}="transform: illegal opcode '$_'.";
2242 return undef;
2243 }
2244 push(@ropy,(exists $OPCODES{$iop}) ? @{$OPCODES{$iop}} : $iop );
2245 }
2246
2247#parameters
2248
2249 if ( !exists $opts{'parm'}) {
2250 $self->{ERRSTR}='transform: no parameter arg given.';
2251 return undef;
2252 }
2253
2254# print Dumper(\@ropx);
2255# print Dumper(\@ropy);
2256# print Dumper(\@ropy);
2257
2258 my $img = Imager->new();
2259 $img->{IMG}=i_transform($self->{IMG},\@ropx,\@ropy,$opts{'parm'});
2260 if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='transform: failed'; return undef; }
2261 return $img;
2262}
2263
2264
bf94b653
TC
2265sub transform2 {
2266 my ($opts, @imgs) = @_;
2267
2268 require "Imager/Expr.pm";
2269
2270 $opts->{variables} = [ qw(x y) ];
2271 my ($width, $height) = @{$opts}{qw(width height)};
2272 if (@imgs) {
2273 $width ||= $imgs[0]->getwidth();
2274 $height ||= $imgs[0]->getheight();
2275 my $img_num = 1;
2276 for my $img (@imgs) {
2277 $opts->{constants}{"w$img_num"} = $img->getwidth();
2278 $opts->{constants}{"h$img_num"} = $img->getheight();
2279 $opts->{constants}{"cx$img_num"} = $img->getwidth()/2;
2280 $opts->{constants}{"cy$img_num"} = $img->getheight()/2;
2281 ++$img_num;
02d1d628 2282 }
02d1d628 2283 }
bf94b653
TC
2284 if ($width) {
2285 $opts->{constants}{w} = $width;
2286 $opts->{constants}{cx} = $width/2;
2287 }
2288 else {
2289 $Imager::ERRSTR = "No width supplied";
2290 return;
2291 }
2292 if ($height) {
2293 $opts->{constants}{h} = $height;
2294 $opts->{constants}{cy} = $height/2;
2295 }
2296 else {
2297 $Imager::ERRSTR = "No height supplied";
2298 return;
2299 }
2300 my $code = Imager::Expr->new($opts);
2301 if (!$code) {
2302 $Imager::ERRSTR = Imager::Expr::error();
2303 return;
2304 }
e5744e01
TC
2305 my $channels = $opts->{channels} || 3;
2306 unless ($channels >= 1 && $channels <= 4) {
2307 return Imager->_set_error("channels must be an integer between 1 and 4");
2308 }
9982a307 2309
bf94b653 2310 my $img = Imager->new();
e5744e01
TC
2311 $img->{IMG} = i_transform2($opts->{width}, $opts->{height},
2312 $channels, $code->code(),
bf94b653
TC
2313 $code->nregs(), $code->cregs(),
2314 [ map { $_->{IMG} } @imgs ]);
2315 if (!defined $img->{IMG}) {
2316 $Imager::ERRSTR = Imager->_error_as_msg();
2317 return;
2318 }
9982a307 2319
bf94b653 2320 return $img;
02d1d628
AMH
2321}
2322
02d1d628
AMH
2323sub rubthrough {
2324 my $self=shift;
71dc4a83 2325 my %opts=(tx => 0,ty => 0, @_);
02d1d628 2326
e7b95388
TC
2327 unless ($self->{IMG}) {
2328 $self->{ERRSTR}='empty input image';
2329 return undef;
2330 }
2331 unless ($opts{src} && $opts{src}->{IMG}) {
2332 $self->{ERRSTR}='empty input image for src';
2333 return undef;
2334 }
02d1d628 2335
71dc4a83
AMH
2336 %opts = (src_minx => 0,
2337 src_miny => 0,
2338 src_maxx => $opts{src}->getwidth(),
2339 src_maxy => $opts{src}->getheight(),
2340 %opts);
2341
2342 unless (i_rubthru($self->{IMG}, $opts{src}->{IMG}, $opts{tx}, $opts{ty},
e7b95388
TC
2343 $opts{src_minx}, $opts{src_miny},
2344 $opts{src_maxx}, $opts{src_maxy})) {
2345 $self->_set_error($self->_error_as_msg());
faa9b3e7
TC
2346 return undef;
2347 }
02d1d628
AMH
2348 return $self;
2349}
2350
2351
142c26ff
AMH
2352sub flip {
2353 my $self = shift;
2354 my %opts = @_;
9191e525 2355 my %xlate = (h=>0, v=>1, hv=>2, vh=>2);
142c26ff
AMH
2356 my $dir;
2357 return () unless defined $opts{'dir'} and defined $xlate{$opts{'dir'}};
2358 $dir = $xlate{$opts{'dir'}};
2359 return $self if i_flipxy($self->{IMG}, $dir);
2360 return ();
2361}
2362
faa9b3e7
TC
2363sub rotate {
2364 my $self = shift;
2365 my %opts = @_;
34b3f7e6
TC
2366
2367 unless (defined wantarray) {
2368 my @caller = caller;
2369 warn "rotate() called in void context - rotate() returns the rotated image at $caller[1] line $caller[2]\n";
2370 return;
2371 }
2372
faa9b3e7
TC
2373 if (defined $opts{right}) {
2374 my $degrees = $opts{right};
2375 if ($degrees < 0) {
2376 $degrees += 360 * int(((-$degrees)+360)/360);
2377 }
2378 $degrees = $degrees % 360;
2379 if ($degrees == 0) {
2380 return $self->copy();
2381 }
2382 elsif ($degrees == 90 || $degrees == 180 || $degrees == 270) {
2383 my $result = Imager->new();
2384 if ($result->{IMG} = i_rotate90($self->{IMG}, $degrees)) {
2385 return $result;
2386 }
2387 else {
2388 $self->{ERRSTR} = $self->_error_as_msg();
2389 return undef;
2390 }
2391 }
2392 else {
2393 $self->{ERRSTR} = "Parameter 'right' must be a multiple of 90 degrees";
2394 return undef;
2395 }
2396 }
2397 elsif (defined $opts{radians} || defined $opts{degrees}) {
2398 my $amount = $opts{radians} || $opts{degrees} * 3.1415926535 / 180;
2399
7f627571 2400 my $back = $opts{back};
faa9b3e7 2401 my $result = Imager->new;
7f627571
TC
2402 if ($back) {
2403 $back = _color($back);
2404 unless ($back) {
2405 $self->_set_error(Imager->errstr);
2406 return undef;
2407 }
2408
2409 $result->{IMG} = i_rotate_exact($self->{IMG}, $amount, $back);
0d3b936e
TC
2410 }
2411 else {
2412 $result->{IMG} = i_rotate_exact($self->{IMG}, $amount);
2413 }
2414 if ($result->{IMG}) {
faa9b3e7
TC
2415 return $result;
2416 }
2417 else {
2418 $self->{ERRSTR} = $self->_error_as_msg();
2419 return undef;
2420 }
2421 }
2422 else {
0d3b936e 2423 $self->{ERRSTR} = "Only the 'right', 'radians' and 'degrees' parameters are available";
faa9b3e7
TC
2424 return undef;
2425 }
2426}
2427
2428sub matrix_transform {
2429 my $self = shift;
2430 my %opts = @_;
2431
34b3f7e6
TC
2432 unless (defined wantarray) {
2433 my @caller = caller;
2434 warn "copy() called in void context - copy() returns the copied image at $caller[1] line $caller[2]\n";
2435 return;
2436 }
2437
faa9b3e7
TC
2438 if ($opts{matrix}) {
2439 my $xsize = $opts{xsize} || $self->getwidth;
2440 my $ysize = $opts{ysize} || $self->getheight;
142c26ff 2441
faa9b3e7 2442 my $result = Imager->new;
0d3b936e
TC
2443 if ($opts{back}) {
2444 $result->{IMG} = i_matrix_transform($self->{IMG}, $xsize, $ysize,
2445 $opts{matrix}, $opts{back})
2446 or return undef;
2447 }
2448 else {
2449 $result->{IMG} = i_matrix_transform($self->{IMG}, $xsize, $ysize,
2450 $opts{matrix})
2451 or return undef;
2452 }
faa9b3e7
TC
2453
2454 return $result;
2455 }
2456 else {
2457 $self->{ERRSTR} = "matrix parameter required";
2458 return undef;
2459 }
2460}
2461
2462# blame Leolo :)
2463*yatf = \&matrix_transform;
02d1d628
AMH
2464
2465# These two are supported for legacy code only
2466
2467sub i_color_new {
faa9b3e7 2468 return Imager::Color->new(@_);
02d1d628
AMH
2469}
2470
2471sub i_color_set {
faa9b3e7 2472 return Imager::Color::set(@_);
02d1d628
AMH
2473}
2474
02d1d628 2475# Draws a box between the specified corner points.
02d1d628
AMH
2476sub box {
2477 my $self=shift;
2478 unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2479 my $dflcl=i_color_new(255,255,255,255);
2480 my %opts=(color=>$dflcl,xmin=>0,ymin=>0,xmax=>$self->getwidth()-1,ymax=>$self->getheight()-1,@_);
2481
2482 if (exists $opts{'box'}) {
bf1573f9
TC
2483 $opts{'xmin'} = _min($opts{'box'}->[0],$opts{'box'}->[2]);
2484 $opts{'xmax'} = _max($opts{'box'}->[0],$opts{'box'}->[2]);
2485 $opts{'ymin'} = _min($opts{'box'}->[1],$opts{'box'}->[3]);
2486 $opts{'ymax'} = _max($opts{'box'}->[1],$opts{'box'}->[3]);
02d1d628
AMH
2487 }
2488
f1ac5027 2489 if ($opts{filled}) {
3a9a4241
TC
2490 my $color = _color($opts{'color'});
2491 unless ($color) {
2492 $self->{ERRSTR} = $Imager::ERRSTR;
2493 return;
2494 }
f1ac5027 2495 i_box_filled($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},
3a9a4241 2496 $opts{ymax}, $color);
f1ac5027
TC
2497 }
2498 elsif ($opts{fill}) {
2499 unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
2500 # assume it's a hash ref
2501 require 'Imager/Fill.pm';
141a6114
TC
2502 unless ($opts{fill} = Imager::Fill->new(%{$opts{fill}})) {
2503 $self->{ERRSTR} = $Imager::ERRSTR;
2504 return undef;
2505 }
f1ac5027
TC
2506 }
2507 i_box_cfill($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},
2508 $opts{ymax},$opts{fill}{fill});
2509 }
cdd23610 2510 else {
3a9a4241
TC
2511 my $color = _color($opts{'color'});
2512 unless ($color) {
cdd23610
AMH
2513 $self->{ERRSTR} = $Imager::ERRSTR;
2514 return;
3a9a4241
TC
2515 }
2516 i_box($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},$opts{ymax},
2517 $color);
f1ac5027 2518 }
02d1d628
AMH
2519 return $self;
2520}
2521
02d1d628
AMH
2522sub arc {
2523 my $self=shift;
2524 unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2525 my $dflcl=i_color_new(255,255,255,255);
2526 my %opts=(color=>$dflcl,
bf1573f9 2527 'r'=>_min($self->getwidth(),$self->getheight())/3,
02d1d628
AMH
2528 'x'=>$self->getwidth()/2,
2529 'y'=>$self->getheight()/2,
2530 'd1'=>0, 'd2'=>361, @_);
a8652edf
TC
2531 if ($opts{aa}) {
2532 if ($opts{fill}) {
2533 unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
2534 # assume it's a hash ref
2535 require 'Imager/Fill.pm';
2536 unless ($opts{fill} = Imager::Fill->new(%{$opts{fill}})) {
2537 $self->{ERRSTR} = $Imager::ERRSTR;
2538 return;
2539 }
2540 }
2541 i_arc_aa_cfill($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},$opts{'d1'},
2542 $opts{'d2'}, $opts{fill}{fill});
2543 }
2544 else {
2545 my $color = _color($opts{'color'});
2546 unless ($color) {
2547 $self->{ERRSTR} = $Imager::ERRSTR;
2548 return;
2549 }
2550 if ($opts{d1} == 0 && $opts{d2} == 361 && $opts{aa}) {
2551 i_circle_aa($self->{IMG}, $opts{'x'}, $opts{'y'}, $opts{'r'},
2552 $color);
2553 }
2554 else {
2555 i_arc_aa($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},
2556 $opts{'d1'}, $opts{'d2'}, $color);
569795e8 2557 }
f1ac5027 2558 }
f1ac5027
TC
2559 }
2560 else {
a8652edf
TC
2561 if ($opts{fill}) {
2562 unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
2563 # assume it's a hash ref
2564 require 'Imager/Fill.pm';
2565 unless ($opts{fill} = Imager::Fill->new(%{$opts{fill}})) {
2566 $self->{ERRSTR} = $Imager::ERRSTR;
2567 return;
2568 }
2569 }
2570 i_arc_cfill($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},$opts{'d1'},
2571 $opts{'d2'}, $opts{fill}{fill});
0d321238
TC
2572 }
2573 else {
a8652edf
TC
2574 my $color = _color($opts{'color'});
2575 unless ($color) {
2576 $self->{ERRSTR} = $Imager::ERRSTR;
2577 return;
2578 }
c5baef69
TC
2579 i_arc($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},
2580 $opts{'d1'}, $opts{'d2'}, $color);
0d321238 2581 }
f1ac5027
TC
2582 }
2583
02d1d628
AMH
2584 return $self;
2585}
2586
aa833c97
AMH
2587# Draws a line from one point to the other
2588# the endpoint is set if the endp parameter is set which it is by default.
2589# to turn of the endpoint being set use endp=>0 when calling line.
02d1d628
AMH
2590
2591sub line {
2592 my $self=shift;
2593 my $dflcl=i_color_new(0,0,0,0);
aa833c97
AMH
2594 my %opts=(color=>$dflcl,
2595 endp => 1,
2596 @_);
02d1d628
AMH
2597 unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2598
2599 unless (exists $opts{x1} and exists $opts{y1}) { $self->{ERRSTR}='missing begining coord'; return undef; }
2600 unless (exists $opts{x2} and exists $opts{y2}) { $self->{ERRSTR}='missing ending coord'; return undef; }
2601
3a9a4241 2602 my $color = _color($opts{'color'});
aa833c97
AMH
2603 unless ($color) {
2604 $self->{ERRSTR} = $Imager::ERRSTR;
2605 return;
3a9a4241 2606 }
aa833c97 2607
3a9a4241 2608 $opts{antialias} = $opts{aa} if defined $opts{aa};
02d1d628 2609 if ($opts{antialias}) {
aa833c97 2610 i_line_aa($self->{IMG},$opts{x1}, $opts{y1}, $opts{x2}, $opts{y2},
b437ce0a 2611 $color, $opts{endp});
02d1d628 2612 } else {
aa833c97
AMH
2613 i_line($self->{IMG},$opts{x1}, $opts{y1}, $opts{x2}, $opts{y2},
2614 $color, $opts{endp});
02d1d628
AMH
2615 }
2616 return $self;
2617}
2618
2619# Draws a line between an ordered set of points - It more or less just transforms this
2620# into a list of lines.
2621
2622sub polyline {
2623 my $self=shift;
2624 my ($pt,$ls,@points);
2625 my $dflcl=i_color_new(0,0,0,0);
2626 my %opts=(color=>$dflcl,@_);
2627
2628 unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2629
2630 if (exists($opts{points})) { @points=@{$opts{points}}; }
2631 if (!exists($opts{points}) and exists($opts{'x'}) and exists($opts{'y'}) ) {
2632 @points=map { [ $opts{'x'}->[$_],$opts{'y'}->[$_] ] } (0..(scalar @{$opts{'x'}}-1));
2633 }
2634
2635# print Dumper(\@points);
2636
3a9a4241
TC
2637 my $color = _color($opts{'color'});
2638 unless ($color) {
2639 $self->{ERRSTR} = $Imager::ERRSTR;
2640 return;
2641 }
2642 $opts{antialias} = $opts{aa} if defined $opts{aa};
02d1d628
AMH
2643 if ($opts{antialias}) {
2644 for $pt(@points) {
3a9a4241 2645 if (defined($ls)) {
b437ce0a 2646 i_line_aa($self->{IMG},$ls->[0],$ls->[1],$pt->[0],$pt->[1],$color, 1);
3a9a4241 2647 }
02d1d628
AMH
2648 $ls=$pt;
2649 }
2650 } else {
2651 for $pt(@points) {
3a9a4241 2652 if (defined($ls)) {
aa833c97 2653 i_line($self->{IMG},$ls->[0],$ls->[1],$pt->[0],$pt->[1],$color,1);
3a9a4241 2654 }
02d1d628
AMH
2655 $ls=$pt;
2656 }
2657 }
2658 return $self;
2659}
2660
d0e7bfee
AMH
2661sub polygon {
2662 my $self = shift;
2663 my ($pt,$ls,@points);
2664 my $dflcl = i_color_new(0,0,0,0);
2665 my %opts = (color=>$dflcl, @_);
2666
2667 unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2668
2669 if (exists($opts{points})) {
2670 $opts{'x'} = [ map { $_->[0] } @{$opts{points}} ];
2671 $opts{'y'} = [ map { $_->[1] } @{$opts{points}} ];
2672 }
2673
2674 if (!exists $opts{'x'} or !exists $opts{'y'}) {
2675 $self->{ERRSTR} = 'no points array, or x and y arrays.'; return undef;
2676 }
2677
43c5dacb
TC
2678 if ($opts{'fill'}) {
2679 unless (UNIVERSAL::isa($opts{'fill'}, 'Imager::Fill')) {
2680 # assume it's a hash ref
2681 require 'Imager/Fill.pm';
2682 unless ($opts{'fill'} = Imager::Fill->new(%{$opts{'fill'}})) {
2683 $self->{ERRSTR} = $Imager::ERRSTR;
2684 return undef;
2685 }
2686 }
2687 i_poly_aa_cfill($self->{IMG}, $opts{'x'}, $opts{'y'},
2688 $opts{'fill'}{'fill'});
2689 }
2690 else {
3a9a4241
TC
2691 my $color = _color($opts{'color'});
2692 unless ($color) {
2693 $self->{ERRSTR} = $Imager::ERRSTR;
2694 return;
2695 }
2696 i_poly_aa($self->{IMG}, $opts{'x'}, $opts{'y'}, $color);
43c5dacb
TC
2697 }
2698
d0e7bfee
AMH
2699 return $self;
2700}
2701
2702
2703# this the multipoint bezier curve
02d1d628
AMH
2704# this is here more for testing that actual usage since
2705# this is not a good algorithm. Usually the curve would be
2706# broken into smaller segments and each done individually.
2707
2708sub polybezier {
2709 my $self=shift;
2710 my ($pt,$ls,@points);
2711 my $dflcl=i_color_new(0,0,0,0);
2712 my %opts=(color=>$dflcl,@_);
2713
2714 unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2715
2716 if (exists $opts{points}) {
2717 $opts{'x'}=map { $_->[0]; } @{$opts{'points'}};
2718 $opts{'y'}=map { $_->[1]; } @{$opts{'points'}};
2719 }
2720
2721 unless ( @{$opts{'x'}} and @{$opts{'x'}} == @{$opts{'y'}} ) {
2722 $self->{ERRSTR}='Missing or invalid points.';
2723 return;
2724 }
2725
3a9a4241
TC
2726 my $color = _color($opts{'color'});
2727 unless ($color) {
2728 $self->{ERRSTR} = $Imager::ERRSTR;
2729 return;
2730 }
2731 i_bezier_multi($self->{IMG},$opts{'x'},$opts{'y'},$color);
02d1d628
AMH
2732 return $self;
2733}
2734
cc6483e0
TC
2735sub flood_fill {
2736 my $self = shift;
2737 my %opts = ( color=>Imager::Color->new(255, 255, 255), @_ );
aa833c97
AMH
2738 my $rc;
2739
9d540150 2740 unless (exists $opts{'x'} && exists $opts{'y'}) {
cc6483e0
TC
2741 $self->{ERRSTR} = "missing seed x and y parameters";
2742 return undef;
2743 }
07d70837 2744
3efb0915
TC
2745 if ($opts{border}) {
2746 my $border = _color($opts{border});
2747 unless ($border) {
2748 $self->_set_error($Imager::ERRSTR);
2749 return;
2750 }
2751 if ($opts{fill}) {
2752 unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
2753 # assume it's a hash ref
2754 require Imager::Fill;
2755 unless ($opts{fill} = Imager::Fill->new(%{$opts{fill}})) {
2756 $self->{ERRSTR} = $Imager::ERRSTR;
2757 return;
2758 }
569795e8 2759 }
3efb0915
TC
2760 $rc = i_flood_cfill_border($self->{IMG}, $opts{'x'}, $opts{'y'},
2761 $opts{fill}{fill}, $border);
2762 }
2763 else {
2764 my $color = _color($opts{'color'});
2765 unless ($color) {
2766 $self->{ERRSTR} = $Imager::ERRSTR;
2767 return;
2768 }
2769 $rc = i_flood_fill_border($self->{IMG}, $opts{'x'}, $opts{'y'},
2770 $color, $border);
2771 }
2772 if ($rc) {
2773 return $self;
2774 }
2775 else {
2776 $self->{ERRSTR} = $self->_error_as_msg();
2777 return;
cc6483e0 2778 }
cc6483e0
TC
2779 }
2780 else {
3efb0915
TC
2781 if ($opts{fill}) {
2782 unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
2783 # assume it's a hash ref
2784 require 'Imager/Fill.pm';
2785 unless ($opts{fill} = Imager::Fill->new(%{$opts{fill}})) {
2786 $self->{ERRSTR} = $Imager::ERRSTR;
2787 return;
2788 }
2789 }
2790 $rc = i_flood_cfill($self->{IMG}, $opts{'x'}, $opts{'y'}, $opts{fill}{fill});
2791 }
2792 else {
2793 my $color = _color($opts{'color'});
2794 unless ($color) {
2795 $self->{ERRSTR} = $Imager::ERRSTR;
2796 return;
2797 }
2798 $rc = i_flood_fill($self->{IMG}, $opts{'x'}, $opts{'y'}, $color);
2799 }
2800 if ($rc) {
2801 return $self;
2802 }
2803 else {
2804 $self->{ERRSTR} = $self->_error_as_msg();
aa833c97 2805 return;
3a9a4241 2806 }
3efb0915 2807 }
cc6483e0
TC
2808}
2809
591b5954
TC
2810sub setpixel {
2811 my $self = shift;
2812
2813 my %opts = ( color=>$self->{fg} || NC(255, 255, 255), @_);
2814
2815 unless (exists $opts{'x'} && exists $opts{'y'}) {
2816 $self->{ERRSTR} = 'missing x and y parameters';
2817 return undef;
2818 }
2819
2820 my $x = $opts{'x'};
2821 my $y = $opts{'y'};
2822 my $color = _color($opts{color})
2823 or return undef;
2824 if (ref $x && ref $y) {
2825 unless (@$x == @$y) {
9650c424 2826 $self->{ERRSTR} = 'length of x and y mismatch';
591b5954
TC
2827 return undef;
2828 }
2829 if ($color->isa('Imager::Color')) {
2830 for my $i (0..$#{$opts{'x'}}) {
2831 i_ppix($self->{IMG}, $x->[$i], $y->[$i], $color);
2832 }
2833 }
2834 else {
2835 for my $i (0..$#{$opts{'x'}}) {
2836 i_ppixf($self->{IMG}, $x->[$i], $y->[$i], $color);
2837 }
2838 }
2839 }
2840 else {
2841 if ($color->isa('Imager::Color')) {
2842 i_ppix($self->{IMG}, $x, $y, $color);
2843 }
2844 else {
2845 i_ppixf($self->{IMG}, $x, $y, $color);
2846 }
2847 }
2848
2849 $self;
2850}
2851
2852sub getpixel {
2853 my $self = shift;
2854
a9fa203f 2855 my %opts = ( "type"=>'8bit', @_);
591b5954
TC
2856
2857 unless (exists $opts{'x'} && exists $opts{'y'}) {
2858 $self->{ERRSTR} = 'missing x and y parameters';
2859 return undef;
2860 }
2861
2862 my $x = $opts{'x'};
2863 my $y = $opts{'y'};
2864 if (ref $x && ref $y) {
2865 unless (@$x == @$y) {
2866 $self->{ERRSTR} = 'length of x and y mismatch';
2867 return undef;
2868 }
2869 my @result;
a9fa203f 2870 if ($opts{"type"} eq '8bit') {
591b5954
TC
2871 for my $i (0..$#{$opts{'x'}}) {
2872 push(@result, i_get_pixel($self->{IMG}, $x->[$i], $y->[$i]));
2873 }
2874 }
2875 else {
2876 for my $i (0..$#{$opts{'x'}}) {
2877 push(@result, i_gpixf($self->{IMG}, $x->[$i], $y->[$i]));
2878 }
2879 }
2880 return wantarray ? @result : \@result;
2881 }
2882 else {
a9fa203f 2883 if ($opts{"type"} eq '8bit') {
591b5954
TC
2884 return i_get_pixel($self->{IMG}, $x, $y);
2885 }
2886 else {
2887 return i_gpixf($self->{IMG}, $x, $y);
2888 }
2889 }
2890
2891 $self;
2892}
2893
ca4d914e
TC
2894sub getscanline {
2895 my $self = shift;
2896 my %opts = ( type => '8bit', x=>0, @_);
2897
4cda4e76
TC
2898 $self->_valid_image or return;
2899
ca4d914e
TC
2900 defined $opts{width} or $opts{width} = $self->getwidth - $opts{x};
2901
2902 unless (defined $opts{'y'}) {
2903 $self->_set_error("missing y parameter");
2904 return;
2905 }
2906
2907 if ($opts{type} eq '8bit') {
2908 return i_glin($self->{IMG}, $opts{x}, $opts{x}+$opts{width},
4cda4e76 2909 $opts{'y'});
ca4d914e
TC
2910 }
2911 elsif ($opts{type} eq 'float') {
2912 return i_glinf($self->{IMG}, $opts{x}, $opts{x}+$opts{width},
4cda4e76
TC
2913 $opts{'y'});
2914 }
2915 elsif ($opts{type} eq 'index') {
2916 unless (i_img_type($self->{IMG})) {
2917 $self->_set_error("type => index only valid on paletted images");
2918 return;
2919 }
2920 return i_gpal($self->{IMG}, $opts{x}, $opts{x} + $opts{width},
2921 $opts{'y'});
ca4d914e
TC
2922 }
2923 else {
2924 $self->_set_error("invalid type parameter - must be '8bit' or 'float'");
2925 return;
2926 }
2927}
2928
2929sub setscanline {
2930 my $self = shift;
2931 my %opts = ( x=>0, @_);
2932
4cda4e76
TC
2933 $self->_valid_image or return;
2934
ca4d914e
TC
2935 unless (defined $opts{'y'}) {
2936 $self->_set_error("missing y parameter");
2937 return;
2938 }
2939
2940 if (!$opts{type}) {
2941 if (ref $opts{pixels} && @{$opts{pixels}}) {
2942 # try to guess the type
2943 if ($opts{pixels}[0]->isa('Imager::Color')) {
2944 $opts{type} = '8bit';
2945 }
2946 elsif ($opts{pixels}[0]->isa('Imager::Color::Float')) {
2947 $opts{type} = 'float';
2948 }
2949 else {
2950 $self->_set_error("missing type parameter and could not guess from pixels");
2951 return;
2952 }
2953 }
2954 else {
2955 # default
2956 $opts{type} = '8bit';
2957 }
2958 }
2959
2960 if ($opts{type} eq '8bit') {
2961 if (ref $opts{pixels}) {
2962 return i_plin($self->{IMG}, $opts{x}, $opts{'y'}, @{$opts{pixels}});
2963 }
2964 else {
2965 return i_plin($self->{IMG}, $opts{x}, $opts{'y'}, $opts{pixels});
2966 }
2967 }
2968 elsif ($opts{type} eq 'float') {
2969 if (ref $opts{pixels}) {
2970 return i_plinf($self->{IMG}, $opts{x}, $opts{'y'}, @{$opts{pixels}});
2971 }
2972 else {
2973 return i_plinf($self->{IMG}, $opts{x}, $opts{'y'}, $opts{pixels});
2974 }
2975 }
4cda4e76
TC
2976 elsif ($opts{type} eq 'index') {
2977 if (ref $opts{pixels}) {
2978 return i_ppal($self->{IMG}, $opts{x}, $opts{'y'}, @{$opts{pixels}});
2979 }
2980 else {
2981 return i_ppal_p($self->{IMG}, $opts{x}, $opts{'y'}, $opts{pixels});
2982 }
2983 }
ca4d914e
TC
2984 else {
2985 $self->_set_error("invalid type parameter - must be '8bit' or 'float'");
2986 return;
2987 }
2988}
2989
2990sub getsamples {
2991 my $self = shift;
2992 my %opts = ( type => '8bit', x=>0, @_);
2993
2994 defined $opts{width} or $opts{width} = $self->getwidth - $opts{x};
2995
2996 unless (defined $opts{'y'}) {
2997 $self->_set_error("missing y parameter");
2998 return;
2999 }
3000
3001 unless ($opts{channels}) {
3002 $opts{channels} = [ 0 .. $self->getchannels()-1 ];
3003 }
3004
3005 if ($opts{type} eq '8bit') {
3006 return i_gsamp($self->{IMG}, $opts{x}, $opts{x}+$opts{width},
3007 $opts{y}, @{$opts{channels}});
3008 }
3009 elsif ($opts{type} eq 'float') {
3010 return i_gsampf($self->{IMG}, $opts{x}, $opts{x}+$opts{width},
3011 $opts{y}, @{$opts{channels}});
3012 }
3013 else {
3014 $self->_set_error("invalid type parameter - must be '8bit' or 'float'");
3015 return;
3016 }
3017}
3018
f5991c03
TC
3019# make an identity matrix of the given size
3020sub _identity {
3021 my ($size) = @_;
3022
3023 my $matrix = [ map { [ (0) x $size ] } 1..$size ];
3024 for my $c (0 .. ($size-1)) {
3025 $matrix->[$c][$c] = 1;
3026 }
3027 return $matrix;
3028}
3029
3030# general function to convert an image
3031sub convert {
3032 my ($self, %opts) = @_;
3033 my $matrix;
3034
34b3f7e6
TC
3035 unless (defined wantarray) {
3036 my @caller = caller;
3037 warn "convert() called in void context - convert() returns the converted image at $caller[1] line $caller[2]\n";
3038 return;
3039 }
3040
f5991c03
TC
3041 # the user can either specify a matrix or preset
3042 # the matrix overrides the preset
3043 if (!exists($opts{matrix})) {
3044 unless (exists($opts{preset})) {
3045 $self->{ERRSTR} = "convert() needs a matrix or preset";
3046 return;
3047 }
3048 else {
3049 if ($opts{preset} eq 'gray' || $opts{preset} eq 'grey') {
3050 # convert to greyscale, keeping the alpha channel if any
3051 if ($self->getchannels == 3) {
3052 $matrix = [ [ 0.222, 0.707, 0.071 ] ];
3053 }
3054 elsif ($self->getchannels == 4) {
3055 # preserve the alpha channel
3056 $matrix = [ [ 0.222, 0.707, 0.071, 0 ],
3057 [ 0, 0, 0, 1 ] ];
3058 }
3059 else {
3060 # an identity
3061 $matrix = _identity($self->getchannels);
3062 }
3063 }
3064 elsif ($opts{preset} eq 'noalpha') {
3065 # strip the alpha channel
3066 if ($self->getchannels == 2 or $self->getchannels == 4) {
3067 $matrix = _identity($self->getchannels);
3068 pop(@$matrix); # lose the alpha entry
3069 }
3070 else {
3071 $matrix = _identity($self->getchannels);
3072 }
3073 }
3074 elsif ($opts{preset} eq 'red' || $opts{preset} eq 'channel0') {
3075 # extract channel 0
3076 $matrix = [ [ 1 ] ];
3077 }
3078 elsif ($opts{preset} eq 'green' || $opts{preset} eq 'channel1') {
3079 $matrix = [ [ 0, 1 ] ];
3080 }
3081 elsif ($opts{preset} eq 'blue' || $opts{preset} eq 'channel2') {
3082 $matrix = [ [ 0, 0, 1 ] ];
3083 }
3084 elsif ($opts{preset} eq 'alpha') {
3085 if ($self->getchannels == 2 or $self->getchannels == 4) {
3086 $matrix = [ [ (0) x ($self->getchannels-1), 1 ] ];
3087 }
3088 else {
3089 # the alpha is just 1 <shrug>
3090 $matrix = [ [ (0) x $self->getchannels, 1 ] ];
3091 }
3092 }
3093 elsif ($opts{preset} eq 'rgb') {
3094 if ($self->getchannels == 1) {
3095 $matrix = [ [ 1 ], [ 1 ], [ 1 ] ];
3096 }
3097 elsif ($self->getchannels == 2) {
3098 # preserve the alpha channel
3099 $matrix = [ [ 1, 0 ], [ 1, 0 ], [ 1, 0 ], [ 0, 1 ] ];
3100 }
3101 else {
3102 $matrix = _identity($self->getchannels);
3103 }
3104 }
3105 elsif ($opts{preset} eq 'addalpha') {
3106 if ($self->getchannels == 1) {
3107 $matrix = _identity(2);
3108 }
3109 elsif ($self->getchannels == 3) {
3110 $matrix = _identity(4);
3111 }
3112 else {
3113 $matrix = _identity($self->getchannels);
3114 }
3115 }
3116 else {
3117 $self->{ERRSTR} = "Unknown convert preset $opts{preset}";
3118 return undef;
3119 }
3120 }
3121 }
3122 else {
3123 $matrix = $opts{matrix};
3124 }
3125
3126 my $new = Imager->new();
3127 $new->{IMG} = i_img_new();
3128 unless (i_convert($new->{IMG}, $self->{IMG}, $matrix)) {
3129 # most likely a bad matrix
3130 $self->{ERRSTR} = _error_as_msg();
3131 return undef;
3132 }
3133 return $new;
3134}
40eba1ea
AMH
3135
3136
40eba1ea 3137# general function to map an image through lookup tables
9495ee93 3138
40eba1ea
AMH
3139sub map {
3140 my ($self, %opts) = @_;
9495ee93 3141 my @chlist = qw( red green blue alpha );
40eba1ea
AMH
3142
3143 if (!exists($opts{'maps'})) {
3144 # make maps from channel maps
3145 my $chnum;
3146 for $chnum (0..$#chlist) {
9495ee93
AMH
3147 if (exists $opts{$chlist[$chnum]}) {
3148 $opts{'maps'}[$chnum] = $opts{$chlist[$chnum]};
3149 } elsif (exists $opts{'all'}) {
3150 $opts{'maps'}[$chnum] = $opts{'all'};
3151 }
40eba1ea
AMH
3152 }
3153 }
3154 if ($opts{'maps'} and $self->{IMG}) {
3155 i_map($self->{IMG}, $opts{'maps'} );
3156 }
3157 return $self;
3158}
3159
dff75dee
TC
3160sub difference {
3161 my ($self, %opts) = @_;
3162
3163 defined $opts{mindist} or $opts{mindist} = 0;
3164
3165 defined $opts{other}
3166 or return $self->_set_error("No 'other' parameter supplied");
3167 defined $opts{other}{IMG}
3168 or return $self->_set_error("No image data in 'other' image");
3169
3170 $self->{IMG}
3171 or return $self->_set_error("No image data");
3172
3173 my $result = Imager->new;
3174 $result->{IMG} = i_diff_image($self->{IMG}, $opts{other}{IMG},
3175 $opts{mindist})
3176 or return $self->_set_error($self->_error_as_msg());
3177
3178 return $result;
3179}
3180
02d1d628
AMH
3181# destructive border - image is shrunk by one pixel all around
3182
3183sub border {
3184 my ($self,%opts)=@_;
3185 my($tx,$ty)=($self->getwidth()-1,$self->getheight()-1);
3186 $self->polyline('x'=>[0,$tx,$tx,0,0],'y'=>[0,0,$ty,$ty,0],%opts);
3187}
3188
3189
3190# Get the width of an image
3191
3192sub getwidth {
3193 my $self = shift;
3194 if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
3195 return (i_img_info($self->{IMG}))[0];
3196}
3197
3198# Get the height of an image
3199
3200sub getheight {
3201 my $self = shift;
3202 if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
3203 return (i_img_info($self->{IMG}))[1];
3204}
3205
3206# Get number of channels in an image
3207
3208sub getchannels {
3209 my $self = shift;
3210 if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
3211 return i_img_getchannels($self->{IMG});
3212}
3213
3214# Get channel mask
3215
3216sub getmask {
3217 my $self = shift;
3218 if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
3219 return i_img_getmask($self->{IMG});
3220}
3221
3222# Set channel mask
3223
3224sub setmask {
3225 my $self = shift;
3226 my %opts = @_;
35f40526
TC
3227 if (!defined($self->{IMG})) {
3228 $self->{ERRSTR} = 'image is empty';
3229 return undef;
3230 }
3231 unless (defined $opts{mask}) {
3232 $self->_set_error("mask parameter required");
3233 return;
3234 }
02d1d628 3235 i_img_setmask( $self->{IMG} , $opts{mask} );
35f40526
TC
3236
3237 1;
02d1d628
AMH
3238}
3239
3240# Get number of colors in an image
3241
3242sub getcolorcount {
3243 my $self=shift;
9d540150 3244 my %opts=('maxcolors'=>2**30,@_);
02d1d628
AMH
3245 if (!defined($self->{IMG})) { $self->{ERRSTR}='image is empty'; return undef; }
3246 my $rc=i_count_colors($self->{IMG},$opts{'maxcolors'});
3247 return ($rc==-1? undef : $rc);
3248}
3249
3250# draw string to an image
3251
3252sub string {
3253 my $self = shift;
3254 unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
3255
3256 my %input=('x'=>0, 'y'=>0, @_);
3257 $input{string}||=$input{text};
3258
e922ae66 3259 unless(defined $input{string}) {
02d1d628
AMH
3260 $self->{ERRSTR}="missing required parameter 'string'";
3261 return;
3262 }
3263
3264 unless($input{font}) {
3265 $self->{ERRSTR}="missing required parameter 'font'";
3266 return;
3267 }
3268
faa9b3e7 3269 unless ($input{font}->draw(image=>$self, %input)) {
faa9b3e7
TC
3270 return;
3271 }
02d1d628
AMH
3272
3273 return $self;
3274}
3275
a7ccc5e2
TC
3276sub align_string {
3277 my $self = shift;
e922ae66
TC
3278
3279 my $img;
3280 if (ref $self) {
3281 unless ($self->{IMG}) {
3282 $self->{ERRSTR}='empty input image';
3283 return;
3284 }
c9cb3397 3285 $img = $self;
e922ae66
TC
3286 }
3287 else {
3288 $img = undef;
3289 }
a7ccc5e2
TC
3290
3291 my %input=('x'=>0, 'y'=>0, @_);
3292 $input{string}||=$input{text};
3293
3294 unless(exists $input{string}) {
e922ae66 3295 $self->_set_error("missing required parameter 'string'");
a7ccc5e2
TC
3296 return;
3297 }
3298
3299 unless($input{font}) {
e922ae66 3300 $self->_set_error("missing required parameter 'font'");
a7ccc5e2
TC
3301 return;
3302 }
3303
3304 my @result;
e922ae66 3305 unless (@result = $input{font}->align(image=>$img, %input)) {
a7ccc5e2
TC
3306 return;
3307 }
3308
3309 return wantarray ? @result : $result[0];
3310}
3311
77157728
TC
3312my @file_limit_names = qw/width height bytes/;
3313
3314sub set_file_limits {
3315 shift;
3316
3317 my %opts = @_;
3318 my %values;
3319
3320 if ($opts{reset}) {
3321 @values{@file_limit_names} = (0) x @file_limit_names;
3322 }
3323 else {
3324 @values{@file_limit_names} = i_get_image_file_limits();
3325 }
3326
3327 for my $key (keys %values) {
3328 defined $opts{$key} and $values{$key} = $opts{$key};
3329 }
3330
3331 i_set_image_file_limits($values{width}, $values{height}, $values{bytes});
3332}
3333
3334sub get_file_limits {
3335 i_get_image_file_limits();
3336}
3337
02d1d628
AMH
3338# Shortcuts that can be exported
3339
3340sub newcolor { Imager::Color->new(@_); }
3341sub newfont { Imager::Font->new(@_); }
3342
3343*NC=*newcolour=*newcolor;
3344*NF=*newfont;
3345
3346*open=\&read;
3347*circle=\&arc;
3348
3349
3350#### Utility routines
3351
faa9b3e7
TC
3352sub errstr {
3353 ref $_[0] ? $_[0]->{ERRSTR} : $ERRSTR
3354}
02d1d628 3355
10461f9a
TC
3356sub _set_error {
3357 my ($self, $msg) = @_;
3358
3359 if (ref $self) {
3360 $self->{ERRSTR} = $msg;
3361 }
3362 else {
3363 $ERRSTR = $msg;
3364 }
dff75dee 3365 return;
10461f9a
TC
3366}
3367
02d1d628
AMH
3368# Default guess for the type of an image from extension
3369
3370sub def_guess_type {
3371 my $name=lc(shift);
3372 my $ext;
3373 $ext=($name =~ m/\.([^\.]+)$/)[0];
3374 return 'tiff' if ($ext =~ m/^tiff?$/);
3375 return 'jpeg' if ($ext =~ m/^jpe?g$/);
3376 return 'pnm' if ($ext =~ m/^p[pgb]m$/);
3377 return 'png' if ($ext eq "png");
705fd961 3378 return 'bmp' if ($ext eq "bmp" || $ext eq "dib");
1ec86afa 3379 return 'tga' if ($ext eq "tga");
737a830c 3380 return 'rgb' if ($ext eq "rgb");
02d1d628 3381 return 'gif' if ($ext eq "gif");
10461f9a 3382 return 'raw' if ($ext eq "raw");
2b405c9e 3383 return lc $ext; # best guess
02d1d628
AMH
3384 return ();
3385}
3386
3387# get the minimum of a list
3388
bf1573f9 3389sub _min {
02d1d628
AMH
3390 my $mx=shift;
3391 for(@_) { if ($_<$mx) { $mx=$_; }}
3392 return $mx;
3393}
3394
3395# get the maximum of a list
3396
bf1573f9 3397sub _max {
02d1d628
AMH
3398 my $mx=shift;
3399 for(@_) { if ($_>$mx) { $mx=$_; }}
3400 return $mx;
3401}
3402
3403# string stuff for iptc headers
3404
bf1573f9 3405sub _clean {
02d1d628
AMH
3406 my($str)=$_[0];
3407 $str = substr($str,3);
3408 $str =~ s/[\n\r]//g;
3409 $str =~ s/\s+/ /g;
3410 $str =~ s/^\s//;
3411 $str =~ s/\s$//;
3412 return $str;
3413}
3414
3415# A little hack to parse iptc headers.
3416
3417sub parseiptc {
3418 my $self=shift;
3419 my(@sar,$item,@ar);
3420 my($caption,$photogr,$headln,$credit);
3421
3422 my $str=$self->{IPTCRAW};
3423
24ae6325
TC
3424 defined $str
3425 or return;
02d1d628
AMH
3426
3427 @ar=split(/8BIM/,$str);
3428
3429 my $i=0;
3430 foreach (@ar) {
3431 if (/^\004\004/) {
3432 @sar=split(/\034\002/);
3433 foreach $item (@sar) {
cdd23610 3434 if ($item =~ m/^x/) {
bf1573f9 3435 $caption = _clean($item);
02d1d628
AMH
3436 $i++;
3437 }
cdd23610 3438 if ($item =~ m/^P/) {
bf1573f9 3439 $photogr = _clean($item);
02d1d628
AMH
3440 $i++;
3441 }
cdd23610 3442 if ($item =~ m/^i/) {
bf1573f9 3443 $headln = _clean($item);
02d1d628
AMH
3444 $i++;
3445 }
cdd23610 3446 if ($item =~ m/^n/) {
bf1573f9 3447 $credit = _clean($item);
02d1d628
AMH
3448 $i++;
3449 }
3450 }
3451 }
3452 }
3453 return (caption=>$caption,photogr=>$photogr,headln=>$headln,credit=>$credit);
3454}
3455
92bda632
TC
3456sub Inline {
3457 my ($lang) = @_;
3458
3459 $lang eq 'C'
3460 or die "Only C language supported";
3461
3462 require Imager::ExtUtils;
3463 return Imager::ExtUtils->inline_config;
3464}
02d1d628
AMH
3465
34661;
3467__END__
3468# Below is the stub of documentation for your module. You better edit it!
3469
3470=head1 NAME
3471
3472Imager - Perl extension for Generating 24 bit Images
3473
3474=head1 SYNOPSIS
3475
0e418f1e
AMH
3476 # Thumbnail example
3477
3478 #!/usr/bin/perl -w
3479 use strict;
10461f9a 3480 use Imager;
02d1d628 3481
0e418f1e
AMH
3482 die "Usage: thumbmake.pl filename\n" if !-f $ARGV[0];
3483 my $file = shift;
3484
3485 my $format;
3486
3487 my $img = Imager->new();
e36d02ad
TC
3488 # see Imager::Files for information on the read() method
3489 $img->read(file=>$file) or die $img->errstr();
0e418f1e
AMH
3490
3491 $file =~ s/\.[^.]*$//;
3492
3493 # Create smaller version
cf7a7d18 3494 # documented in Imager::Transformations
0e418f1e
AMH
3495 my $thumb = $img->scale(scalefactor=>.3);
3496
3497 # Autostretch individual channels
3498 $thumb->filter(type=>'autolevels');
3499
3500 # try to save in one of these formats
3501 SAVE:
3502
3503 for $format ( qw( png gif jpg tiff ppm ) ) {
3504 # Check if given format is supported
3505 if ($Imager::formats{$format}) {
3506 $file.="_low.$format";
3507 print "Storing image as: $file\n";
cf7a7d18 3508 # documented in Imager::Files
0e418f1e
AMH
3509 $thumb->write(file=>$file) or
3510 die $thumb->errstr;
3511 last SAVE;
3512 }
3513 }
3514
02d1d628
AMH
3515=head1 DESCRIPTION
3516
0e418f1e
AMH
3517Imager is a module for creating and altering images. It can read and
3518write various image formats, draw primitive shapes like lines,and
3519polygons, blend multiple images together in various ways, scale, crop,
3520render text and more.
02d1d628 3521
5df0fac7
AMH
3522=head2 Overview of documentation
3523
3524=over
3525
cf7a7d18 3526=item *
5df0fac7 3527
d5556805 3528Imager - This document - Synopsis, Example, Table of Contents and
cf7a7d18 3529Overview.
5df0fac7 3530
cf7a7d18 3531=item *
5df0fac7 3532
985bda61
TC
3533L<Imager::Tutorial> - a brief introduction to Imager.
3534
3535=item *
3536
e1d57e9d
TC
3537L<Imager::Cookbook> - how to do various things with Imager.
3538
3539=item *
3540
cf7a7d18
TC
3541L<Imager::ImageTypes> - Basics of constructing image objects with
3542C<new()>: Direct type/virtual images, RGB(A)/paletted images,
35438/16/double bits/channel, color maps, channel masks, image tags, color
6d0ed98a 3544quantization. Also discusses basic image information methods.
5df0fac7 3545
cf7a7d18 3546=item *
5df0fac7 3547
cf7a7d18
TC
3548L<Imager::Files> - IO interaction, reading/writing images, format
3549specific tags.
5df0fac7 3550
cf7a7d18 3551=item *
5df0fac7 3552
cf7a7d18
TC
3553L<Imager::Draw> - Drawing Primitives, lines, boxes, circles, arcs,
3554flood fill.
5df0fac7 3555
cf7a7d18 3556=item *
5df0fac7 3557
cf7a7d18 3558L<Imager::Color> - Color specification.
5df0fac7 3559
cf7a7d18 3560=item *
f5fd108b 3561
cf7a7d18 3562L<Imager::Fill> - Fill pattern specification.
f5fd108b 3563
cf7a7d18 3564=item *
5df0fac7 3565
cf7a7d18
TC
3566L<Imager::Font> - General font rendering, bounding boxes and font
3567metrics.
5df0fac7 3568
cf7a7d18 3569=item *
5df0fac7 3570
cf7a7d18
TC
3571L<Imager::Transformations> - Copying, scaling, cropping, flipping,
3572blending, pasting, convert and map.
5df0fac7 3573
cf7a7d18 3574=item *
5df0fac7 3575
cf7a7d18
TC
3576L<Imager::Engines> - Programmable transformations through
3577C<transform()>, C<transform2()> and C<matrix_transform()>.
5df0fac7 3578
cf7a7d18 3579=item *
5df0fac7 3580
cf7a7d18
TC
3581L<Imager::Filters> - Filters, sharpen, blur, noise, convolve etc. and
3582filter plugins.
5df0fac7 3583
cf7a7d18 3584=item *
5df0fac7 3585
cf7a7d18
TC
3586L<Imager::Expr> - Expressions for evaluation engine used by
3587transform2().
5df0fac7 3588
cf7a7d18 3589=item *
5df0fac7 3590
cf7a7d18 3591L<Imager::Matrix2d> - Helper class for affine transformations.
5df0fac7 3592
cf7a7d18 3593=item *
5df0fac7 3594
cf7a7d18 3595L<Imager::Fountain> - Helper for making gradient profiles.
5df0fac7 3596
92bda632
TC
3597=item *
3598
3599L<Imager::API> - using Imager's C API
3600
3601=item *
3602
3603L<Imager::APIRef> - API function reference
3604
3605=item *
3606
3607L<Imager::Inline> - using Imager's C API from Inline::C
3608
3609=item *
3610
3611L<Imager::ExtUtils> - tools to get access to Imager's C API.
3612
5df0fac7
AMH
3613=back
3614
0e418f1e 3615=head2 Basic Overview
02d1d628 3616
55b287f5
AMH
3617An Image object is created with C<$img = Imager-E<gt>new()>.
3618Examples:
02d1d628 3619
55b287f5 3620 $img=Imager->new(); # create empty image
e36d02ad 3621 $img->read(file=>'lena.png',type=>'png') or # read image from file
55b287f5
AMH
3622 die $img->errstr(); # give an explanation
3623 # if something failed
02d1d628
AMH
3624
3625or if you want to create an empty image:
3626
3627 $img=Imager->new(xsize=>400,ysize=>300,channels=>4);
3628
0e418f1e
AMH
3629This example creates a completely black image of width 400 and height
3630300 and 4 channels.
3631
d5556805 3632=head1 ERROR HANDLING
55b287f5 3633
d5556805
TC
3634In general a method will return false when it fails, if it does use the errstr() method to find out why:
3635
3636=over
3637
3638=item errstr
3639
3640Returns the last error message in that context.
3641
3642If the last error you received was from calling an object method, such
3643as read, call errstr() as an object method to find out why:
3644
3645 my $image = Imager->new;
3646 $image->read(file => 'somefile.gif')
3647 or die $image->errstr;
3648
3649If it was a class method then call errstr() as a class method:
3650
3651 my @imgs = Imager->read_multi(file => 'somefile.gif')
3652 or die Imager->errstr;
3653
3654Note that in some cases object methods are implemented in terms of
3655class methods so a failing object method may set both.
3656
3657=back
55b287f5 3658
cf7a7d18
TC
3659The C<Imager-E<gt>new> method is described in detail in
3660L<Imager::ImageTypes>.
4b4f5319 3661
13fc481e
TC
3662=head1 METHOD INDEX
3663
3664Where to find information on methods for Imager class objects.
3665
4b3408a5 3666addcolors() - L<Imager::ImageTypes/addcolors>
13fc481e 3667
4b3408a5 3668addtag() - L<Imager::ImageTypes/addtag> - add image tags
13fc481e 3669
a7ccc5e2
TC
3670align_string() - L<Imager::Draw/align_string>
3671
7fca1e9e
TC
3672arc() - L<Imager::Draw/arc>
3673
4b3408a5 3674bits() - L<Imager::ImageTypes/bits> - number of bits per sample for the
13fc481e
TC
3675image
3676
3677box() - L<Imager::Draw/box>
3678
3679circle() - L<Imager::Draw/circle>
3680
feac660c
TC
3681colorcount() - L<Imager::Draw/colorcount>
3682
13fc481e
TC
3683convert() - L<Imager::Transformations/"Color transformations"> -
3684transform the color space
3685
3686copy() - L<Imager::Transformations/copy>
3687
3688crop() - L<Imager::Transformations/crop> - extract part of an image
3689
d5556805
TC
3690def_guess_type() - L<Imager::Files/def_guess_type>
3691
4b3408a5 3692deltag() - L<Imager::ImageTypes/deltag> - delete image tags
13fc481e
TC
3693
3694difference() - L<Imager::Filters/"Image Difference">
3695
e922ae66 3696errstr() - L<"Basic Overview">
99958502 3697
13fc481e
TC
3698filter() - L<Imager::Filters>
3699
4b3408a5 3700findcolor() - L<Imager::ImageTypes/findcolor> - search the image palette, if it
13fc481e
TC
3701has one
3702
3703flip() - L<Imager::Transformations/flip>
3704
3705flood_fill() - L<Imager::Draw/flood_fill>
3706
4b3408a5 3707getchannels() - L<Imager::ImageTypes/getchannels>
13fc481e 3708
4b3408a5 3709getcolorcount() - L<Imager::ImageTypes/getcolorcount>
13fc481e 3710
4b3408a5 3711getcolors() - L<Imager::ImageTypes/getcolors> - get colors from the image
13fc481e
TC
3712palette, if it has one
3713
77157728
TC
3714get_file_limits() - L<Imager::Files/"Limiting the sizes of images you read">
3715
4b3408a5 3716getheight() - L<Imager::ImageTypes/getwidth>
13fc481e 3717
7fca1e9e
TC
3718getmask() - L<Imager::ImageTypes/getmask>
3719
a7ccc5e2 3720getpixel() - L<Imager::Draw/getpixel>
13fc481e 3721
ca4d914e
TC
3722getsamples() - L<Imager::Draw/getsamples>
3723
3724getscanline() - L<Imager::Draw/getscanline>
3725
4b3408a5 3726getwidth() - L<Imager::ImageTypes/getwidth>
13fc481e 3727
4b3408a5 3728img_set() - L<Imager::ImageTypes/img_set>
13fc481e 3729
7fca1e9e
TC
3730init() - L<Imager::ImageTypes/init>
3731
13fc481e
TC
3732line() - L<Imager::Draw/line>
3733
7fca1e9e
TC
3734load_plugin() - L<Imager::Filters/load_plugin>
3735
13fc481e
TC
3736map() - L<Imager::Transformations/"Color Mappings"> - remap color
3737channel values
3738
4b3408a5 3739masked() - L<Imager::ImageTypes/masked> - make a masked image
13fc481e 3740
58a9ba58 3741matrix_transform() - L<Imager::Engines/matrix_transform>
13fc481e 3742
4b3408a5 3743maxcolors() - L<Imager::ImageTypes/maxcolors>
feac660c 3744
7fca1e9e
TC
3745NC() - L<Imager::Handy/NC>
3746
4b3408a5 3747new() - L<Imager::ImageTypes/new>
13fc481e 3748
7fca1e9e
TC
3749newcolor() - L<Imager::Handy/newcolor>
3750
3751newcolour() - L<Imager::Handy/newcolour>
3752
3753newfont() - L<Imager::Handy/newfont>
3754
3755NF() - L<Imager::Handy/NF>
3756
e36d02ad
TC
3757open() - L<Imager::Files> - an alias for read()
3758
f0fe9c14
TC
3759parseiptc() - L<Imager::Files/parseiptc> - parse IPTC data from a JPEG
3760image
3761
13fc481e
TC
3762paste() - L<Imager::Transformations/paste> - draw an image onto an image
3763
3764polygon() - L<Imager::Draw/polygon>
3765
3766polyline() - L<Imager::Draw/polyline>
3767
e36d02ad 3768read() - L<Imager::Files> - read a single image from an image file
13fc481e 3769
e36d02ad
TC
3770read_multi() - L<Imager::Files> - read multiple images from an image
3771file
13fc481e 3772
7fca1e9e
TC
3773register_filter() - L<Imager::Filters/register_filter>
3774
3775register_reader() - L<Imager::Filters/register_reader>
3776
3777register_writer() - L<Imager::Filters/register_writer>
3778
13fc481e
TC
3779rotate() - L<Imager::Transformations/rotate>
3780
3781rubthrough() - L<Imager::Transformations/rubthrough> - draw an image onto an
3782image and use the alpha channel
3783
3784scale() - L<Imager::Transformations/scale>
1adb5500
TC
3785
3786scaleX() - L<Imager::Transformations/scaleX>
3787
3788scaleY() - L<Imager::Transformations/scaleY>
13fc481e 3789
4b3408a5
TC
3790setcolors() - L<Imager::ImageTypes/setcolors> - set palette colors in
3791a paletted image
13fc481e 3792
7fca1e9e
TC
3793set_file_limits() - L<Imager::Files/"Limiting the sizes of images you read">
3794
3795setmask() - L<Imager::ImageTypes/setmask>
3796
a7ccc5e2 3797setpixel() - L<Imager::Draw/setpixel>
13fc481e 3798
58a9ba58
TC
3799setscanline() - L<Imager::Draw/setscanline>
3800
3801settag() - L<Imager::ImageTypes/settag>
3802
a7ccc5e2 3803string() - L<Imager::Draw/string> - draw text on an image
13fc481e 3804
4b3408a5 3805tags() - L<Imager::ImageTypes/tags> - fetch image tags
13fc481e 3806
4b3408a5 3807to_paletted() - L<Imager::ImageTypes/to_paletted>
13fc481e 3808
4b3408a5 3809to_rgb8() - L<Imager::ImageTypes/to_rgb8>
13fc481e
TC
3810
3811transform() - L<Imager::Engines/"transform">
3812
3813transform2() - L<Imager::Engines/"transform2">
3814
4b3408a5 3815type() - L<Imager::ImageTypes/type> - type of image (direct vs paletted)
13fc481e 3816
7fca1e9e
TC
3817unload_plugin() - L<Imager::Filters/unload_plugin>
3818
4b3408a5 3819virtual() - L<Imager::ImageTypes/virtual> - whether the image has it's own
13fc481e
TC
3820data
3821
e36d02ad 3822write() - L<Imager::Files> - write an image to a file
13fc481e 3823
e36d02ad
TC
3824write_multi() - L<Imager::Files> - write multiple image to an image
3825file.
13fc481e 3826
dc67bc2f
TC
3827=head1 CONCEPT INDEX
3828
3829animated GIF - L<Imager::File/"Writing an animated GIF">
3830
3831aspect ratio - L<Imager::ImageTypes/i_xres>,
3832L<Imager::ImageTypes/i_yres>, L<Imager::ImageTypes/i_aspect_only>
3833
cad360aa
TC
3834blend - alpha blending one image onto another
3835L<Imager::Transformations/rubthrough>
3836
dc67bc2f
TC
3837blur - L<Imager::Filters/guassian>, L<Imager::Filters/conv>
3838
3839boxes, drawing - L<Imager::Draw/box>
3840
a8652edf
TC
3841changes between image - L<Imager::Filter/"Image Difference">
3842
dc67bc2f
TC
3843color - L<Imager::Color>
3844
3845color names - L<Imager::Color>, L<Imager::Color::Table>
3846
3847combine modes - L<Imager::Fill/combine>
3848
a8652edf
TC
3849compare images - L<Imager::Filter/"Image Difference">
3850
a4e6485d
TC
3851contrast - L<Imager::Filter/contrast>, L<Imager::Filter/autolevels>
3852
3853convolution - L<Imager::Filter/conv>
3854
dc67bc2f
TC
3855cropping - L<Imager::Transformations/crop>
3856
a8652edf
TC
3857C<diff> images - L<Imager::Filter/"Image Difference">
3858
c2d1dd13
TC
3859dpi - L<Imager::ImageTypes/i_xres>,
3860L<Imager::Cookbook/"Image spatial resolution">
dc67bc2f
TC
3861
3862drawing boxes - L<Imager::Draw/box>
3863
3864drawing lines - L<Imager::Draw/line>
3865
c2d1dd13 3866drawing text - L<Imager::Draw/string>, L<Imager::Draw/align_string>
dc67bc2f 3867
e922ae66 3868error message - L<"Basic Overview">
dc67bc2f
TC
3869
3870files, font - L<Imager::Font>
3871
3872files, image - L<Imager::Files>
3873
3874filling, types of fill - L<Imager::Fill>
3875
3876filling, boxes - L<Imager::Draw/box>
3877
3878filling, flood fill - L<Imager::Draw/flood_fill>
3879
3880flood fill - L<Imager::Draw/flood_fill>
3881
3882fonts - L<Imager::Font>
3883
c2d1dd13
TC
3884fonts, drawing with - L<Imager::Draw/string>,
3885L<Imager::Draw/align_string>, L<Imager::Font::Wrap>
dc67bc2f
TC
3886
3887fonts, metrics - L<Imager::Font/bounding_box>, L<Imager::Font::BBox>
3888
3889fonts, multiple master - L<Imager::Font/"MULTIPLE MASTER FONTS">
3890
3891fountain fill - L<Imager::Fill/"Fountain fills">,
3892L<Imager::Filters/fountain>, L<Imager::Fountain>,
3893L<Imager::Filters/gradgen>
3894
a4e6485d
TC
3895GIF files - L<Imager::Files/"GIF">
3896
3897GIF files, animated - L<Imager::File/"Writing an animated GIF">
3898
dc67bc2f
TC
3899gradient fill - L<Imager::Fill/"Fountain fills">,
3900L<Imager::Filters/fountain>, L<Imager::Fountain>,
3901L<Imager::Filters/gradgen>
3902
a4e6485d
TC
3903guassian blur - L<Imager::Filter/guassian>
3904
dc67bc2f
TC
3905hatch fills - L<Imager::Fill/"Hatched fills">
3906
a4e6485d
TC
3907invert image - L<Imager::Filter/hardinvert>
3908
dc67bc2f
TC
3909JPEG - L<Imager::Files/"JPEG">
3910
77157728
TC
3911limiting image sizes - L<Imager::Files/"Limiting the sizes of images you read">
3912
dc67bc2f
TC
3913lines, drawing - L<Imager::Draw/line>
3914
a4e6485d
TC
3915matrix - L<Imager::Matrix2d>,
3916L<Imager::Transformations/"Matrix Transformations">,
3917L<Imager::Font/transform>
3918
dc67bc2f
TC
3919metadata, image - L<Imager::ImageTypes/"Tags">
3920
a4e6485d
TC
3921mosaic - L<Imager::Filter/mosaic>
3922
3923noise, filter - L<Imager::Filter/noise>
3924
3925noise, rendered - L<Imager::Filter/turbnoise>,
3926L<Imager::Filter/radnoise>
3927
cad360aa
TC
3928paste - L<Imager::Transformations/paste>,
3929L<Imager::Transformations/rubthrough>
3930
4b3408a5
TC
3931pseudo-color image - L<Imager::ImageTypes/to_paletted>,
3932L<Imager::ImageTypes/new>
3933
a4e6485d
TC
3934posterize - L<Imager::Filter/postlevels>
3935
3936png files - L<Imager::Files>, L<Imager::Files/"PNG">
dc67bc2f 3937
f75c1aeb 3938pnm - L<Imager::Files/"PNM (Portable aNy Map)">
dc67bc2f
TC
3939
3940rectangles, drawing - L<Imager::Draw/box>
3941
3942resizing an image - L<Imager::Transformations/scale>,
3943L<Imager::Transformations/crop>
3944
3945saving an image - L<Imager::Files>
3946
3947scaling - L<Imager::Transformations/scale>
3948
3949sharpen - L<Imager::Filters/unsharpmask>, L<Imager::Filters/conv>
3950
3951size, image - L<Imager::ImageTypes/getwidth>,
3952L<Imager::ImageTypes/getheight>
3953
3954size, text - L<Imager::Font/bounding_box>
3955
4b3408a5
TC
3956tags, image metadata - L<Imager::ImageTypes/"Tags">
3957
a7ccc5e2 3958text, drawing - L<Imager::Draw/string>, L<Imager::Draw/align_string>,
dc67bc2f
TC
3959L<Imager::Font::Wrap>
3960
3961text, wrapping text in an area - L<Imager::Font::Wrap>
3962
3963text, measuring - L<Imager::Font/bounding_box>, L<Imager::Font::BBox>
3964
a4e6485d
TC
3965tiles, color - L<Imager::Filter/mosaic>
3966
3967unsharp mask - L<Imager::Filter/unsharpmask>
3968
3969watermark - L<Imager::Filter/watermark>
3970
a7ccc5e2 3971writing an image to a file - L<Imager::Files>
dc67bc2f 3972
f64132d2 3973=head1 SUPPORT
0e418f1e 3974
b6228d02 3975The best place to get help with Imager is the mailing list.
02d1d628 3976
f64132d2
TC
3977To subscribe send a message with C<subscribe> in the body to:
3978
3979 imager-devel+request@molar.is
3980
3981or use the form at:
3982
e922ae66
TC
3983=over
3984
3985L<http://www.molar.is/en/lists/imager-devel/>
3986
3987=back
f64132d2
TC
3988
3989where you can also find the mailing list archive.
10461f9a 3990
f6acebd0 3991You can report bugs by pointing your browser at:
8f22b8d8 3992
e922ae66
TC
3993=over
3994
3995L<https://rt.cpan.org/NoAuth/ReportBug.html?Queue=Imager>
3996
3997=back
8f22b8d8
TC
3998
3999Please remember to include the versions of Imager, perl, supporting
4000libraries, and any relevant code. If you have specific images that
4001cause the problems, please include those too.
3ed96cd3 4002
02d1d628
AMH
4003=head1 BUGS
4004
0e418f1e 4005Bugs are listed individually for relevant pod pages.
02d1d628
AMH
4006
4007=head1 AUTHOR
4008
4b3408a5
TC
4009Arnar M. Hrafnkelsson and Tony Cook (tony@imager.perl.org) among
4010others. See the README for a complete list.
02d1d628 4011
9495ee93 4012=head1 SEE ALSO
02d1d628 4013
e922ae66
TC
4014L<perl>(1), L<Imager::ImageTypes>(3), L<Imager::Files>(3),
4015L<Imager::Draw>(3), L<Imager::Color>(3), L<Imager::Fill>(3),
4016L<Imager::Font>(3), L<Imager::Transformations>(3),
4017L<Imager::Engines>(3), L<Imager::Filters>(3), L<Imager::Expr>(3),
4018L<Imager::Matrix2d>(3), L<Imager::Fountain>(3)
4019
4020L<http://imager.perl.org/>
009db950 4021
e922ae66 4022L<Affix::Infix2Postfix>(3), L<Parse::RecDescent>(3)
02d1d628 4023
35f40526
TC
4024Other perl imaging modules include:
4025
e922ae66 4026L<GD>(3), L<Image::Magick>(3), L<Graphics::Magick>(3).
35f40526 4027
02d1d628 4028=cut