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