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