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