]> git.imager.perl.org - imager.git/blame - Imager.pm
projects / imager.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
- the straight edges of filled arcs weren't being drawn correctly,
[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
02d1d628
AMH		 2087sub arc {
2088 my $self=shift;
2089 unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2090 my $dflcl=i_color_new(255,255,255,255);
2091 my %opts=(color=>$dflcl,
2092 'r'=>min($self->getwidth(),$self->getheight())/3,
2093 'x'=>$self->getwidth()/2,
2094 'y'=>$self->getheight()/2,
2095 'd1'=>0, 'd2'=>361, @_);
a8652edf
TC		 2096 if ($opts{aa}) {
2097 if ($opts{fill}) {
2098 unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
2099 # assume it's a hash ref
2100 require 'Imager/Fill.pm';
2101 unless ($opts{fill} = Imager::Fill->new(%{$opts{fill}})) {
2102 $self->{ERRSTR} = $Imager::ERRSTR;
2103 return;
2104 }
2105 }
2106 i_arc_aa_cfill($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},$opts{'d1'},
2107 $opts{'d2'}, $opts{fill}{fill});
2108 }
2109 else {
2110 my $color = _color($opts{'color'});
2111 unless ($color) {
2112 $self->{ERRSTR} = $Imager::ERRSTR;
2113 return;
2114 }
2115 if ($opts{d1} == 0 && $opts{d2} == 361 && $opts{aa}) {
2116 i_circle_aa($self->{IMG}, $opts{'x'}, $opts{'y'}, $opts{'r'},
2117 $color);
2118 }
2119 else {
2120 i_arc_aa($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},
2121 $opts{'d1'}, $opts{'d2'}, $color);
569795e8 2122 }
f1ac5027 2123 }
f1ac5027
TC		 2124 }
2125 else {
a8652edf
TC		 2126 if ($opts{fill}) {
2127 unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
2128 # assume it's a hash ref
2129 require 'Imager/Fill.pm';
2130 unless ($opts{fill} = Imager::Fill->new(%{$opts{fill}})) {
2131 $self->{ERRSTR} = $Imager::ERRSTR;
2132 return;
2133 }
2134 }
2135 i_arc_cfill($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},$opts{'d1'},
2136 $opts{'d2'}, $opts{fill}{fill});
0d321238
TC		 2137 }
2138 else {
a8652edf
TC		 2139 my $color = _color($opts{'color'});
2140 unless ($color) {
2141 $self->{ERRSTR} = $Imager::ERRSTR;
2142 return;
2143 }
2144 if ($opts{d1} == 0 && $opts{d2} == 361 && $opts{aa}) {
2145 i_circle_aa($self->{IMG}, $opts{'x'}, $opts{'y'}, $opts{'r'},
2146 $color);
3a9a4241
TC		 2147 }
2148 else {
a8652edf
TC		 2149 i_arc($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},
2150 $opts{'d1'}, $opts{'d2'}, $color);
3a9a4241 2151 }
0d321238 2152 }
f1ac5027
TC		 2153 }
2154
02d1d628
AMH		 2155 return $self;
2156}
2157
aa833c97
AMH		 2158# Draws a line from one point to the other
2159# the endpoint is set if the endp parameter is set which it is by default.
2160# to turn of the endpoint being set use endp=>0 when calling line.
02d1d628
AMH		 2161
2162sub line {
2163 my $self=shift;
2164 my $dflcl=i_color_new(0,0,0,0);
aa833c97
AMH		 2165 my %opts=(color=>$dflcl,
2166 endp => 1,
2167 @_);
02d1d628
AMH		 2168 unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2169
2170 unless (exists $opts{x1} and exists $opts{y1}) { $self->{ERRSTR}='missing begining coord'; return undef; }
2171 unless (exists $opts{x2} and exists $opts{y2}) { $self->{ERRSTR}='missing ending coord'; return undef; }
2172
3a9a4241 2173 my $color = _color($opts{'color'});
aa833c97
AMH		 2174 unless ($color) {
2175 $self->{ERRSTR} = $Imager::ERRSTR;
2176 return;
3a9a4241 2177 }
aa833c97 2178
3a9a4241 2179 $opts{antialias} = $opts{aa} if defined $opts{aa};
02d1d628 2180 if ($opts{antialias}) {
aa833c97 2181 i_line_aa($self->{IMG},$opts{x1}, $opts{y1}, $opts{x2}, $opts{y2},
b437ce0a 2182 $color, $opts{endp});
02d1d628 2183 } else {
aa833c97
AMH		 2184 i_line($self->{IMG},$opts{x1}, $opts{y1}, $opts{x2}, $opts{y2},
2185 $color, $opts{endp});
02d1d628
AMH		 2186 }
2187 return $self;
2188}
2189
2190# Draws a line between an ordered set of points - It more or less just transforms this
2191# into a list of lines.
2192
2193sub polyline {
2194 my $self=shift;
2195 my ($pt,$ls,@points);
2196 my $dflcl=i_color_new(0,0,0,0);
2197 my %opts=(color=>$dflcl,@_);
2198
2199 unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2200
2201 if (exists($opts{points})) { @points=@{$opts{points}}; }
2202 if (!exists($opts{points}) and exists($opts{'x'}) and exists($opts{'y'}) ) {
2203 @points=map { [ $opts{'x'}->[$_],$opts{'y'}->[$_] ] } (0..(scalar @{$opts{'x'}}-1));
2204 }
2205
2206# print Dumper(\@points);
2207
3a9a4241
TC		 2208 my $color = _color($opts{'color'});
2209 unless ($color) {
2210 $self->{ERRSTR} = $Imager::ERRSTR;
2211 return;
2212 }
2213 $opts{antialias} = $opts{aa} if defined $opts{aa};
02d1d628
AMH		 2214 if ($opts{antialias}) {
2215 for $pt(@points) {
3a9a4241 2216 if (defined($ls)) {
b437ce0a 2217 i_line_aa($self->{IMG},$ls->[0],$ls->[1],$pt->[0],$pt->[1],$color, 1);
3a9a4241 2218 }
02d1d628
AMH		 2219 $ls=$pt;
2220 }
2221 } else {
2222 for $pt(@points) {
3a9a4241 2223 if (defined($ls)) {
aa833c97 2224 i_line($self->{IMG},$ls->[0],$ls->[1],$pt->[0],$pt->[1],$color,1);
3a9a4241 2225 }
02d1d628
AMH		 2226 $ls=$pt;
2227 }
2228 }
2229 return $self;
2230}
2231
d0e7bfee
AMH		 2232sub polygon {
2233 my $self = shift;
2234 my ($pt,$ls,@points);
2235 my $dflcl = i_color_new(0,0,0,0);
2236 my %opts = (color=>$dflcl, @_);
2237
2238 unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2239
2240 if (exists($opts{points})) {
2241 $opts{'x'} = [ map { $_->[0] } @{$opts{points}} ];
2242 $opts{'y'} = [ map { $_->[1] } @{$opts{points}} ];
2243 }
2244
2245 if (!exists $opts{'x'} or !exists $opts{'y'}) {
2246 $self->{ERRSTR} = 'no points array, or x and y arrays.'; return undef;
2247 }
2248
43c5dacb
TC		 2249 if ($opts{'fill'}) {
2250 unless (UNIVERSAL::isa($opts{'fill'}, 'Imager::Fill')) {
2251 # assume it's a hash ref
2252 require 'Imager/Fill.pm';
2253 unless ($opts{'fill'} = Imager::Fill->new(%{$opts{'fill'}})) {
2254 $self->{ERRSTR} = $Imager::ERRSTR;
2255 return undef;
2256 }
2257 }
2258 i_poly_aa_cfill($self->{IMG}, $opts{'x'}, $opts{'y'},
2259 $opts{'fill'}{'fill'});
2260 }
2261 else {
3a9a4241
TC		 2262 my $color = _color($opts{'color'});
2263 unless ($color) {
2264 $self->{ERRSTR} = $Imager::ERRSTR;
2265 return;
2266 }
2267 i_poly_aa($self->{IMG}, $opts{'x'}, $opts{'y'}, $color);
43c5dacb
TC		 2268 }
2269
d0e7bfee
AMH		 2270 return $self;
2271}
2272
2273
2274# this the multipoint bezier curve
02d1d628
AMH		 2275# this is here more for testing that actual usage since
2276# this is not a good algorithm. Usually the curve would be
2277# broken into smaller segments and each done individually.
2278
2279sub polybezier {
2280 my $self=shift;
2281 my ($pt,$ls,@points);
2282 my $dflcl=i_color_new(0,0,0,0);
2283 my %opts=(color=>$dflcl,@_);
2284
2285 unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2286
2287 if (exists $opts{points}) {
2288 $opts{'x'}=map { $_->[0]; } @{$opts{'points'}};
2289 $opts{'y'}=map { $_->[1]; } @{$opts{'points'}};
2290 }
2291
2292 unless ( @{$opts{'x'}} and @{$opts{'x'}} == @{$opts{'y'}} ) {
2293 $self->{ERRSTR}='Missing or invalid points.';
2294 return;
2295 }
2296
3a9a4241
TC		 2297 my $color = _color($opts{'color'});
2298 unless ($color) {
2299 $self->{ERRSTR} = $Imager::ERRSTR;
2300 return;
2301 }
2302 i_bezier_multi($self->{IMG},$opts{'x'},$opts{'y'},$color);
02d1d628
AMH		 2303 return $self;
2304}
2305
cc6483e0
TC		 2306sub flood_fill {
2307 my $self = shift;
2308 my %opts = ( color=>Imager::Color->new(255, 255, 255), @_ );
aa833c97
AMH		 2309 my $rc;
2310
9d540150 2311 unless (exists $opts{'x'} && exists $opts{'y'}) {
cc6483e0
TC		 2312 $self->{ERRSTR} = "missing seed x and y parameters";
2313 return undef;
2314 }
07d70837 2315
cc6483e0
TC		 2316 if ($opts{fill}) {
2317 unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
2318 # assume it's a hash ref
2319 require 'Imager/Fill.pm';
569795e8
TC		 2320 unless ($opts{fill} = Imager::Fill->new(%{$opts{fill}})) {
2321 $self->{ERRSTR} = $Imager::ERRSTR;
2322 return;
2323 }
cc6483e0 2324 }
a321d497 2325 $rc = i_flood_cfill($self->{IMG}, $opts{'x'}, $opts{'y'}, $opts{fill}{fill});
cc6483e0
TC		 2326 }
2327 else {
3a9a4241 2328 my $color = _color($opts{'color'});
aa833c97
AMH		 2329 unless ($color) {
2330 $self->{ERRSTR} = $Imager::ERRSTR;
2331 return;
3a9a4241 2332 }
a321d497 2333 $rc = i_flood_fill($self->{IMG}, $opts{'x'}, $opts{'y'}, $color);
cc6483e0 2334 }
aa833c97 2335 if ($rc) { $self; } else { $self->{ERRSTR} = $self->_error_as_msg(); return (); }
cc6483e0
TC		 2336}
2337
591b5954
TC		 2338sub setpixel {
2339 my $self = shift;
2340
2341 my %opts = ( color=>$self->{fg} || NC(255, 255, 255), @_);
2342
2343 unless (exists $opts{'x'} && exists $opts{'y'}) {
2344 $self->{ERRSTR} = 'missing x and y parameters';
2345 return undef;
2346 }
2347
2348 my $x = $opts{'x'};
2349 my $y = $opts{'y'};
2350 my $color = _color($opts{color})
2351 or return undef;
2352 if (ref $x && ref $y) {
2353 unless (@$x == @$y) {
9650c424 2354 $self->{ERRSTR} = 'length of x and y mismatch';
591b5954
TC		 2355 return undef;
2356 }
2357 if ($color->isa('Imager::Color')) {
2358 for my $i (0..$#{$opts{'x'}}) {
2359 i_ppix($self->{IMG}, $x->[$i], $y->[$i], $color);
2360 }
2361 }
2362 else {
2363 for my $i (0..$#{$opts{'x'}}) {
2364 i_ppixf($self->{IMG}, $x->[$i], $y->[$i], $color);
2365 }
2366 }
2367 }
2368 else {
2369 if ($color->isa('Imager::Color')) {
2370 i_ppix($self->{IMG}, $x, $y, $color);
2371 }
2372 else {
2373 i_ppixf($self->{IMG}, $x, $y, $color);
2374 }
2375 }
2376
2377 $self;
2378}
2379
2380sub getpixel {
2381 my $self = shift;
2382
a9fa203f 2383 my %opts = ( "type"=>'8bit', @_);
591b5954
TC		 2384
2385 unless (exists $opts{'x'} && exists $opts{'y'}) {
2386 $self->{ERRSTR} = 'missing x and y parameters';
2387 return undef;
2388 }
2389
2390 my $x = $opts{'x'};
2391 my $y = $opts{'y'};
2392 if (ref $x && ref $y) {
2393 unless (@$x == @$y) {
2394 $self->{ERRSTR} = 'length of x and y mismatch';
2395 return undef;
2396 }
2397 my @result;
a9fa203f 2398 if ($opts{"type"} eq '8bit') {
591b5954
TC		 2399 for my $i (0..$#{$opts{'x'}}) {
2400 push(@result, i_get_pixel($self->{IMG}, $x->[$i], $y->[$i]));
2401 }
2402 }
2403 else {
2404 for my $i (0..$#{$opts{'x'}}) {
2405 push(@result, i_gpixf($self->{IMG}, $x->[$i], $y->[$i]));
2406 }
2407 }
2408 return wantarray ? @result : \@result;
2409 }
2410 else {
a9fa203f 2411 if ($opts{"type"} eq '8bit') {
591b5954
TC		 2412 return i_get_pixel($self->{IMG}, $x, $y);
2413 }
2414 else {
2415 return i_gpixf($self->{IMG}, $x, $y);
2416 }
2417 }
2418
2419 $self;
2420}
2421
ca4d914e
TC		 2422sub getscanline {
2423 my $self = shift;
2424 my %opts = ( type => '8bit', x=>0, @_);
2425
2426 defined $opts{width} or $opts{width} = $self->getwidth - $opts{x};
2427
2428 unless (defined $opts{'y'}) {
2429 $self->_set_error("missing y parameter");
2430 return;
2431 }
2432
2433 if ($opts{type} eq '8bit') {
2434 return i_glin($self->{IMG}, $opts{x}, $opts{x}+$opts{width},
2435 $opts{y});
2436 }
2437 elsif ($opts{type} eq 'float') {
2438 return i_glinf($self->{IMG}, $opts{x}, $opts{x}+$opts{width},
2439 $opts{y});
2440 }
2441 else {
2442 $self->_set_error("invalid type parameter - must be '8bit' or 'float'");
2443 return;
2444 }
2445}
2446
2447sub setscanline {
2448 my $self = shift;
2449 my %opts = ( x=>0, @_);
2450
2451 unless (defined $opts{'y'}) {
2452 $self->_set_error("missing y parameter");
2453 return;
2454 }
2455
2456 if (!$opts{type}) {
2457 if (ref $opts{pixels} && @{$opts{pixels}}) {
2458 # try to guess the type
2459 if ($opts{pixels}[0]->isa('Imager::Color')) {
2460 $opts{type} = '8bit';
2461 }
2462 elsif ($opts{pixels}[0]->isa('Imager::Color::Float')) {
2463 $opts{type} = 'float';
2464 }
2465 else {
2466 $self->_set_error("missing type parameter and could not guess from pixels");
2467 return;
2468 }
2469 }
2470 else {
2471 # default
2472 $opts{type} = '8bit';
2473 }
2474 }
2475
2476 if ($opts{type} eq '8bit') {
2477 if (ref $opts{pixels}) {
2478 return i_plin($self->{IMG}, $opts{x}, $opts{'y'}, @{$opts{pixels}});
2479 }
2480 else {
2481 return i_plin($self->{IMG}, $opts{x}, $opts{'y'}, $opts{pixels});
2482 }
2483 }
2484 elsif ($opts{type} eq 'float') {
2485 if (ref $opts{pixels}) {
2486 return i_plinf($self->{IMG}, $opts{x}, $opts{'y'}, @{$opts{pixels}});
2487 }
2488 else {
2489 return i_plinf($self->{IMG}, $opts{x}, $opts{'y'}, $opts{pixels});
2490 }
2491 }
2492 else {
2493 $self->_set_error("invalid type parameter - must be '8bit' or 'float'");
2494 return;
2495 }
2496}
2497
2498sub getsamples {
2499 my $self = shift;
2500 my %opts = ( type => '8bit', x=>0, @_);
2501
2502 defined $opts{width} or $opts{width} = $self->getwidth - $opts{x};
2503
2504 unless (defined $opts{'y'}) {
2505 $self->_set_error("missing y parameter");
2506 return;
2507 }
2508
2509 unless ($opts{channels}) {
2510 $opts{channels} = [ 0 .. $self->getchannels()-1 ];
2511 }
2512
2513 if ($opts{type} eq '8bit') {
2514 return i_gsamp($self->{IMG}, $opts{x}, $opts{x}+$opts{width},
2515 $opts{y}, @{$opts{channels}});
2516 }
2517 elsif ($opts{type} eq 'float') {
2518 return i_gsampf($self->{IMG}, $opts{x}, $opts{x}+$opts{width},
2519 $opts{y}, @{$opts{channels}});
2520 }
2521 else {
2522 $self->_set_error("invalid type parameter - must be '8bit' or 'float'");
2523 return;
2524 }
2525}
2526
f5991c03
TC		 2527# make an identity matrix of the given size
2528sub _identity {
2529 my ($size) = @_;
2530
2531 my $matrix = [ map { [ (0) x $size ] } 1..$size ];
2532 for my $c (0 .. ($size-1)) {
2533 $matrix->[$c][$c] = 1;
2534 }
2535 return $matrix;
2536}
2537
2538# general function to convert an image
2539sub convert {
2540 my ($self, %opts) = @_;
2541 my $matrix;
2542
34b3f7e6
TC		 2543 unless (defined wantarray) {
2544 my @caller = caller;
2545 warn "convert() called in void context - convert() returns the converted image at $caller[1] line $caller[2]\n";
2546 return;
2547 }
2548
f5991c03
TC		 2549 # the user can either specify a matrix or preset
2550 # the matrix overrides the preset
2551 if (!exists($opts{matrix})) {
2552 unless (exists($opts{preset})) {
2553 $self->{ERRSTR} = "convert() needs a matrix or preset";
2554 return;
2555 }
2556 else {
2557 if ($opts{preset} eq 'gray' || $opts{preset} eq 'grey') {
2558 # convert to greyscale, keeping the alpha channel if any
2559 if ($self->getchannels == 3) {
2560 $matrix = [ [ 0.222, 0.707, 0.071 ] ];
2561 }
2562 elsif ($self->getchannels == 4) {
2563 # preserve the alpha channel
2564 $matrix = [ [ 0.222, 0.707, 0.071, 0 ],
2565 [ 0, 0, 0, 1 ] ];
2566 }
2567 else {
2568 # an identity
2569 $matrix = _identity($self->getchannels);
2570 }
2571 }
2572 elsif ($opts{preset} eq 'noalpha') {
2573 # strip the alpha channel
2574 if ($self->getchannels == 2 or $self->getchannels == 4) {
2575 $matrix = _identity($self->getchannels);
2576 pop(@$matrix); # lose the alpha entry
2577 }
2578 else {
2579 $matrix = _identity($self->getchannels);
2580 }
2581 }
2582 elsif ($opts{preset} eq 'red' || $opts{preset} eq 'channel0') {
2583 # extract channel 0
2584 $matrix = [ [ 1 ] ];
2585 }
2586 elsif ($opts{preset} eq 'green' || $opts{preset} eq 'channel1') {
2587 $matrix = [ [ 0, 1 ] ];
2588 }
2589 elsif ($opts{preset} eq 'blue' || $opts{preset} eq 'channel2') {
2590 $matrix = [ [ 0, 0, 1 ] ];
2591 }
2592 elsif ($opts{preset} eq 'alpha') {
2593 if ($self->getchannels == 2 or $self->getchannels == 4) {
2594 $matrix = [ [ (0) x ($self->getchannels-1), 1 ] ];
2595 }
2596 else {
2597 # the alpha is just 1 <shrug>
2598 $matrix = [ [ (0) x $self->getchannels, 1 ] ];
2599 }
2600 }
2601 elsif ($opts{preset} eq 'rgb') {
2602 if ($self->getchannels == 1) {
2603 $matrix = [ [ 1 ], [ 1 ], [ 1 ] ];
2604 }
2605 elsif ($self->getchannels == 2) {
2606 # preserve the alpha channel
2607 $matrix = [ [ 1, 0 ], [ 1, 0 ], [ 1, 0 ], [ 0, 1 ] ];
2608 }
2609 else {
2610 $matrix = _identity($self->getchannels);
2611 }
2612 }
2613 elsif ($opts{preset} eq 'addalpha') {
2614 if ($self->getchannels == 1) {
2615 $matrix = _identity(2);
2616 }
2617 elsif ($self->getchannels == 3) {
2618 $matrix = _identity(4);
2619 }
2620 else {
2621 $matrix = _identity($self->getchannels);
2622 }
2623 }
2624 else {
2625 $self->{ERRSTR} = "Unknown convert preset $opts{preset}";
2626 return undef;
2627 }
2628 }
2629 }
2630 else {
2631 $matrix = $opts{matrix};
2632 }
2633
2634 my $new = Imager->new();
2635 $new->{IMG} = i_img_new();
2636 unless (i_convert($new->{IMG}, $self->{IMG}, $matrix)) {
2637 # most likely a bad matrix
2638 $self->{ERRSTR} = _error_as_msg();
2639 return undef;
2640 }
2641 return $new;
2642}
40eba1ea
AMH		 2643
2644
40eba1ea 2645# general function to map an image through lookup tables
9495ee93 2646
40eba1ea
AMH		 2647sub map {
2648 my ($self, %opts) = @_;
9495ee93 2649 my @chlist = qw( red green blue alpha );
40eba1ea
AMH		 2650
2651 if (!exists($opts{'maps'})) {
2652 # make maps from channel maps
2653 my $chnum;
2654 for $chnum (0..$#chlist) {
9495ee93
AMH		 2655 if (exists $opts{$chlist[$chnum]}) {
2656 $opts{'maps'}[$chnum] = $opts{$chlist[$chnum]};
2657 } elsif (exists $opts{'all'}) {
2658 $opts{'maps'}[$chnum] = $opts{'all'};
2659 }
40eba1ea
AMH		 2660 }
2661 }
2662 if ($opts{'maps'} and $self->{IMG}) {
2663 i_map($self->{IMG}, $opts{'maps'} );
2664 }
2665 return $self;
2666}
2667
dff75dee
TC		 2668sub difference {
2669 my ($self, %opts) = @_;
2670
2671 defined $opts{mindist} or $opts{mindist} = 0;
2672
2673 defined $opts{other}
2674 or return $self->_set_error("No 'other' parameter supplied");
2675 defined $opts{other}{IMG}
2676 or return $self->_set_error("No image data in 'other' image");
2677
2678 $self->{IMG}
2679 or return $self->_set_error("No image data");
2680
2681 my $result = Imager->new;
2682 $result->{IMG} = i_diff_image($self->{IMG}, $opts{other}{IMG},
2683 $opts{mindist})
2684 or return $self->_set_error($self->_error_as_msg());
2685
2686 return $result;
2687}
2688
02d1d628
AMH		 2689# destructive border - image is shrunk by one pixel all around
2690
2691sub border {
2692 my ($self,%opts)=@_;
2693 my($tx,$ty)=($self->getwidth()-1,$self->getheight()-1);
2694 $self->polyline('x'=>[0,$tx,$tx,0,0],'y'=>[0,0,$ty,$ty,0],%opts);
2695}
2696
2697
2698# Get the width of an image
2699
2700sub getwidth {
2701 my $self = shift;
2702 if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
2703 return (i_img_info($self->{IMG}))[0];
2704}
2705
2706# Get the height of an image
2707
2708sub getheight {
2709 my $self = shift;
2710 if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
2711 return (i_img_info($self->{IMG}))[1];
2712}
2713
2714# Get number of channels in an image
2715
2716sub getchannels {
2717 my $self = shift;
2718 if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
2719 return i_img_getchannels($self->{IMG});
2720}
2721
2722# Get channel mask
2723
2724sub getmask {
2725 my $self = shift;
2726 if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
2727 return i_img_getmask($self->{IMG});
2728}
2729
2730# Set channel mask
2731
2732sub setmask {
2733 my $self = shift;
2734 my %opts = @_;
35f40526
TC		 2735 if (!defined($self->{IMG})) {
2736 $self->{ERRSTR} = 'image is empty';
2737 return undef;
2738 }
2739 unless (defined $opts{mask}) {
2740 $self->_set_error("mask parameter required");
2741 return;
2742 }
02d1d628 2743 i_img_setmask( $self->{IMG} , $opts{mask} );
35f40526
TC		 2744
2745 1;
02d1d628
AMH		 2746}
2747
2748# Get number of colors in an image
2749
2750sub getcolorcount {
2751 my $self=shift;
9d540150 2752 my %opts=('maxcolors'=>2**30,@_);
02d1d628
AMH		 2753 if (!defined($self->{IMG})) { $self->{ERRSTR}='image is empty'; return undef; }
2754 my $rc=i_count_colors($self->{IMG},$opts{'maxcolors'});
2755 return ($rc==-1? undef : $rc);
2756}
2757
2758# draw string to an image
2759
2760sub string {
2761 my $self = shift;
2762 unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
2763
2764 my %input=('x'=>0, 'y'=>0, @_);
2765 $input{string}||=$input{text};
2766
2767 unless(exists $input{string}) {
2768 $self->{ERRSTR}="missing required parameter 'string'";
2769 return;
2770 }
2771
2772 unless($input{font}) {
2773 $self->{ERRSTR}="missing required parameter 'font'";
2774 return;
2775 }
2776
faa9b3e7
TC		 2777 unless ($input{font}->draw(image=>$self, %input)) {
2778 $self->{ERRSTR} = $self->_error_as_msg();
2779 return;
2780 }
02d1d628
AMH		 2781
2782 return $self;
2783}
2784
77157728
TC		 2785my @file_limit_names = qw/width height bytes/;
2786
2787sub set_file_limits {
2788 shift;
2789
2790 my %opts = @_;
2791 my %values;
2792
2793 if ($opts{reset}) {
2794 @values{@file_limit_names} = (0) x @file_limit_names;
2795 }
2796 else {
2797 @values{@file_limit_names} = i_get_image_file_limits();
2798 }
2799
2800 for my $key (keys %values) {
2801 defined $opts{$key} and $values{$key} = $opts{$key};
2802 }
2803
2804 i_set_image_file_limits($values{width}, $values{height}, $values{bytes});
2805}
2806
2807sub get_file_limits {
2808 i_get_image_file_limits();
2809}
2810
02d1d628
AMH		 2811# Shortcuts that can be exported
2812
2813sub newcolor { Imager::Color->new(@_); }
2814sub newfont { Imager::Font->new(@_); }
2815
2816*NC=*newcolour=*newcolor;
2817*NF=*newfont;
2818
2819*open=\&read;
2820*circle=\&arc;
2821
2822
2823#### Utility routines
2824
faa9b3e7
TC		 2825sub errstr {
2826 ref $_[0] ? $_[0]->{ERRSTR} : $ERRSTR
2827}
02d1d628 2828
10461f9a
TC		 2829sub _set_error {
2830 my ($self, $msg) = @_;
2831
2832 if (ref $self) {
2833 $self->{ERRSTR} = $msg;
2834 }
2835 else {
2836 $ERRSTR = $msg;
2837 }
dff75dee 2838 return;
10461f9a
TC		 2839}
2840
02d1d628
AMH		 2841# Default guess for the type of an image from extension
2842
2843sub def_guess_type {
2844 my $name=lc(shift);
2845 my $ext;
2846 $ext=($name =~ m/\.([^\.]+)$/)[0];
2847 return 'tiff' if ($ext =~ m/^tiff?$/);
2848 return 'jpeg' if ($ext =~ m/^jpe?g$/);
2849 return 'pnm' if ($ext =~ m/^p[pgb]m$/);
2850 return 'png' if ($ext eq "png");
705fd961 2851 return 'bmp' if ($ext eq "bmp" || $ext eq "dib");
1ec86afa 2852 return 'tga' if ($ext eq "tga");
737a830c 2853 return 'rgb' if ($ext eq "rgb");
02d1d628 2854 return 'gif' if ($ext eq "gif");
10461f9a 2855 return 'raw' if ($ext eq "raw");
02d1d628
AMH		 2856 return ();
2857}
2858
2859# get the minimum of a list
2860
2861sub min {
2862 my $mx=shift;
2863 for(@_) { if ($_<$mx) { $mx=$_; }}
2864 return $mx;
2865}
2866
2867# get the maximum of a list
2868
2869sub max {
2870 my $mx=shift;
2871 for(@_) { if ($_>$mx) { $mx=$_; }}
2872 return $mx;
2873}
2874
2875# string stuff for iptc headers
2876
2877sub clean {
2878 my($str)=$_[0];
2879 $str = substr($str,3);
2880 $str =~ s/[\n\r]//g;
2881 $str =~ s/\s+/ /g;
2882 $str =~ s/^\s//;
2883 $str =~ s/\s$//;
2884 return $str;
2885}
2886
2887# A little hack to parse iptc headers.
2888
2889sub parseiptc {
2890 my $self=shift;
2891 my(@sar,$item,@ar);
2892 my($caption,$photogr,$headln,$credit);
2893
2894 my $str=$self->{IPTCRAW};
2895
2896 #print $str;
2897
2898 @ar=split(/8BIM/,$str);
2899
2900 my $i=0;
2901 foreach (@ar) {
2902 if (/^\004\004/) {
2903 @sar=split(/\034\002/);
2904 foreach $item (@sar) {
cdd23610 2905 if ($item =~ m/^x/) {
02d1d628
AMH		 2906 $caption=&clean($item);
2907 $i++;
2908 }
cdd23610 2909 if ($item =~ m/^P/) {
02d1d628
AMH		 2910 $photogr=&clean($item);
2911 $i++;
2912 }
cdd23610 2913 if ($item =~ m/^i/) {
02d1d628
AMH		 2914 $headln=&clean($item);
2915 $i++;
2916 }
cdd23610 2917 if ($item =~ m/^n/) {
02d1d628
AMH		 2918 $credit=&clean($item);
2919 $i++;
2920 }
2921 }
2922 }
2923 }
2924 return (caption=>$caption,photogr=>$photogr,headln=>$headln,credit=>$credit);
2925}
2926
02d1d628
AMH		 2927# Autoload methods go after =cut, and are processed by the autosplit program.
2928
29291;
2930__END__
2931# Below is the stub of documentation for your module. You better edit it!
2932
2933=head1 NAME
2934
2935Imager - Perl extension for Generating 24 bit Images
2936
2937=head1 SYNOPSIS
2938
0e418f1e
AMH		 2939 # Thumbnail example
2940
2941 #!/usr/bin/perl -w
2942 use strict;
10461f9a 2943 use Imager;
02d1d628 2944
0e418f1e
AMH		 2945 die "Usage: thumbmake.pl filename\n" if !-f $ARGV[0];
2946 my $file = shift;
2947
2948 my $format;
2949
2950 my $img = Imager->new();
e36d02ad
TC		 2951 # see Imager::Files for information on the read() method
2952 $img->read(file=>$file) or die $img->errstr();
0e418f1e
AMH		 2953
2954 $file =~ s/\.[^.]*$//;
2955
2956 # Create smaller version
cf7a7d18 2957 # documented in Imager::Transformations
0e418f1e
AMH		 2958 my $thumb = $img->scale(scalefactor=>.3);
2959
2960 # Autostretch individual channels
2961 $thumb->filter(type=>'autolevels');
2962
2963 # try to save in one of these formats
2964 SAVE:
2965
2966 for $format ( qw( png gif jpg tiff ppm ) ) {
2967 # Check if given format is supported
2968 if ($Imager::formats{$format}) {
2969 $file.="_low.$format";
2970 print "Storing image as: $file\n";
cf7a7d18 2971 # documented in Imager::Files
0e418f1e
AMH		 2972 $thumb->write(file=>$file) or
2973 die $thumb->errstr;
2974 last SAVE;
2975 }
2976 }
2977
02d1d628
AMH		 2978=head1 DESCRIPTION
2979
0e418f1e
AMH		 2980Imager is a module for creating and altering images. It can read and
2981write various image formats, draw primitive shapes like lines,and
2982polygons, blend multiple images together in various ways, scale, crop,
2983render text and more.
02d1d628 2984
5df0fac7
AMH		 2985=head2 Overview of documentation
2986
2987=over
2988
cf7a7d18 2989=item *
5df0fac7 2990
cf7a7d18
TC		 2991Imager - This document - Synopsis Example, Table of Contents and
2992Overview.
5df0fac7 2993
cf7a7d18 2994=item *
5df0fac7 2995
985bda61
TC		 2996L<Imager::Tutorial> - a brief introduction to Imager.
2997
2998=item *
2999
e1d57e9d
TC		 3000L<Imager::Cookbook> - how to do various things with Imager.
3001
3002=item *
3003
cf7a7d18
TC		 3004L<Imager::ImageTypes> - Basics of constructing image objects with
3005C<new()>: Direct type/virtual images, RGB(A)/paletted images,
30068/16/double bits/channel, color maps, channel masks, image tags, color
6d0ed98a 3007quantization. Also discusses basic image information methods.
5df0fac7 3008
cf7a7d18 3009=item *
5df0fac7 3010
cf7a7d18
TC		 3011L<Imager::Files> - IO interaction, reading/writing images, format
3012specific tags.
5df0fac7 3013
cf7a7d18 3014=item *
5df0fac7 3015
cf7a7d18
TC		 3016L<Imager::Draw> - Drawing Primitives, lines, boxes, circles, arcs,
3017flood fill.
5df0fac7 3018
cf7a7d18 3019=item *
5df0fac7 3020
cf7a7d18 3021L<Imager::Color> - Color specification.
5df0fac7 3022
cf7a7d18 3023=item *
f5fd108b 3024
cf7a7d18 3025L<Imager::Fill> - Fill pattern specification.
f5fd108b 3026
cf7a7d18 3027=item *
5df0fac7 3028
cf7a7d18
TC		 3029L<Imager::Font> - General font rendering, bounding boxes and font
3030metrics.
5df0fac7 3031
cf7a7d18 3032=item *
5df0fac7 3033
cf7a7d18
TC		 3034L<Imager::Transformations> - Copying, scaling, cropping, flipping,
3035blending, pasting, convert and map.
5df0fac7 3036
cf7a7d18 3037=item *
5df0fac7 3038
cf7a7d18
TC		 3039L<Imager::Engines> - Programmable transformations through
3040C<transform()>, C<transform2()> and C<matrix_transform()>.
5df0fac7 3041
cf7a7d18 3042=item *
5df0fac7 3043
cf7a7d18
TC		 3044L<Imager::Filters> - Filters, sharpen, blur, noise, convolve etc. and
3045filter plugins.
5df0fac7 3046
cf7a7d18 3047=item *
5df0fac7 3048
cf7a7d18
TC		 3049L<Imager::Expr> - Expressions for evaluation engine used by
3050transform2().
5df0fac7 3051
cf7a7d18 3052=item *
5df0fac7 3053
cf7a7d18 3054L<Imager::Matrix2d> - Helper class for affine transformations.
5df0fac7 3055
cf7a7d18 3056=item *
5df0fac7 3057
cf7a7d18 3058L<Imager::Fountain> - Helper for making gradient profiles.
5df0fac7
AMH		 3059
3060=back
3061
0e418f1e 3062=head2 Basic Overview
02d1d628 3063
55b287f5
AMH		 3064An Image object is created with C<$img = Imager-E<gt>new()>.
3065Examples:
02d1d628 3066
55b287f5 3067 $img=Imager->new(); # create empty image
e36d02ad 3068 $img->read(file=>'lena.png',type=>'png') or # read image from file
55b287f5
AMH		 3069 die $img->errstr(); # give an explanation
3070 # if something failed
02d1d628
AMH		 3071
3072or if you want to create an empty image:
3073
3074 $img=Imager->new(xsize=>400,ysize=>300,channels=>4);
3075
0e418f1e
AMH		 3076This example creates a completely black image of width 400 and height
3077300 and 4 channels.
3078
55b287f5
AMH		 3079When an operation fails which can be directly associated with an image
3080the error message is stored can be retrieved with
3081C<$img-E<gt>errstr()>.
3082
3083In cases where no image object is associated with an operation
3084C<$Imager::ERRSTR> is used to report errors not directly associated
99958502
TC		 3085with an image object. You can also call C<Imager->errstr> to get this
3086value.
55b287f5 3087
cf7a7d18
TC		 3088The C<Imager-E<gt>new> method is described in detail in
3089L<Imager::ImageTypes>.
4b4f5319 3090
13fc481e
TC		 3091=head1 METHOD INDEX
3092
3093Where to find information on methods for Imager class objects.
3094
4b3408a5 3095addcolors() - L<Imager::ImageTypes/addcolors>
13fc481e 3096
4b3408a5 3097addtag() - L<Imager::ImageTypes/addtag> - add image tags
13fc481e
TC		 3098
3099arc() - L<Imager::Draw/arc>
3100
4b3408a5 3101bits() - L<Imager::ImageTypes/bits> - number of bits per sample for the
13fc481e
TC		 3102image
3103
3104box() - L<Imager::Draw/box>
3105
3106circle() - L<Imager::Draw/circle>
3107
feac660c
TC		 3108colorcount() - L<Imager::Draw/colorcount>
3109
13fc481e
TC		 3110convert() - L<Imager::Transformations/"Color transformations"> -
3111transform the color space
3112
3113copy() - L<Imager::Transformations/copy>
3114
3115crop() - L<Imager::Transformations/crop> - extract part of an image
3116
4b3408a5 3117deltag() - L<Imager::ImageTypes/deltag> - delete image tags
13fc481e
TC		 3118
3119difference() - L<Imager::Filters/"Image Difference">
3120
99958502
TC		 3121errstr() - L<Imager/"Basic Overview">
3122
13fc481e
TC		 3123filter() - L<Imager::Filters>
3124
4b3408a5 3125findcolor() - L<Imager::ImageTypes/findcolor> - search the image palette, if it
13fc481e
TC		 3126has one
3127
3128flip() - L<Imager::Transformations/flip>
3129
3130flood_fill() - L<Imager::Draw/flood_fill>
3131
4b3408a5 3132getchannels() - L<Imager::ImageTypes/getchannels>
13fc481e 3133
4b3408a5 3134getcolorcount() - L<Imager::ImageTypes/getcolorcount>
13fc481e 3135
4b3408a5 3136getcolors() - L<Imager::ImageTypes/getcolors> - get colors from the image
13fc481e
TC		 3137palette, if it has one
3138
77157728
TC		 3139get_file_limits() - L<Imager::Files/"Limiting the sizes of images you read">
3140
4b3408a5 3141getheight() - L<Imager::ImageTypes/getwidth>
13fc481e
TC		 3142
3143getpixel() - L<Imager::Draw/setpixel and getpixel>
3144
ca4d914e
TC		 3145getsamples() - L<Imager::Draw/getsamples>
3146
3147getscanline() - L<Imager::Draw/getscanline>
3148
4b3408a5 3149getwidth() - L<Imager::ImageTypes/getwidth>
13fc481e 3150
4b3408a5 3151img_set() - L<Imager::ImageTypes/img_set>
13fc481e
TC		 3152
3153line() - L<Imager::Draw/line>
3154
3155map() - L<Imager::Transformations/"Color Mappings"> - remap color
3156channel values
3157
4b3408a5 3158masked() - L<Imager::ImageTypes/masked> - make a masked image
13fc481e
TC		 3159
3160matrix_transform() - L<Imager::Engines/"Matrix Transformations">
3161
4b3408a5 3162maxcolors() - L<Imager::ImageTypes/maxcolors>
feac660c 3163
4b3408a5 3164new() - L<Imager::ImageTypes/new>
13fc481e 3165
e36d02ad
TC		 3166open() - L<Imager::Files> - an alias for read()
3167
13fc481e
TC		 3168paste() - L<Imager::Transformations/paste> - draw an image onto an image
3169
3170polygon() - L<Imager::Draw/polygon>
3171
3172polyline() - L<Imager::Draw/polyline>
3173
e36d02ad 3174read() - L<Imager::Files> - read a single image from an image file
13fc481e 3175
e36d02ad
TC		 3176read_multi() - L<Imager::Files> - read multiple images from an image
3177file
13fc481e
TC		 3178
3179rotate() - L<Imager::Transformations/rotate>
3180
3181rubthrough() - L<Imager::Transformations/rubthrough> - draw an image onto an
3182image and use the alpha channel
3183
3184scale() - L<Imager::Transformations/scale>
1adb5500 3185
ca4d914e
TC		 3186setscanline() - L<Imager::Draw/setscanline>
3187
1adb5500
TC		 3188scaleX() - L<Imager::Transformations/scaleX>
3189
3190scaleY() - L<Imager::Transformations/scaleY>
13fc481e 3191
4b3408a5
TC		 3192setcolors() - L<Imager::ImageTypes/setcolors> - set palette colors in
3193a paletted image
13fc481e
TC		 3194
3195setpixel() - L<Imager::Draw/setpixel and getpixel>
3196
77157728
TC		 3197set_file_limits() - L<Imager::Files/"Limiting the sizes of images you read">
3198
13fc481e
TC		 3199string() - L<Imager::Font/string> - draw text on an image
3200
4b3408a5 3201tags() - L<Imager::ImageTypes/tags> - fetch image tags
13fc481e 3202
4b3408a5 3203to_paletted() - L<Imager::ImageTypes/to_paletted>
13fc481e 3204
4b3408a5 3205to_rgb8() - L<Imager::ImageTypes/to_rgb8>
13fc481e
TC		 3206
3207transform() - L<Imager::Engines/"transform">
3208
3209transform2() - L<Imager::Engines/"transform2">
3210
4b3408a5 3211type() - L<Imager::ImageTypes/type> - type of image (direct vs paletted)
13fc481e 3212
4b3408a5 3213virtual() - L<Imager::ImageTypes/virtual> - whether the image has it's own
13fc481e
TC		 3214data
3215
e36d02ad 3216write() - L<Imager::Files> - write an image to a file
13fc481e 3217
e36d02ad
TC		 3218write_multi() - L<Imager::Files> - write multiple image to an image
3219file.
13fc481e 3220
dc67bc2f
TC		 3221=head1 CONCEPT INDEX
3222
3223animated GIF - L<Imager::File/"Writing an animated GIF">
3224
3225aspect ratio - L<Imager::ImageTypes/i_xres>,
3226L<Imager::ImageTypes/i_yres>, L<Imager::ImageTypes/i_aspect_only>
3227
3228blur - L<Imager::Filters/guassian>, L<Imager::Filters/conv>
3229
3230boxes, drawing - L<Imager::Draw/box>
3231
a8652edf
TC		 3232changes between image - L<Imager::Filter/"Image Difference">
3233
dc67bc2f
TC		 3234color - L<Imager::Color>
3235
3236color names - L<Imager::Color>, L<Imager::Color::Table>
3237
3238combine modes - L<Imager::Fill/combine>
3239
a8652edf
TC		 3240compare images - L<Imager::Filter/"Image Difference">
3241
a4e6485d
TC		 3242contrast - L<Imager::Filter/contrast>, L<Imager::Filter/autolevels>
3243
3244convolution - L<Imager::Filter/conv>
3245
dc67bc2f
TC		 3246cropping - L<Imager::Transformations/crop>
3247
a8652edf
TC		 3248C<diff> images - L<Imager::Filter/"Image Difference">
3249
dc67bc2f
TC		 3250dpi - L<Imager::ImageTypes/i_xres>
3251
3252drawing boxes - L<Imager::Draw/box>
3253
3254drawing lines - L<Imager::Draw/line>
3255
985bda61 3256drawing text - L<Imager::Font/string>, L<Imager::Font/align>
dc67bc2f
TC		 3257
3258error message - L<Imager/"Basic Overview">
3259
3260files, font - L<Imager::Font>
3261
3262files, image - L<Imager::Files>
3263
3264filling, types of fill - L<Imager::Fill>
3265
3266filling, boxes - L<Imager::Draw/box>
3267
3268filling, flood fill - L<Imager::Draw/flood_fill>
3269
3270flood fill - L<Imager::Draw/flood_fill>
3271
3272fonts - L<Imager::Font>
3273
3274fonts, drawing with - L<Imager::Font/string>, L<Imager::Font/align>,
3275L<Imager::Font::Wrap>
3276
3277fonts, metrics - L<Imager::Font/bounding_box>, L<Imager::Font::BBox>
3278
3279fonts, multiple master - L<Imager::Font/"MULTIPLE MASTER FONTS">
3280
3281fountain fill - L<Imager::Fill/"Fountain fills">,
3282L<Imager::Filters/fountain>, L<Imager::Fountain>,
3283L<Imager::Filters/gradgen>
3284
a4e6485d
TC		 3285GIF files - L<Imager::Files/"GIF">
3286
3287GIF files, animated - L<Imager::File/"Writing an animated GIF">
3288
dc67bc2f
TC		 3289gradient fill - L<Imager::Fill/"Fountain fills">,
3290L<Imager::Filters/fountain>, L<Imager::Fountain>,
3291L<Imager::Filters/gradgen>
3292
a4e6485d
TC		 3293guassian blur - L<Imager::Filter/guassian>
3294
dc67bc2f
TC		 3295hatch fills - L<Imager::Fill/"Hatched fills">
3296
a4e6485d
TC		 3297invert image - L<Imager::Filter/hardinvert>
3298
dc67bc2f
TC		 3299JPEG - L<Imager::Files/"JPEG">
3300
77157728
TC		 3301limiting image sizes - L<Imager::Files/"Limiting the sizes of images you read">
3302
dc67bc2f
TC		 3303lines, drawing - L<Imager::Draw/line>
3304
a4e6485d
TC		 3305matrix - L<Imager::Matrix2d>,
3306L<Imager::Transformations/"Matrix Transformations">,
3307L<Imager::Font/transform>
3308
dc67bc2f
TC		 3309metadata, image - L<Imager::ImageTypes/"Tags">
3310
a4e6485d
TC		 3311mosaic - L<Imager::Filter/mosaic>
3312
3313noise, filter - L<Imager::Filter/noise>
3314
3315noise, rendered - L<Imager::Filter/turbnoise>,
3316L<Imager::Filter/radnoise>
3317
4b3408a5
TC		 3318pseudo-color image - L<Imager::ImageTypes/to_paletted>,
3319L<Imager::ImageTypes/new>
3320
a4e6485d
TC		 3321posterize - L<Imager::Filter/postlevels>
3322
3323png files - L<Imager::Files>, L<Imager::Files/"PNG">
dc67bc2f 3324
f75c1aeb 3325pnm - L<Imager::Files/"PNM (Portable aNy Map)">
dc67bc2f
TC		 3326
3327rectangles, drawing - L<Imager::Draw/box>
3328
3329resizing an image - L<Imager::Transformations/scale>,
3330L<Imager::Transformations/crop>
3331
3332saving an image - L<Imager::Files>
3333
3334scaling - L<Imager::Transformations/scale>
3335
3336sharpen - L<Imager::Filters/unsharpmask>, L<Imager::Filters/conv>
3337
3338size, image - L<Imager::ImageTypes/getwidth>,
3339L<Imager::ImageTypes/getheight>
3340
3341size, text - L<Imager::Font/bounding_box>
3342
4b3408a5
TC		 3343tags, image metadata - L<Imager::ImageTypes/"Tags">
3344
dc67bc2f
TC		 3345text, drawing - L<Imager::Font/string>, L<Imager::Font/align>,
3346L<Imager::Font::Wrap>
3347
3348text, wrapping text in an area - L<Imager::Font::Wrap>
3349
3350text, measuring - L<Imager::Font/bounding_box>, L<Imager::Font::BBox>
3351
a4e6485d
TC		 3352tiles, color - L<Imager::Filter/mosaic>
3353
3354unsharp mask - L<Imager::Filter/unsharpmask>
3355
3356watermark - L<Imager::Filter/watermark>
3357
dc67bc2f
TC		 3358writing an image - L<Imager::Files>
3359
f64132d2 3360=head1 SUPPORT
0e418f1e 3361
f64132d2
TC		 3362You can ask for help, report bugs or express your undying love for
3363Imager on the Imager-devel mailing list.
02d1d628 3364
f64132d2
TC		 3365To subscribe send a message with C<subscribe> in the body to:
3366
3367 imager-devel+request@molar.is
3368
3369or use the form at:
3370
3371 http://www.molar.is/en/lists/imager-devel/
55b287f5 3372 (annonymous is temporarily off due to spam)
f64132d2
TC		 3373
3374where you can also find the mailing list archive.
10461f9a 3375
3ed96cd3 3376If you're into IRC, you can typically find the developers in #Imager
8f22b8d8
TC		 3377on irc.perl.org. As with any IRC channel, the participants could be
3378occupied or asleep, so please be patient.
3379
f6acebd0 3380You can report bugs by pointing your browser at:
8f22b8d8
TC		 3381
3382 https://rt.cpan.org/NoAuth/ReportBug.html?Queue=Imager
3383
3384Please remember to include the versions of Imager, perl, supporting
3385libraries, and any relevant code. If you have specific images that
3386cause the problems, please include those too.
3ed96cd3 3387
02d1d628
AMH		 3388=head1 BUGS
3389
0e418f1e 3390Bugs are listed individually for relevant pod pages.
02d1d628
AMH		 3391
3392=head1 AUTHOR
3393
4b3408a5
TC		 3394Arnar M. Hrafnkelsson and Tony Cook (tony@imager.perl.org) among
3395others. See the README for a complete list.
02d1d628 3396
9495ee93 3397=head1 SEE ALSO
02d1d628 3398
55b287f5
AMH		 3399perl(1), Imager::ImageTypes(3), Imager::Files(3), Imager::Draw(3),
3400Imager::Color(3), Imager::Fill(3), Imager::Font(3),
3401Imager::Transformations(3), Imager::Engines(3), Imager::Filters(3),
3402Imager::Expr(3), Imager::Matrix2d(3), Imager::Fountain(3)
009db950
AMH		 3403
3404Affix::Infix2Postfix(3), Parse::RecDescent(3)
8f22b8d8 3405http://imager.perl.org/
02d1d628 3406
35f40526
TC		 3407Other perl imaging modules include:
3408
3409GD(3), Image::Magick(3), Graphics::Magick(3).
3410
02d1d628 3411=cut
Image manipulation for perl