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