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