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