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