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