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