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