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