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