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