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