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