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