Adds reading capabilities for certain variants of targa, writer code has not been
[imager.git] / Imager.pm
CommitLineData
02d1d628
AMH
1package Imager;
2
02d1d628
AMH
3use strict;
4use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS %formats $DEBUG %filters %DSOs $ERRSTR $fontstate %OPCODES $I2P $FORMATGUESS);
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
38 i_draw
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
47
48 i_copyto
49 i_rubthru
50 i_scaleaxis
51 i_scale_nn
52 i_haar
53 i_count_colors
dd55acc8 54
02d1d628
AMH
55 i_gaussian
56 i_conv
dd55acc8 57
f5991c03 58 i_convert
40eba1ea 59 i_map
dd55acc8 60
02d1d628
AMH
61 i_img_diff
62
63 i_init_fonts
64 i_t1_new
65 i_t1_destroy
66 i_t1_set_aa
67 i_t1_cp
68 i_t1_text
69 i_t1_bbox
70
02d1d628
AMH
71 i_tt_set_aa
72 i_tt_cp
73 i_tt_text
74 i_tt_bbox
75
02d1d628
AMH
76 i_readjpeg_wiol
77 i_writejpeg_wiol
78
79 i_readtiff_wiol
80 i_writetiff_wiol
d2dfdcc9 81 i_writetiff_wiol_faxable
02d1d628 82
790923a4
AMH
83 i_readpng_wiol
84 i_writepng_wiol
02d1d628
AMH
85
86 i_readgif
87 i_readgif_callback
88 i_writegif
89 i_writegifmc
90 i_writegif_gen
91 i_writegif_callback
92
93 i_readpnm_wiol
067d6bdc 94 i_writeppm_wiol
02d1d628 95
895dbd34
AMH
96 i_readraw_wiol
97 i_writeraw_wiol
02d1d628
AMH
98
99 i_contrast
100 i_hardinvert
101 i_noise
102 i_bumpmap
103 i_postlevels
104 i_mosaic
105 i_watermark
dd55acc8 106
02d1d628
AMH
107 malloc_state
108
109 list_formats
dd55acc8 110
02d1d628
AMH
111 i_gifquant
112
113 newfont
114 newcolor
115 newcolour
116 NC
117 NF
02d1d628
AMH
118);
119
02d1d628
AMH
120@EXPORT=qw(
121 init_log
122 i_list_formats
123 i_has_format
124 malloc_state
125 i_color_new
126
127 i_img_empty
128 i_img_empty_ch
129 );
130
131%EXPORT_TAGS=
132 (handy => [qw(
133 newfont
134 newcolor
135 NF
136 NC
137 )],
138 all => [@EXPORT_OK],
139 default => [qw(
140 load_plugin
141 unload_plugin
142 )]);
143
02d1d628
AMH
144BEGIN {
145 require Exporter;
146 require DynaLoader;
147
5b0d044f 148 $VERSION = '0.39pre1';
02d1d628
AMH
149 @ISA = qw(Exporter DynaLoader);
150 bootstrap Imager $VERSION;
151}
152
153BEGIN {
154 i_init_fonts(); # Initialize font engines
faa9b3e7 155 Imager::Font::__init();
02d1d628
AMH
156 for(i_list_formats()) { $formats{$_}++; }
157
158 if ($formats{'t1'}) {
159 i_t1_set_aa(1);
160 }
161
faa9b3e7
TC
162 if (!$formats{'t1'} and !$formats{'tt'}
163 && !$formats{'ft2'} && !$formats{'w32'}) {
02d1d628
AMH
164 $fontstate='no font support';
165 }
166
167 %OPCODES=(Add=>[0],Sub=>[1],Mult=>[2],Div=>[3],Parm=>[4],'sin'=>[5],'cos'=>[6],'x'=>[4,0],'y'=>[4,1]);
168
169 $DEBUG=0;
170
6607600c
TC
171 # the members of the subhashes under %filters are:
172 # callseq - a list of the parameters to the underlying filter in the
173 # order they are passed
174 # callsub - a code ref that takes a named parameter list and calls the
175 # underlying filter
176 # defaults - a hash of default values
177 # names - defines names for value of given parameters so if the names
178 # field is foo=> { bar=>1 }, and the user supplies "bar" as the
179 # foo parameter, the filter will receive 1 for the foo
180 # parameter
02d1d628
AMH
181 $filters{contrast}={
182 callseq => ['image','intensity'],
183 callsub => sub { my %hsh=@_; i_contrast($hsh{image},$hsh{intensity}); }
184 };
185
186 $filters{noise} ={
187 callseq => ['image', 'amount', 'subtype'],
188 defaults => { amount=>3,subtype=>0 },
189 callsub => sub { my %hsh=@_; i_noise($hsh{image},$hsh{amount},$hsh{subtype}); }
190 };
191
192 $filters{hardinvert} ={
193 callseq => ['image'],
194 defaults => { },
195 callsub => sub { my %hsh=@_; i_hardinvert($hsh{image}); }
196 };
197
198 $filters{autolevels} ={
199 callseq => ['image','lsat','usat','skew'],
200 defaults => { lsat=>0.1,usat=>0.1,skew=>0.0 },
201 callsub => sub { my %hsh=@_; i_autolevels($hsh{image},$hsh{lsat},$hsh{usat},$hsh{skew}); }
202 };
203
204 $filters{turbnoise} ={
205 callseq => ['image'],
206 defaults => { xo=>0.0,yo=>0.0,scale=>10.0 },
207 callsub => sub { my %hsh=@_; i_turbnoise($hsh{image},$hsh{xo},$hsh{yo},$hsh{scale}); }
208 };
209
210 $filters{radnoise} ={
211 callseq => ['image'],
212 defaults => { xo=>100,yo=>100,ascale=>17.0,rscale=>0.02 },
213 callsub => sub { my %hsh=@_; i_radnoise($hsh{image},$hsh{xo},$hsh{yo},$hsh{rscale},$hsh{ascale}); }
214 };
215
216 $filters{conv} ={
217 callseq => ['image', 'coef'],
218 defaults => { },
219 callsub => sub { my %hsh=@_; i_conv($hsh{image},$hsh{coef}); }
220 };
221
222 $filters{gradgen} ={
223 callseq => ['image', 'xo', 'yo', 'colors', 'dist'],
224 defaults => { },
225 callsub => sub { my %hsh=@_; i_gradgen($hsh{image}, $hsh{xo}, $hsh{yo}, $hsh{colors}, $hsh{dist}); }
226 };
227
228 $filters{nearest_color} ={
229 callseq => ['image', 'xo', 'yo', 'colors', 'dist'],
230 defaults => { },
231 callsub => sub { my %hsh=@_; i_nearest_color($hsh{image}, $hsh{xo}, $hsh{yo}, $hsh{colors}, $hsh{dist}); }
232 };
faa9b3e7
TC
233 $filters{gaussian} = {
234 callseq => [ 'image', 'stddev' ],
235 defaults => { },
236 callsub => sub { my %hsh = @_; i_gaussian($hsh{image}, $hsh{stddev}); },
237 };
d08b8f85
TC
238 $filters{mosaic} =
239 {
240 callseq => [ qw(image size) ],
241 defaults => { size => 20 },
242 callsub => sub { my %hsh = @_; i_mosaic($hsh{image}, $hsh{size}) },
243 };
244 $filters{bumpmap} =
245 {
246 callseq => [ qw(image bump elevation lightx lighty st) ],
247 defaults => { elevation=>0, st=> 2 },
248 callsub => sub {
249 my %hsh = @_;
250 i_bumpmap($hsh{image}, $hsh{bump}{IMG}, $hsh{elevation},
251 $hsh{lightx}, $hsh{lighty}, $hsh{st});
252 },
253 };
254 $filters{postlevels} =
255 {
256 callseq => [ qw(image levels) ],
257 defaults => { levels => 10 },
258 callsub => sub { my %hsh = @_; i_postlevels($hsh{image}, $hsh{levels}); },
259 };
260 $filters{watermark} =
261 {
262 callseq => [ qw(image wmark tx ty pixdiff) ],
263 defaults => { pixdiff=>10, tx=>0, ty=>0 },
264 callsub =>
265 sub {
266 my %hsh = @_;
267 i_watermark($hsh{image}, $hsh{wmark}{IMG}, $hsh{tx}, $hsh{ty},
268 $hsh{pixdiff});
269 },
270 };
6607600c
TC
271 $filters{fountain} =
272 {
273 callseq => [ qw(image xa ya xb yb ftype repeat combine super_sample ssample_param segments) ],
274 names => {
275 ftype => { linear => 0,
276 bilinear => 1,
277 radial => 2,
278 radial_square => 3,
279 revolution => 4,
280 conical => 5 },
281 repeat => { none => 0,
282 sawtooth => 1,
283 triangle => 2,
284 saw_both => 3,
285 tri_both => 4,
286 },
287 super_sample => {
288 none => 0,
289 grid => 1,
290 random => 2,
291 circle => 3,
292 },
efdc2568
TC
293 combine => {
294 none => 0,
295 normal => 1,
296 multiply => 2, mult => 2,
297 dissolve => 3,
298 add => 4,
299 subtract => 5, sub => 5,
300 diff => 6,
301 lighten => 7,
302 darken => 8,
303 hue => 9,
304 sat => 10,
305 value => 11,
306 color => 12,
307 },
6607600c
TC
308 },
309 defaults => { ftype => 0, repeat => 0, combine => 0,
310 super_sample => 0, ssample_param => 4,
311 segments=>[
312 [ 0, 0.5, 1,
313 Imager::Color->new(0,0,0),
314 Imager::Color->new(255, 255, 255),
315 0, 0,
316 ],
317 ],
318 },
319 callsub =>
320 sub {
321 my %hsh = @_;
322 i_fountain($hsh{image}, $hsh{xa}, $hsh{ya}, $hsh{xb}, $hsh{yb},
323 $hsh{ftype}, $hsh{repeat}, $hsh{combine}, $hsh{super_sample},
324 $hsh{ssample_param}, $hsh{segments});
325 },
326 };
02d1d628
AMH
327
328 $FORMATGUESS=\&def_guess_type;
329}
330
331#
332# Non methods
333#
334
335# initlize Imager
336# NOTE: this might be moved to an import override later on
337
338#sub import {
339# my $pack = shift;
340# (look through @_ for special tags, process, and remove them);
341# use Data::Dumper;
342# print Dumper($pack);
343# print Dumper(@_);
344#}
345
346sub init {
347 my %parms=(loglevel=>1,@_);
348 if ($parms{'log'}) {
349 init_log($parms{'log'},$parms{'loglevel'});
350 }
351
352# if ($parms{T1LIB_CONFIG}) { $ENV{T1LIB_CONFIG}=$parms{T1LIB_CONFIG}; }
353# if ( $ENV{T1LIB_CONFIG} and ( $fontstate eq 'missing conf' )) {
354# i_init_fonts();
355# $fontstate='ok';
356# }
357}
358
359END {
360 if ($DEBUG) {
361 print "shutdown code\n";
362 # for(keys %instances) { $instances{$_}->DESTROY(); }
363 malloc_state(); # how do decide if this should be used? -- store something from the import
364 print "Imager exiting\n";
365 }
366}
367
368# Load a filter plugin
369
370sub load_plugin {
371 my ($filename)=@_;
372 my $i;
373 my ($DSO_handle,$str)=DSO_open($filename);
374 if (!defined($DSO_handle)) { $Imager::ERRSTR="Couldn't load plugin '$filename'\n"; return undef; }
375 my %funcs=DSO_funclist($DSO_handle);
376 if ($DEBUG) { print "loading module $filename\n"; $i=0; for(keys %funcs) { printf(" %2d: %s\n",$i++,$_); } }
377 $i=0;
378 for(keys %funcs) { if ($filters{$_}) { $ERRSTR="filter '$_' already exists\n"; DSO_close($DSO_handle); return undef; } }
379
380 $DSOs{$filename}=[$DSO_handle,\%funcs];
381
382 for(keys %funcs) {
383 my $evstr="\$filters{'".$_."'}={".$funcs{$_}.'};';
384 $DEBUG && print "eval string:\n",$evstr,"\n";
385 eval $evstr;
386 print $@ if $@;
387 }
388 return 1;
389}
390
391# Unload a plugin
392
393sub unload_plugin {
394 my ($filename)=@_;
395
396 if (!$DSOs{$filename}) { $ERRSTR="plugin '$filename' not loaded."; return undef; }
397 my ($DSO_handle,$funcref)=@{$DSOs{$filename}};
398 for(keys %{$funcref}) {
399 delete $filters{$_};
400 $DEBUG && print "unloading: $_\n";
401 }
402 my $rc=DSO_close($DSO_handle);
403 if (!defined($rc)) { $ERRSTR="unable to unload plugin '$filename'."; return undef; }
404 return 1;
405}
406
64606cc7
TC
407# take the results of i_error() and make a message out of it
408sub _error_as_msg {
409 return join(": ", map $_->[0], i_errors());
410}
411
02d1d628
AMH
412#
413# Methods to be called on objects.
414#
415
416# Create a new Imager object takes very few parameters.
417# usually you call this method and then call open from
418# the resulting object
419
420sub new {
421 my $class = shift;
422 my $self ={};
423 my %hsh=@_;
424 bless $self,$class;
425 $self->{IMG}=undef; # Just to indicate what exists
426 $self->{ERRSTR}=undef; #
427 $self->{DEBUG}=$DEBUG;
428 $self->{DEBUG} && print "Initialized Imager\n";
429 if ($hsh{xsize} && $hsh{ysize}) { $self->img_set(%hsh); }
430 return $self;
431}
432
02d1d628
AMH
433# Copy an entire image with no changes
434# - if an image has magic the copy of it will not be magical
435
436sub copy {
437 my $self = shift;
438 unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
439
440 my $newcopy=Imager->new();
441 $newcopy->{IMG}=i_img_new();
442 i_copy($newcopy->{IMG},$self->{IMG});
443 return $newcopy;
444}
445
446# Paste a region
447
448sub paste {
449 my $self = shift;
450 unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
451 my %input=(left=>0, top=>0, @_);
452 unless($input{img}) {
453 $self->{ERRSTR}="no source image";
454 return;
455 }
456 $input{left}=0 if $input{left} <= 0;
457 $input{top}=0 if $input{top} <= 0;
458 my $src=$input{img};
459 my($r,$b)=i_img_info($src->{IMG});
460
461 i_copyto($self->{IMG}, $src->{IMG},
462 0,0, $r, $b, $input{left}, $input{top});
463 return $self; # What should go here??
464}
465
466# Crop an image - i.e. return a new image that is smaller
467
468sub crop {
469 my $self=shift;
470 unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
471 my %hsh=(left=>0,right=>0,top=>0,bottom=>0,@_);
472
473 my ($w,$h,$l,$r,$b,$t)=($self->getwidth(),$self->getheight(),
474 @hsh{qw(left right bottom top)});
475 $l=0 if not defined $l;
476 $t=0 if not defined $t;
299a3866
AMH
477
478 $r||=$l+delete $hsh{'width'} if defined $l and exists $hsh{'width'};
479 $b||=$t+delete $hsh{'height'} if defined $t and exists $hsh{'height'};
480 $l||=$r-delete $hsh{'width'} if defined $r and exists $hsh{'width'};
481 $t||=$b-delete $hsh{'height'} if defined $b and exists $hsh{'height'};
482
02d1d628
AMH
483 $r=$self->getwidth if not defined $r;
484 $b=$self->getheight if not defined $b;
485
486 ($l,$r)=($r,$l) if $l>$r;
487 ($t,$b)=($b,$t) if $t>$b;
488
299a3866
AMH
489 if ($hsh{'width'}) {
490 $l=int(0.5+($w-$hsh{'width'})/2);
491 $r=$l+$hsh{'width'};
02d1d628
AMH
492 } else {
493 $hsh{'width'}=$r-$l;
494 }
299a3866
AMH
495 if ($hsh{'height'}) {
496 $b=int(0.5+($h-$hsh{'height'})/2);
497 $t=$h+$hsh{'height'};
02d1d628
AMH
498 } else {
499 $hsh{'height'}=$b-$t;
500 }
501
502# print "l=$l, r=$r, h=$hsh{'width'}\n";
503# print "t=$t, b=$b, w=$hsh{'height'}\n";
504
299a3866 505 my $dst=Imager->new(xsize=>$hsh{'width'}, ysize=>$hsh{'height'}, channels=>$self->getchannels());
02d1d628
AMH
506
507 i_copyto($dst->{IMG},$self->{IMG},$l,$t,$r,$b,0,0);
508 return $dst;
509}
510
511# Sets an image to a certain size and channel number
512# if there was previously data in the image it is discarded
513
514sub img_set {
515 my $self=shift;
516
faa9b3e7 517 my %hsh=(xsize=>100, ysize=>100, channels=>3, bits=>8, type=>'direct', @_);
02d1d628
AMH
518
519 if (defined($self->{IMG})) {
faa9b3e7
TC
520 # let IIM_DESTROY destroy it, it's possible this image is
521 # referenced from a virtual image (like masked)
522 #i_img_destroy($self->{IMG});
02d1d628
AMH
523 undef($self->{IMG});
524 }
525
faa9b3e7
TC
526 if ($hsh{type} eq 'paletted' || $hsh{type} eq 'pseudo') {
527 $self->{IMG} = i_img_pal_new($hsh{xsize}, $hsh{ysize}, $hsh{channels},
528 $hsh{maxcolors} || 256);
529 }
530 elsif ($hsh{bits} == 16) {
531 $self->{IMG} = i_img_16_new($hsh{xsize}, $hsh{ysize}, $hsh{channels});
532 }
533 else {
534 $self->{IMG}=Imager::ImgRaw::new($hsh{'xsize'}, $hsh{'ysize'},
535 $hsh{'channels'});
536 }
537}
538
539# created a masked version of the current image
540sub masked {
541 my $self = shift;
542
543 $self or return undef;
544 my %opts = (left => 0,
545 top => 0,
546 right => $self->getwidth,
547 bottom => $self->getheight,
548 @_);
549 my $mask = $opts{mask} ? $opts{mask}{IMG} : undef;
550
551 my $result = Imager->new;
552 $result->{IMG} = i_img_masked_new($self->{IMG}, $mask, $opts{left},
553 $opts{top}, $opts{right} - $opts{left},
554 $opts{bottom} - $opts{top});
555 # keep references to the mask and base images so they don't
556 # disappear on us
557 $result->{DEPENDS} = [ $self->{IMG}, $mask ];
558
559 $result;
560}
561
562# convert an RGB image into a paletted image
563sub to_paletted {
564 my $self = shift;
565 my $opts;
566 if (@_ != 1 && !ref $_[0]) {
567 $opts = { @_ };
568 }
569 else {
570 $opts = shift;
571 }
572
573 my $result = Imager->new;
574 $result->{IMG} = i_img_to_pal($self->{IMG}, $opts);
575
576 #print "Type ", i_img_type($result->{IMG}), "\n";
577
578 $result->{IMG} or undef $result;
579
580 return $result;
581}
582
583# convert a paletted (or any image) to an 8-bit/channel RGB images
584sub to_rgb8 {
585 my $self = shift;
586 my $result;
587
588 if ($self->{IMG}) {
589 $result = Imager->new;
590 $result->{IMG} = i_img_to_rgb($self->{IMG})
591 or undef $result;
592 }
593
594 return $result;
595}
596
597sub addcolors {
598 my $self = shift;
599 my %opts = (colors=>[], @_);
600
601 @{$opts{colors}} or return undef;
602
603 $self->{IMG} and i_addcolors($self->{IMG}, @{$opts{colors}});
604}
605
606sub setcolors {
607 my $self = shift;
608 my %opts = (start=>0, colors=>[], @_);
609 @{$opts{colors}} or return undef;
610
611 $self->{IMG} and i_setcolors($self->{IMG}, $opts{start}, @{$opts{colors}});
612}
613
614sub getcolors {
615 my $self = shift;
616 my %opts = @_;
617 if (!exists $opts{start} && !exists $opts{count}) {
618 # get them all
619 $opts{start} = 0;
620 $opts{count} = $self->colorcount;
621 }
622 elsif (!exists $opts{count}) {
623 $opts{count} = 1;
624 }
625 elsif (!exists $opts{start}) {
626 $opts{start} = 0;
627 }
628
629 $self->{IMG} and
630 return i_getcolors($self->{IMG}, $opts{start}, $opts{count});
631}
632
633sub colorcount {
634 i_colorcount($_[0]{IMG});
635}
636
637sub maxcolors {
638 i_maxcolors($_[0]{IMG});
639}
640
641sub findcolor {
642 my $self = shift;
643 my %opts = @_;
644 $opts{color} or return undef;
645
646 $self->{IMG} and i_findcolor($self->{IMG}, $opts{color});
647}
648
649sub bits {
650 my $self = shift;
651 $self->{IMG} and i_img_bits($self->{IMG});
652}
653
654sub type {
655 my $self = shift;
656 if ($self->{IMG}) {
657 return i_img_type($self->{IMG}) ? "paletted" : "direct";
658 }
659}
660
661sub virtual {
662 my $self = shift;
663 $self->{IMG} and i_img_virtual($self->{IMG});
664}
665
666sub tags {
667 my ($self, %opts) = @_;
668
669 $self->{IMG} or return;
670
671 if (defined $opts{name}) {
672 my @result;
673 my $start = 0;
674 my $found;
675 while (defined($found = i_tags_find($self->{IMG}, $opts{name}, $start))) {
676 push @result, (i_tags_get($self->{IMG}, $found))[1];
677 $start = $found+1;
678 }
679 return wantarray ? @result : $result[0];
680 }
681 elsif (defined $opts{code}) {
682 my @result;
683 my $start = 0;
684 my $found;
685 while (defined($found = i_tags_findn($self->{IMG}, $opts{code}, $start))) {
686 push @result, (i_tags_get($self->{IMG}, $found))[1];
687 $start = $found+1;
688 }
689 return @result;
690 }
691 else {
692 if (wantarray) {
693 return map { [ i_tags_get($self->{IMG}, $_) ] } 0.. i_tags_count($self->{IMG})-1;
694 }
695 else {
696 return i_tags_count($self->{IMG});
697 }
698 }
699}
700
701sub addtag {
702 my $self = shift;
703 my %opts = @_;
704
705 return -1 unless $self->{IMG};
706 if ($opts{name}) {
707 if (defined $opts{value}) {
708 if ($opts{value} =~ /^\d+$/) {
709 # add as a number
710 return i_tags_addn($self->{IMG}, $opts{name}, 0, $opts{value});
711 }
712 else {
713 return i_tags_add($self->{IMG}, $opts{name}, 0, $opts{value}, 0);
714 }
715 }
716 elsif (defined $opts{data}) {
717 # force addition as a string
718 return i_tags_add($self->{IMG}, $opts{name}, 0, $opts{data}, 0);
719 }
720 else {
721 $self->{ERRSTR} = "No value supplied";
722 return undef;
723 }
724 }
725 elsif ($opts{code}) {
726 if (defined $opts{value}) {
727 if ($opts{value} =~ /^\d+$/) {
728 # add as a number
729 return i_tags_addn($self->{IMG}, $opts{code}, 0, $opts{value});
730 }
731 else {
732 return i_tags_add($self->{IMG}, $opts{code}, 0, $opts{value}, 0);
733 }
734 }
735 elsif (defined $opts{data}) {
736 # force addition as a string
737 return i_tags_add($self->{IMG}, $opts{code}, 0, $opts{data}, 0);
738 }
739 else {
740 $self->{ERRSTR} = "No value supplied";
741 return undef;
742 }
743 }
744 else {
745 return undef;
746 }
747}
748
749sub deltag {
750 my $self = shift;
751 my %opts = @_;
752
753 return 0 unless $self->{IMG};
754
755 if (defined $opts{index}) {
756 return i_tags_delete($self->{IMG}, $opts{index});
757 }
758 elsif (defined $opts{name}) {
759 return i_tags_delbyname($self->{IMG}, $opts{name});
760 }
761 elsif (defined $opts{code}) {
762 return i_tags_delbycode($self->{IMG}, $opts{code});
763 }
764 else {
765 $self->{ERRSTR} = "Need to supply index, name, or code parameter";
766 return 0;
767 }
02d1d628
AMH
768}
769
770# Read an image from file
771
772sub read {
773 my $self = shift;
774 my %input=@_;
775 my ($fh, $fd, $IO);
776
777 if (defined($self->{IMG})) {
faa9b3e7
TC
778 # let IIM_DESTROY do the destruction, since the image may be
779 # referenced from elsewhere
780 #i_img_destroy($self->{IMG});
02d1d628
AMH
781 undef($self->{IMG});
782 }
783
895dbd34
AMH
784 if (!$input{fd} and !$input{file} and !$input{data}) {
785 $self->{ERRSTR}='no file, fd or data parameter'; return undef;
786 }
02d1d628
AMH
787 if ($input{file}) {
788 $fh = new IO::File($input{file},"r");
895dbd34
AMH
789 if (!defined $fh) {
790 $self->{ERRSTR}='Could not open file'; return undef;
791 }
02d1d628
AMH
792 binmode($fh);
793 $fd = $fh->fileno();
794 }
895dbd34
AMH
795 if ($input{fd}) {
796 $fd=$input{fd};
797 }
02d1d628
AMH
798
799 # FIXME: Find the format here if not specified
800 # yes the code isn't here yet - next week maybe?
dd55acc8
AMH
801 # Next week? Are you high or something? That comment
802 # has been there for half a year dude.
cf692b64 803 # Look, i just work here, ok?
02d1d628 804
895dbd34
AMH
805 if (!$input{type} and $input{file}) {
806 $input{type}=$FORMATGUESS->($input{file});
807 }
808 if (!$formats{$input{type}}) {
809 $self->{ERRSTR}='format not supported'; return undef;
810 }
02d1d628 811
1ec86afa 812 my %iolready=(jpeg=>1, png=>1, tiff=>1, pnm=>1, raw=>1, bmp=>1, tga=>1);
02d1d628
AMH
813
814 if ($iolready{$input{type}}) {
815 # Setup data source
895dbd34 816 $IO = io_new_fd($fd); # sort of simple for now eh?
02d1d628
AMH
817
818 if ( $input{type} eq 'jpeg' ) {
819 ($self->{IMG},$self->{IPTCRAW})=i_readjpeg_wiol( $IO );
895dbd34
AMH
820 if ( !defined($self->{IMG}) ) {
821 $self->{ERRSTR}='unable to read jpeg image'; return undef;
822 }
02d1d628
AMH
823 $self->{DEBUG} && print "loading a jpeg file\n";
824 return $self;
825 }
826
827 if ( $input{type} eq 'tiff' ) {
828 $self->{IMG}=i_readtiff_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed
895dbd34
AMH
829 if ( !defined($self->{IMG}) ) {
830 $self->{ERRSTR}='unable to read tiff image'; return undef;
831 }
02d1d628
AMH
832 $self->{DEBUG} && print "loading a tiff file\n";
833 return $self;
834 }
835
836 if ( $input{type} eq 'pnm' ) {
837 $self->{IMG}=i_readpnm_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed
895dbd34
AMH
838 if ( !defined($self->{IMG}) ) {
839 $self->{ERRSTR}='unable to read pnm image: '._error_as_msg(); return undef;
840 }
02d1d628
AMH
841 $self->{DEBUG} && print "loading a pnm file\n";
842 return $self;
843 }
844
790923a4
AMH
845 if ( $input{type} eq 'png' ) {
846 $self->{IMG}=i_readpng_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed
847 if ( !defined($self->{IMG}) ) {
848 $self->{ERRSTR}='unable to read png image';
849 return undef;
850 }
851 $self->{DEBUG} && print "loading a png file\n";
852 }
853
705fd961
TC
854 if ( $input{type} eq 'bmp' ) {
855 $self->{IMG}=i_readbmp_wiol( $IO );
856 if ( !defined($self->{IMG}) ) {
857 $self->{ERRSTR}='unable to read bmp image';
858 return undef;
859 }
860 $self->{DEBUG} && print "loading a bmp file\n";
861 }
862
1ec86afa
AMH
863 if ( $input{type} eq 'tga' ) {
864 $self->{IMG}=i_readtga_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed
865 if ( !defined($self->{IMG}) ) {
866 $self->{ERRSTR}=$self->_error_as_msg();
867# $self->{ERRSTR}='unable to read tga image';
868 return undef;
869 }
870 $self->{DEBUG} && print "loading a tga file\n";
871 }
872
895dbd34
AMH
873 if ( $input{type} eq 'raw' ) {
874 my %params=(datachannels=>3,storechannels=>3,interleave=>1,%input);
02d1d628 875
895dbd34
AMH
876 if ( !($params{xsize} && $params{ysize}) ) {
877 $self->{ERRSTR}='missing xsize or ysize parameter for raw';
878 return undef;
879 }
02d1d628 880
895dbd34
AMH
881 $self->{IMG} = i_readraw_wiol( $IO,
882 $params{xsize},
883 $params{ysize},
884 $params{datachannels},
885 $params{storechannels},
886 $params{interleave});
887 if ( !defined($self->{IMG}) ) {
888 $self->{ERRSTR}='unable to read raw image';
889 return undef;
890 }
891 $self->{DEBUG} && print "loading a raw file\n";
892 }
790923a4 893
895dbd34 894 } else {
02d1d628 895
895dbd34 896 # Old code for reference while changing the new stuff
02d1d628 897
895dbd34
AMH
898 if (!$input{type} and $input{file}) {
899 $input{type}=$FORMATGUESS->($input{file});
900 }
901
902 if (!$input{type}) {
903 $self->{ERRSTR}='type parameter missing and not possible to guess from extension'; return undef;
904 }
02d1d628 905
895dbd34
AMH
906 if (!$formats{$input{type}}) {
907 $self->{ERRSTR}='format not supported';
a59ffd27
TC
908 return undef;
909 }
895dbd34
AMH
910
911 if ($input{file}) {
912 $fh = new IO::File($input{file},"r");
913 if (!defined $fh) {
914 $self->{ERRSTR}='Could not open file';
915 return undef;
a59ffd27 916 }
895dbd34
AMH
917 binmode($fh);
918 $fd = $fh->fileno();
a59ffd27 919 }
895dbd34
AMH
920
921 if ($input{fd}) {
922 $fd=$input{fd};
923 }
924
925 if ( $input{type} eq 'gif' ) {
926 my $colors;
927 if ($input{colors} && !ref($input{colors})) {
928 # must be a reference to a scalar that accepts the colour map
929 $self->{ERRSTR} = "option 'colors' must be a scalar reference";
930 return undef;
a59ffd27 931 }
895dbd34
AMH
932 if (exists $input{data}) {
933 if ($input{colors}) {
934 ($self->{IMG}, $colors) = i_readgif_scalar($input{data});
935 } else {
936 $self->{IMG}=i_readgif_scalar($input{data});
937 }
938 } else {
939 if ($input{colors}) {
940 ($self->{IMG}, $colors) = i_readgif( $fd );
941 } else {
942 $self->{IMG} = i_readgif( $fd )
943 }
a59ffd27 944 }
895dbd34
AMH
945 if ($colors) {
946 # we may or may not change i_readgif to return blessed objects...
947 ${ $input{colors} } = [ map { NC(@$_) } @$colors ];
948 }
949 if ( !defined($self->{IMG}) ) {
950 $self->{ERRSTR}= 'reading GIF:'._error_as_msg();
951 return undef;
952 }
953 $self->{DEBUG} && print "loading a gif file\n";
dd55acc8 954 }
02d1d628
AMH
955 }
956 return $self;
02d1d628
AMH
957}
958
02d1d628 959# Write an image to file
02d1d628
AMH
960sub write {
961 my $self = shift;
4c2d6970
TC
962 my %input=(jpegquality=>75, gifquant=>'mc', lmdither=>6.0, lmfixed=>[],
963 fax_fine=>1, @_);
02d1d628
AMH
964 my ($fh, $rc, $fd, $IO);
965
1ec86afa 966 my %iolready=( tiff=>1, raw=>1, png=>1, pnm=>1, bmp=>1, jpeg=>1, tga=>1 ); # this will be SO MUCH BETTER once they are all in there
02d1d628
AMH
967
968 unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
969
970 if (!$input{file} and !$input{'fd'} and !$input{'data'}) { $self->{ERRSTR}='file/fd/data parameter missing'; return undef; }
4c2d6970 971 if (!$input{type} and $input{file}) { $input{type}=$FORMATGUESS->($input{file}); }
02d1d628
AMH
972 if (!$input{type}) { $self->{ERRSTR}='type parameter missing and not possible to guess from extension'; return undef; }
973
974 if (!$formats{$input{type}}) { $self->{ERRSTR}='format not supported'; return undef; }
975
976 if (exists $input{'fd'}) {
977 $fd=$input{'fd'};
978 } elsif (exists $input{'data'}) {
979 $IO = Imager::io_new_bufchain();
980 } else {
981 $fh = new IO::File($input{file},"w+");
982 if (!defined $fh) { $self->{ERRSTR}='Could not open file'; return undef; }
faa9b3e7 983 binmode($fh) or die;
02d1d628
AMH
984 $fd = $fh->fileno();
985 }
986
02d1d628 987 if ($iolready{$input{type}}) {
4c2d6970 988 if (defined $fd) {
02d1d628
AMH
989 $IO = io_new_fd($fd);
990 }
991
992 if ($input{type} eq 'tiff') {
4c2d6970
TC
993 if (defined $input{class} && $input{class} eq 'fax') {
994 if (!i_writetiff_wiol_faxable($self->{IMG}, $IO, $input{fax_fine})) {
d2dfdcc9
TC
995 $self->{ERRSTR}='Could not write to buffer';
996 return undef;
997 }
04418ecc 998 } else {
930c67c8
AMH
999 if (!i_writetiff_wiol($self->{IMG}, $IO)) {
1000 $self->{ERRSTR}='Could not write to buffer';
1001 return undef;
d2dfdcc9
TC
1002 }
1003 }
04418ecc 1004 } elsif ( $input{type} eq 'pnm' ) {
04418ecc
AMH
1005 if ( ! i_writeppm_wiol($self->{IMG},$IO) ) {
1006 $self->{ERRSTR}='unable to write pnm image';
1007 return undef;
1008 }
1009 $self->{DEBUG} && print "writing a pnm file\n";
1010 } elsif ( $input{type} eq 'raw' ) {
ec9b9c3e 1011 if ( !i_writeraw_wiol($self->{IMG},$IO) ) {
04418ecc
AMH
1012 $self->{ERRSTR}='unable to write raw image';
1013 return undef;
1014 }
1015 $self->{DEBUG} && print "writing a raw file\n";
ec9b9c3e
AMH
1016 } elsif ( $input{type} eq 'png' ) {
1017 if ( !i_writepng_wiol($self->{IMG}, $IO) ) {
1018 $self->{ERRSTR}='unable to write png image';
1019 return undef;
1020 }
1021 $self->{DEBUG} && print "writing a png file\n";
cf692b64
TC
1022 } elsif ( $input{type} eq 'jpeg' ) {
1023 if ( !i_writejpeg_wiol($self->{IMG}, $IO, $input{jpegquality})) {
f873cb01 1024 $self->{ERRSTR} = $self->_error_as_msg();
cf692b64
TC
1025 return undef;
1026 }
1027 $self->{DEBUG} && print "writing a jpeg file\n";
705fd961
TC
1028 } elsif ( $input{type} eq 'bmp' ) {
1029 if ( !i_writebmp_wiol($self->{IMG}, $IO) ) {
1030 $self->{ERRSTR}='unable to write bmp image';
1031 return undef;
1032 }
1033 $self->{DEBUG} && print "writing a bmp file\n";
1ec86afa
AMH
1034 } elsif ( $input{type} eq 'tga' ) {
1035 if ( !i_writetga_wiol($self->{IMG}, $IO) ) {
1036 $self->{ERRSTR}=$self->_error_as_msg();
1037# $self->{ERRSTR}='unable to write tga image';
1038 return undef;
1039 }
1040 $self->{DEBUG} && print "writing a tga file\n";
02d1d628
AMH
1041 }
1042
930c67c8
AMH
1043 if (exists $input{'data'}) {
1044 my $data = io_slurp($IO);
1045 if (!$data) {
1046 $self->{ERRSTR}='Could not slurp from buffer';
1047 return undef;
1048 }
1049 ${$input{data}} = $data;
1050 }
02d1d628
AMH
1051 return $self;
1052 } else {
02d1d628
AMH
1053 if ( $input{type} eq 'gif' ) {
1054 if (not $input{gifplanes}) {
1055 my $gp;
1056 my $count=i_count_colors($self->{IMG}, 256);
1057 $gp=8 if $count == -1;
1058 $gp=1 if not $gp and $count <= 2;
1059 $gp=2 if not $gp and $count <= 4;
1060 $gp=3 if not $gp and $count <= 8;
1061 $gp=4 if not $gp and $count <= 16;
1062 $gp=5 if not $gp and $count <= 32;
1063 $gp=6 if not $gp and $count <= 64;
1064 $gp=7 if not $gp and $count <= 128;
1065 $input{gifplanes} = $gp || 8;
1066 }
1067
1068 if ($input{gifplanes}>8) {
1069 $input{gifplanes}=8;
1070 }
1071 if ($input{gifquant} eq 'gen' || $input{callback}) {
1072
1073
1074 if ($input{gifquant} eq 'lm') {
1075
1076 $input{make_colors} = 'addi';
1077 $input{translate} = 'perturb';
1078 $input{perturb} = $input{lmdither};
1079 } elsif ($input{gifquant} eq 'gen') {
1080 # just pass options through
1081 } else {
1082 $input{make_colors} = 'webmap'; # ignored
1083 $input{translate} = 'giflib';
1084 }
1085
1086 if ($input{callback}) {
1087 defined $input{maxbuffer} or $input{maxbuffer} = -1;
1088 $rc = i_writegif_callback($input{callback}, $input{maxbuffer},
1089 \%input, $self->{IMG});
1090 } else {
1091 $rc = i_writegif_gen($fd, \%input, $self->{IMG});
1092 }
1093
02d1d628
AMH
1094 } elsif ($input{gifquant} eq 'lm') {
1095 $rc=i_writegif($self->{IMG},$fd,$input{gifplanes},$input{lmdither},$input{lmfixed});
1096 } else {
1097 $rc=i_writegifmc($self->{IMG},$fd,$input{gifplanes});
1098 }
1099 if ( !defined($rc) ) {
3827fae0 1100 $self->{ERRSTR} = "Writing GIF file: "._error_as_msg(); return undef;
02d1d628
AMH
1101 }
1102 $self->{DEBUG} && print "writing a gif file\n";
1103
02d1d628 1104 }
02d1d628
AMH
1105 }
1106 return $self;
1107}
1108
1109sub write_multi {
1110 my ($class, $opts, @images) = @_;
1111
1112 if ($opts->{type} eq 'gif') {
ed88b092
TC
1113 my $gif_delays = $opts->{gif_delays};
1114 local $opts->{gif_delays} = $gif_delays;
1115 unless (ref $opts->{gif_delays}) {
1116 # assume the caller wants the same delay for each frame
1117 $opts->{gif_delays} = [ ($gif_delays) x @images ];
1118 }
02d1d628
AMH
1119 # translate to ImgRaw
1120 if (grep !UNIVERSAL::isa($_, 'Imager') || !$_->{IMG}, @images) {
1121 $ERRSTR = "Usage: Imager->write_multi({ options }, @images)";
1122 return 0;
1123 }
1124 my @work = map $_->{IMG}, @images;
1125 if ($opts->{callback}) {
1126 # Note: you may need to fix giflib for this one to work
1127 my $maxbuffer = $opts->{maxbuffer};
1128 defined $maxbuffer or $maxbuffer = -1; # max by default
1129 return i_writegif_callback($opts->{callback}, $maxbuffer,
1130 $opts, @work);
1131 }
1132 if ($opts->{fd}) {
1133 return i_writegif_gen($opts->{fd}, $opts, @work);
1134 }
1135 else {
1136 my $fh = IO::File->new($opts->{file}, "w+");
1137 unless ($fh) {
1138 $ERRSTR = "Error creating $opts->{file}: $!";
1139 return 0;
1140 }
1141 binmode($fh);
1142 return i_writegif_gen(fileno($fh), $opts, @work);
1143 }
1144 }
1145 else {
1146 $ERRSTR = "Sorry, write_multi doesn't support $opts->{type} yet";
1147 return 0;
1148 }
1149}
1150
faa9b3e7
TC
1151# read multiple images from a file
1152sub read_multi {
1153 my ($class, %opts) = @_;
1154
1155 if ($opts{file} && !exists $opts{type}) {
1156 # guess the type
1157 my $type = $FORMATGUESS->($opts{file});
1158 $opts{type} = $type;
1159 }
1160 unless ($opts{type}) {
1161 $ERRSTR = "No type parameter supplied and it couldn't be guessed";
1162 return;
1163 }
1164 my $fd;
1165 my $file;
1166 if ($opts{file}) {
1167 $file = IO::File->new($opts{file}, "r");
1168 unless ($file) {
1169 $ERRSTR = "Could not open file $opts{file}: $!";
1170 return;
1171 }
1172 binmode $file;
1173 $fd = fileno($file);
1174 }
1175 elsif ($opts{fh}) {
1176 $fd = fileno($opts{fh});
1177 unless ($fd) {
1178 $ERRSTR = "File handle specified with fh option not open";
1179 return;
1180 }
1181 }
1182 elsif ($opts{fd}) {
1183 $fd = $opts{fd};
1184 }
1185 elsif ($opts{callback} || $opts{data}) {
1186 # don't fail here
1187 }
1188 else {
1189 $ERRSTR = "You need to specify one of file, fd, fh, callback or data";
1190 return;
1191 }
1192
1193 if ($opts{type} eq 'gif') {
1194 my @imgs;
1195 if ($fd) {
1196 @imgs = i_readgif_multi($fd);
1197 }
1198 else {
1199 if (Imager::i_giflib_version() < 4.0) {
1200 $ERRSTR = "giflib3.x does not support callbacks";
1201 return;
1202 }
1203 if ($opts{callback}) {
1204 @imgs = i_readgif_multi_callback($opts{callback})
1205 }
1206 else {
1207 @imgs = i_readgif_multi_scalar($opts{data});
1208 }
1209 }
1210 if (@imgs) {
1211 return map {
1212 bless { IMG=>$_, DEBUG=>$DEBUG, ERRSTR=>undef }, 'Imager'
1213 } @imgs;
1214 }
1215 else {
1216 $ERRSTR = _error_as_msg();
1217 return;
1218 }
1219 }
1220
1221 $ERRSTR = "Cannot read multiple images from $opts{type} files";
1222 return;
1223}
1224
02d1d628
AMH
1225# Destroy an Imager object
1226
1227sub DESTROY {
1228 my $self=shift;
1229 # delete $instances{$self};
1230 if (defined($self->{IMG})) {
faa9b3e7
TC
1231 # the following is now handled by the XS DESTROY method for
1232 # Imager::ImgRaw object
1233 # Re-enabling this will break virtual images
1234 # tested for in t/t020masked.t
1235 # i_img_destroy($self->{IMG});
02d1d628
AMH
1236 undef($self->{IMG});
1237 } else {
1238# print "Destroy Called on an empty image!\n"; # why did I put this here??
1239 }
1240}
1241
1242# Perform an inplace filter of an image
1243# that is the image will be overwritten with the data
1244
1245sub filter {
1246 my $self=shift;
1247 my %input=@_;
1248 my %hsh;
1249 unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1250
1251 if (!$input{type}) { $self->{ERRSTR}='type parameter missing'; return undef; }
1252
1253 if ( (grep { $_ eq $input{type} } keys %filters) != 1) {
1254 $self->{ERRSTR}='type parameter not matching any filter'; return undef;
1255 }
1256
6607600c
TC
1257 if ($filters{$input{type}}{names}) {
1258 my $names = $filters{$input{type}}{names};
1259 for my $name (keys %$names) {
1260 if (defined $input{$name} && exists $names->{$name}{$input{$name}}) {
1261 $input{$name} = $names->{$name}{$input{$name}};
1262 }
1263 }
1264 }
02d1d628
AMH
1265 if (defined($filters{$input{type}}{defaults})) {
1266 %hsh=('image',$self->{IMG},%{$filters{$input{type}}{defaults}},%input);
1267 } else {
1268 %hsh=('image',$self->{IMG},%input);
1269 }
1270
1271 my @cs=@{$filters{$input{type}}{callseq}};
1272
1273 for(@cs) {
1274 if (!defined($hsh{$_})) {
1275 $self->{ERRSTR}="missing parameter '$_' for filter ".$input{type}; return undef;
1276 }
1277 }
1278
1279 &{$filters{$input{type}}{callsub}}(%hsh);
1280
1281 my @b=keys %hsh;
1282
1283 $self->{DEBUG} && print "callseq is: @cs\n";
1284 $self->{DEBUG} && print "matching callseq is: @b\n";
1285
1286 return $self;
1287}
1288
1289# Scale an image to requested size and return the scaled version
1290
1291sub scale {
1292 my $self=shift;
1293 my %opts=(scalefactor=>0.5,type=>'max',qtype=>'normal',@_);
1294 my $img = Imager->new();
1295 my $tmp = Imager->new();
1296
1297 unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1298
1299 if ($opts{xpixels} and $opts{ypixels} and $opts{type}) {
1300 my ($xpix,$ypix)=( $opts{xpixels}/$self->getwidth() , $opts{ypixels}/$self->getheight() );
1301 if ($opts{type} eq 'min') { $opts{scalefactor}=min($xpix,$ypix); }
1302 if ($opts{type} eq 'max') { $opts{scalefactor}=max($xpix,$ypix); }
1303 } elsif ($opts{xpixels}) { $opts{scalefactor}=$opts{xpixels}/$self->getwidth(); }
1304 elsif ($opts{ypixels}) { $opts{scalefactor}=$opts{ypixels}/$self->getheight(); }
1305
1306 if ($opts{qtype} eq 'normal') {
1307 $tmp->{IMG}=i_scaleaxis($self->{IMG},$opts{scalefactor},0);
1308 if ( !defined($tmp->{IMG}) ) { $self->{ERRSTR}='unable to scale image'; return undef; }
1309 $img->{IMG}=i_scaleaxis($tmp->{IMG},$opts{scalefactor},1);
1310 if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='unable to scale image'; return undef; }
1311 return $img;
1312 }
1313 if ($opts{'qtype'} eq 'preview') {
1314 $img->{IMG}=i_scale_nn($self->{IMG},$opts{'scalefactor'},$opts{'scalefactor'});
1315 if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='unable to scale image'; return undef; }
1316 return $img;
1317 }
1318 $self->{ERRSTR}='scale: invalid value for qtype'; return undef;
1319}
1320
1321# Scales only along the X axis
1322
1323sub scaleX {
1324 my $self=shift;
1325 my %opts=(scalefactor=>0.5,@_);
1326
1327 unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1328
1329 my $img = Imager->new();
1330
1331 if ($opts{pixels}) { $opts{scalefactor}=$opts{pixels}/$self->getwidth(); }
1332
1333 unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1334 $img->{IMG}=i_scaleaxis($self->{IMG},$opts{scalefactor},0);
1335
1336 if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='unable to scale image'; return undef; }
1337 return $img;
1338}
1339
1340# Scales only along the Y axis
1341
1342sub scaleY {
1343 my $self=shift;
1344 my %opts=(scalefactor=>0.5,@_);
1345
1346 unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1347
1348 my $img = Imager->new();
1349
1350 if ($opts{pixels}) { $opts{scalefactor}=$opts{pixels}/$self->getheight(); }
1351
1352 unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1353 $img->{IMG}=i_scaleaxis($self->{IMG},$opts{scalefactor},1);
1354
1355 if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='unable to scale image'; return undef; }
1356 return $img;
1357}
1358
1359
1360# Transform returns a spatial transformation of the input image
1361# this moves pixels to a new location in the returned image.
1362# NOTE - should make a utility function to check transforms for
1363# stack overruns
1364
1365sub transform {
1366 my $self=shift;
1367 unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1368 my %opts=@_;
1369 my (@op,@ropx,@ropy,$iop,$or,@parm,$expr,@xt,@yt,@pt,$numre);
1370
1371# print Dumper(\%opts);
1372# xopcopdes
1373
1374 if ( $opts{'xexpr'} and $opts{'yexpr'} ) {
1375 if (!$I2P) {
1376 eval ("use Affix::Infix2Postfix;");
1377 print $@;
1378 if ( $@ ) {
1379 $self->{ERRSTR}='transform: expr given and Affix::Infix2Postfix is not avaliable.';
1380 return undef;
1381 }
1382 $I2P=Affix::Infix2Postfix->new('ops'=>[{op=>'+',trans=>'Add'},
1383 {op=>'-',trans=>'Sub'},
1384 {op=>'*',trans=>'Mult'},
1385 {op=>'/',trans=>'Div'},
1386 {op=>'-',type=>'unary',trans=>'u-'},
1387 {op=>'**'},
1388 {op=>'func',type=>'unary'}],
1389 'grouping'=>[qw( \( \) )],
1390 'func'=>[qw( sin cos )],
1391 'vars'=>[qw( x y )]
1392 );
1393 }
1394
1395 @xt=$I2P->translate($opts{'xexpr'});
1396 @yt=$I2P->translate($opts{'yexpr'});
1397
1398 $numre=$I2P->{'numre'};
1399 @pt=(0,0);
1400
1401 for(@xt) { if (/$numre/) { push(@pt,$_); push(@{$opts{'xopcodes'}},'Parm',$#pt); } else { push(@{$opts{'xopcodes'}},$_); } }
1402 for(@yt) { if (/$numre/) { push(@pt,$_); push(@{$opts{'yopcodes'}},'Parm',$#pt); } else { push(@{$opts{'yopcodes'}},$_); } }
1403 @{$opts{'parm'}}=@pt;
1404 }
1405
1406# print Dumper(\%opts);
1407
1408 if ( !exists $opts{'xopcodes'} or @{$opts{'xopcodes'}}==0) {
1409 $self->{ERRSTR}='transform: no xopcodes given.';
1410 return undef;
1411 }
1412
1413 @op=@{$opts{'xopcodes'}};
1414 for $iop (@op) {
1415 if (!defined ($OPCODES{$iop}) and ($iop !~ /^\d+$/) ) {
1416 $self->{ERRSTR}="transform: illegal opcode '$_'.";
1417 return undef;
1418 }
1419 push(@ropx,(exists $OPCODES{$iop}) ? @{$OPCODES{$iop}} : $iop );
1420 }
1421
1422
1423# yopcopdes
1424
1425 if ( !exists $opts{'yopcodes'} or @{$opts{'yopcodes'}}==0) {
1426 $self->{ERRSTR}='transform: no yopcodes given.';
1427 return undef;
1428 }
1429
1430 @op=@{$opts{'yopcodes'}};
1431 for $iop (@op) {
1432 if (!defined ($OPCODES{$iop}) and ($iop !~ /^\d+$/) ) {
1433 $self->{ERRSTR}="transform: illegal opcode '$_'.";
1434 return undef;
1435 }
1436 push(@ropy,(exists $OPCODES{$iop}) ? @{$OPCODES{$iop}} : $iop );
1437 }
1438
1439#parameters
1440
1441 if ( !exists $opts{'parm'}) {
1442 $self->{ERRSTR}='transform: no parameter arg given.';
1443 return undef;
1444 }
1445
1446# print Dumper(\@ropx);
1447# print Dumper(\@ropy);
1448# print Dumper(\@ropy);
1449
1450 my $img = Imager->new();
1451 $img->{IMG}=i_transform($self->{IMG},\@ropx,\@ropy,$opts{'parm'});
1452 if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='transform: failed'; return undef; }
1453 return $img;
1454}
1455
1456
1457{
1458 my $got_expr;
1459 sub transform2 {
1460 my ($opts, @imgs) = @_;
1461
1462 if (!$got_expr) {
1463 # this is fairly big, delay loading it
1464 eval "use Imager::Expr";
1465 die $@ if $@;
1466 ++$got_expr;
1467 }
1468
1469 $opts->{variables} = [ qw(x y) ];
1470 my ($width, $height) = @{$opts}{qw(width height)};
1471 if (@imgs) {
1472 $width ||= $imgs[0]->getwidth();
1473 $height ||= $imgs[0]->getheight();
1474 my $img_num = 1;
1475 for my $img (@imgs) {
1476 $opts->{constants}{"w$img_num"} = $img->getwidth();
1477 $opts->{constants}{"h$img_num"} = $img->getheight();
1478 $opts->{constants}{"cx$img_num"} = $img->getwidth()/2;
1479 $opts->{constants}{"cy$img_num"} = $img->getheight()/2;
1480 ++$img_num;
1481 }
1482 }
1483 if ($width) {
1484 $opts->{constants}{w} = $width;
1485 $opts->{constants}{cx} = $width/2;
1486 }
1487 else {
1488 $Imager::ERRSTR = "No width supplied";
1489 return;
1490 }
1491 if ($height) {
1492 $opts->{constants}{h} = $height;
1493 $opts->{constants}{cy} = $height/2;
1494 }
1495 else {
1496 $Imager::ERRSTR = "No height supplied";
1497 return;
1498 }
1499 my $code = Imager::Expr->new($opts);
1500 if (!$code) {
1501 $Imager::ERRSTR = Imager::Expr::error();
1502 return;
1503 }
1504
1505 my $img = Imager->new();
1506 $img->{IMG} = i_transform2($opts->{width}, $opts->{height}, $code->code(),
1507 $code->nregs(), $code->cregs(),
1508 [ map { $_->{IMG} } @imgs ]);
1509 if (!defined $img->{IMG}) {
1510 $Imager::ERRSTR = "transform2 failed";
1511 return;
1512 }
1513
1514 return $img;
1515 }
1516}
1517
02d1d628
AMH
1518sub rubthrough {
1519 my $self=shift;
1520 my %opts=(tx=>0,ty=>0,@_);
1521
1522 unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1523 unless ($opts{src} && $opts{src}->{IMG}) { $self->{ERRSTR}='empty input image for source'; return undef; }
1524
faa9b3e7
TC
1525 unless (i_rubthru($self->{IMG}, $opts{src}->{IMG}, $opts{tx},$opts{ty})) {
1526 $self->{ERRSTR} = $self->_error_as_msg();
1527 return undef;
1528 }
02d1d628
AMH
1529 return $self;
1530}
1531
1532
142c26ff
AMH
1533sub flip {
1534 my $self = shift;
1535 my %opts = @_;
9191e525 1536 my %xlate = (h=>0, v=>1, hv=>2, vh=>2);
142c26ff
AMH
1537 my $dir;
1538 return () unless defined $opts{'dir'} and defined $xlate{$opts{'dir'}};
1539 $dir = $xlate{$opts{'dir'}};
1540 return $self if i_flipxy($self->{IMG}, $dir);
1541 return ();
1542}
1543
faa9b3e7
TC
1544sub rotate {
1545 my $self = shift;
1546 my %opts = @_;
1547 if (defined $opts{right}) {
1548 my $degrees = $opts{right};
1549 if ($degrees < 0) {
1550 $degrees += 360 * int(((-$degrees)+360)/360);
1551 }
1552 $degrees = $degrees % 360;
1553 if ($degrees == 0) {
1554 return $self->copy();
1555 }
1556 elsif ($degrees == 90 || $degrees == 180 || $degrees == 270) {
1557 my $result = Imager->new();
1558 if ($result->{IMG} = i_rotate90($self->{IMG}, $degrees)) {
1559 return $result;
1560 }
1561 else {
1562 $self->{ERRSTR} = $self->_error_as_msg();
1563 return undef;
1564 }
1565 }
1566 else {
1567 $self->{ERRSTR} = "Parameter 'right' must be a multiple of 90 degrees";
1568 return undef;
1569 }
1570 }
1571 elsif (defined $opts{radians} || defined $opts{degrees}) {
1572 my $amount = $opts{radians} || $opts{degrees} * 3.1415926535 / 180;
1573
1574 my $result = Imager->new;
1575 if ($result->{IMG} = i_rotate_exact($self->{IMG}, $amount)) {
1576 return $result;
1577 }
1578 else {
1579 $self->{ERRSTR} = $self->_error_as_msg();
1580 return undef;
1581 }
1582 }
1583 else {
1584 $self->{ERRSTR} = "Only the 'right' parameter is available";
1585 return undef;
1586 }
1587}
1588
1589sub matrix_transform {
1590 my $self = shift;
1591 my %opts = @_;
1592
1593 if ($opts{matrix}) {
1594 my $xsize = $opts{xsize} || $self->getwidth;
1595 my $ysize = $opts{ysize} || $self->getheight;
142c26ff 1596
faa9b3e7
TC
1597 my $result = Imager->new;
1598 $result->{IMG} = i_matrix_transform($self->{IMG}, $xsize, $ysize,
1599 $opts{matrix})
1600 or return undef;
1601
1602 return $result;
1603 }
1604 else {
1605 $self->{ERRSTR} = "matrix parameter required";
1606 return undef;
1607 }
1608}
1609
1610# blame Leolo :)
1611*yatf = \&matrix_transform;
02d1d628
AMH
1612
1613# These two are supported for legacy code only
1614
1615sub i_color_new {
faa9b3e7 1616 return Imager::Color->new(@_);
02d1d628
AMH
1617}
1618
1619sub i_color_set {
faa9b3e7 1620 return Imager::Color::set(@_);
02d1d628
AMH
1621}
1622
02d1d628 1623# Draws a box between the specified corner points.
02d1d628
AMH
1624sub box {
1625 my $self=shift;
1626 unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1627 my $dflcl=i_color_new(255,255,255,255);
1628 my %opts=(color=>$dflcl,xmin=>0,ymin=>0,xmax=>$self->getwidth()-1,ymax=>$self->getheight()-1,@_);
1629
1630 if (exists $opts{'box'}) {
1631 $opts{'xmin'} = min($opts{'box'}->[0],$opts{'box'}->[2]);
1632 $opts{'xmax'} = max($opts{'box'}->[0],$opts{'box'}->[2]);
1633 $opts{'ymin'} = min($opts{'box'}->[1],$opts{'box'}->[3]);
1634 $opts{'ymax'} = max($opts{'box'}->[1],$opts{'box'}->[3]);
1635 }
1636
f1ac5027
TC
1637 if ($opts{filled}) {
1638 i_box_filled($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},
1639 $opts{ymax},$opts{color});
1640 }
1641 elsif ($opts{fill}) {
1642 unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
1643 # assume it's a hash ref
1644 require 'Imager/Fill.pm';
141a6114
TC
1645 unless ($opts{fill} = Imager::Fill->new(%{$opts{fill}})) {
1646 $self->{ERRSTR} = $Imager::ERRSTR;
1647 return undef;
1648 }
f1ac5027
TC
1649 }
1650 i_box_cfill($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},
1651 $opts{ymax},$opts{fill}{fill});
1652 }
1653 else {
1654 i_box($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},$opts{ymax},$opts{color});
1655 }
02d1d628
AMH
1656 return $self;
1657}
1658
1659# Draws an arc - this routine SUCKS and is buggy - it sometimes doesn't work when the arc is a convex polygon
1660
1661sub arc {
1662 my $self=shift;
1663 unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1664 my $dflcl=i_color_new(255,255,255,255);
1665 my %opts=(color=>$dflcl,
1666 'r'=>min($self->getwidth(),$self->getheight())/3,
1667 'x'=>$self->getwidth()/2,
1668 'y'=>$self->getheight()/2,
1669 'd1'=>0, 'd2'=>361, @_);
f1ac5027
TC
1670 if ($opts{fill}) {
1671 unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
1672 # assume it's a hash ref
1673 require 'Imager/Fill.pm';
1674 $opts{fill} = Imager::Fill->new(%{$opts{fill}});
1675 }
1676 i_arc_cfill($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},$opts{'d1'},
1677 $opts{'d2'}, $opts{fill}{fill});
1678 }
1679 else {
1680 i_arc($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},$opts{'d1'},
1681 $opts{'d2'},$opts{'color'});
1682 }
1683
02d1d628
AMH
1684 return $self;
1685}
1686
1687# Draws a line from one point to (but not including) the destination point
1688
1689sub line {
1690 my $self=shift;
1691 my $dflcl=i_color_new(0,0,0,0);
1692 my %opts=(color=>$dflcl,@_);
1693 unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1694
1695 unless (exists $opts{x1} and exists $opts{y1}) { $self->{ERRSTR}='missing begining coord'; return undef; }
1696 unless (exists $opts{x2} and exists $opts{y2}) { $self->{ERRSTR}='missing ending coord'; return undef; }
1697
1698 if ($opts{antialias}) {
1699 i_line_aa($self->{IMG},$opts{x1}, $opts{y1}, $opts{x2}, $opts{y2}, $opts{color});
1700 } else {
1701 i_draw($self->{IMG},$opts{x1}, $opts{y1}, $opts{x2}, $opts{y2}, $opts{color});
1702 }
1703 return $self;
1704}
1705
1706# Draws a line between an ordered set of points - It more or less just transforms this
1707# into a list of lines.
1708
1709sub polyline {
1710 my $self=shift;
1711 my ($pt,$ls,@points);
1712 my $dflcl=i_color_new(0,0,0,0);
1713 my %opts=(color=>$dflcl,@_);
1714
1715 unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1716
1717 if (exists($opts{points})) { @points=@{$opts{points}}; }
1718 if (!exists($opts{points}) and exists($opts{'x'}) and exists($opts{'y'}) ) {
1719 @points=map { [ $opts{'x'}->[$_],$opts{'y'}->[$_] ] } (0..(scalar @{$opts{'x'}}-1));
1720 }
1721
1722# print Dumper(\@points);
1723
1724 if ($opts{antialias}) {
1725 for $pt(@points) {
1726 if (defined($ls)) { i_line_aa($self->{IMG},$ls->[0],$ls->[1],$pt->[0],$pt->[1],$opts{color}); }
1727 $ls=$pt;
1728 }
1729 } else {
1730 for $pt(@points) {
1731 if (defined($ls)) { i_draw($self->{IMG},$ls->[0],$ls->[1],$pt->[0],$pt->[1],$opts{color}); }
1732 $ls=$pt;
1733 }
1734 }
1735 return $self;
1736}
1737
1738# this the multipoint bezier curve
1739# this is here more for testing that actual usage since
1740# this is not a good algorithm. Usually the curve would be
1741# broken into smaller segments and each done individually.
1742
1743sub polybezier {
1744 my $self=shift;
1745 my ($pt,$ls,@points);
1746 my $dflcl=i_color_new(0,0,0,0);
1747 my %opts=(color=>$dflcl,@_);
1748
1749 unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1750
1751 if (exists $opts{points}) {
1752 $opts{'x'}=map { $_->[0]; } @{$opts{'points'}};
1753 $opts{'y'}=map { $_->[1]; } @{$opts{'points'}};
1754 }
1755
1756 unless ( @{$opts{'x'}} and @{$opts{'x'}} == @{$opts{'y'}} ) {
1757 $self->{ERRSTR}='Missing or invalid points.';
1758 return;
1759 }
1760
1761 i_bezier_multi($self->{IMG},$opts{'x'},$opts{'y'},$opts{'color'});
1762 return $self;
1763}
1764
cc6483e0
TC
1765sub flood_fill {
1766 my $self = shift;
1767 my %opts = ( color=>Imager::Color->new(255, 255, 255), @_ );
1768
1769 unless (exists $opts{x} && exists $opts{'y'}) {
1770 $self->{ERRSTR} = "missing seed x and y parameters";
1771 return undef;
1772 }
1773
1774 if ($opts{fill}) {
1775 unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
1776 # assume it's a hash ref
1777 require 'Imager/Fill.pm';
1778 $opts{fill} = Imager::Fill->new(%{$opts{fill}});
1779 }
1780 i_flood_cfill($self->{IMG}, $opts{x}, $opts{'y'}, $opts{fill}{fill});
1781 }
1782 else {
1783 i_flood_fill($self->{IMG}, $opts{x}, $opts{'y'}, $opts{color});
1784 }
1785
1786 $self;
1787}
1788
f5991c03
TC
1789# make an identity matrix of the given size
1790sub _identity {
1791 my ($size) = @_;
1792
1793 my $matrix = [ map { [ (0) x $size ] } 1..$size ];
1794 for my $c (0 .. ($size-1)) {
1795 $matrix->[$c][$c] = 1;
1796 }
1797 return $matrix;
1798}
1799
1800# general function to convert an image
1801sub convert {
1802 my ($self, %opts) = @_;
1803 my $matrix;
1804
1805 # the user can either specify a matrix or preset
1806 # the matrix overrides the preset
1807 if (!exists($opts{matrix})) {
1808 unless (exists($opts{preset})) {
1809 $self->{ERRSTR} = "convert() needs a matrix or preset";
1810 return;
1811 }
1812 else {
1813 if ($opts{preset} eq 'gray' || $opts{preset} eq 'grey') {
1814 # convert to greyscale, keeping the alpha channel if any
1815 if ($self->getchannels == 3) {
1816 $matrix = [ [ 0.222, 0.707, 0.071 ] ];
1817 }
1818 elsif ($self->getchannels == 4) {
1819 # preserve the alpha channel
1820 $matrix = [ [ 0.222, 0.707, 0.071, 0 ],
1821 [ 0, 0, 0, 1 ] ];
1822 }
1823 else {
1824 # an identity
1825 $matrix = _identity($self->getchannels);
1826 }
1827 }
1828 elsif ($opts{preset} eq 'noalpha') {
1829 # strip the alpha channel
1830 if ($self->getchannels == 2 or $self->getchannels == 4) {
1831 $matrix = _identity($self->getchannels);
1832 pop(@$matrix); # lose the alpha entry
1833 }
1834 else {
1835 $matrix = _identity($self->getchannels);
1836 }
1837 }
1838 elsif ($opts{preset} eq 'red' || $opts{preset} eq 'channel0') {
1839 # extract channel 0
1840 $matrix = [ [ 1 ] ];
1841 }
1842 elsif ($opts{preset} eq 'green' || $opts{preset} eq 'channel1') {
1843 $matrix = [ [ 0, 1 ] ];
1844 }
1845 elsif ($opts{preset} eq 'blue' || $opts{preset} eq 'channel2') {
1846 $matrix = [ [ 0, 0, 1 ] ];
1847 }
1848 elsif ($opts{preset} eq 'alpha') {
1849 if ($self->getchannels == 2 or $self->getchannels == 4) {
1850 $matrix = [ [ (0) x ($self->getchannels-1), 1 ] ];
1851 }
1852 else {
1853 # the alpha is just 1 <shrug>
1854 $matrix = [ [ (0) x $self->getchannels, 1 ] ];
1855 }
1856 }
1857 elsif ($opts{preset} eq 'rgb') {
1858 if ($self->getchannels == 1) {
1859 $matrix = [ [ 1 ], [ 1 ], [ 1 ] ];
1860 }
1861 elsif ($self->getchannels == 2) {
1862 # preserve the alpha channel
1863 $matrix = [ [ 1, 0 ], [ 1, 0 ], [ 1, 0 ], [ 0, 1 ] ];
1864 }
1865 else {
1866 $matrix = _identity($self->getchannels);
1867 }
1868 }
1869 elsif ($opts{preset} eq 'addalpha') {
1870 if ($self->getchannels == 1) {
1871 $matrix = _identity(2);
1872 }
1873 elsif ($self->getchannels == 3) {
1874 $matrix = _identity(4);
1875 }
1876 else {
1877 $matrix = _identity($self->getchannels);
1878 }
1879 }
1880 else {
1881 $self->{ERRSTR} = "Unknown convert preset $opts{preset}";
1882 return undef;
1883 }
1884 }
1885 }
1886 else {
1887 $matrix = $opts{matrix};
1888 }
1889
1890 my $new = Imager->new();
1891 $new->{IMG} = i_img_new();
1892 unless (i_convert($new->{IMG}, $self->{IMG}, $matrix)) {
1893 # most likely a bad matrix
1894 $self->{ERRSTR} = _error_as_msg();
1895 return undef;
1896 }
1897 return $new;
1898}
40eba1ea
AMH
1899
1900
40eba1ea 1901# general function to map an image through lookup tables
9495ee93 1902
40eba1ea
AMH
1903sub map {
1904 my ($self, %opts) = @_;
9495ee93 1905 my @chlist = qw( red green blue alpha );
40eba1ea
AMH
1906
1907 if (!exists($opts{'maps'})) {
1908 # make maps from channel maps
1909 my $chnum;
1910 for $chnum (0..$#chlist) {
9495ee93
AMH
1911 if (exists $opts{$chlist[$chnum]}) {
1912 $opts{'maps'}[$chnum] = $opts{$chlist[$chnum]};
1913 } elsif (exists $opts{'all'}) {
1914 $opts{'maps'}[$chnum] = $opts{'all'};
1915 }
40eba1ea
AMH
1916 }
1917 }
1918 if ($opts{'maps'} and $self->{IMG}) {
1919 i_map($self->{IMG}, $opts{'maps'} );
1920 }
1921 return $self;
1922}
1923
02d1d628
AMH
1924# destructive border - image is shrunk by one pixel all around
1925
1926sub border {
1927 my ($self,%opts)=@_;
1928 my($tx,$ty)=($self->getwidth()-1,$self->getheight()-1);
1929 $self->polyline('x'=>[0,$tx,$tx,0,0],'y'=>[0,0,$ty,$ty,0],%opts);
1930}
1931
1932
1933# Get the width of an image
1934
1935sub getwidth {
1936 my $self = shift;
1937 if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
1938 return (i_img_info($self->{IMG}))[0];
1939}
1940
1941# Get the height of an image
1942
1943sub getheight {
1944 my $self = shift;
1945 if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
1946 return (i_img_info($self->{IMG}))[1];
1947}
1948
1949# Get number of channels in an image
1950
1951sub getchannels {
1952 my $self = shift;
1953 if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
1954 return i_img_getchannels($self->{IMG});
1955}
1956
1957# Get channel mask
1958
1959sub getmask {
1960 my $self = shift;
1961 if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
1962 return i_img_getmask($self->{IMG});
1963}
1964
1965# Set channel mask
1966
1967sub setmask {
1968 my $self = shift;
1969 my %opts = @_;
1970 if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
1971 i_img_setmask( $self->{IMG} , $opts{mask} );
1972}
1973
1974# Get number of colors in an image
1975
1976sub getcolorcount {
1977 my $self=shift;
1978 my %opts=(maxcolors=>2**30,@_);
1979 if (!defined($self->{IMG})) { $self->{ERRSTR}='image is empty'; return undef; }
1980 my $rc=i_count_colors($self->{IMG},$opts{'maxcolors'});
1981 return ($rc==-1? undef : $rc);
1982}
1983
1984# draw string to an image
1985
1986sub string {
1987 my $self = shift;
1988 unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
1989
1990 my %input=('x'=>0, 'y'=>0, @_);
1991 $input{string}||=$input{text};
1992
1993 unless(exists $input{string}) {
1994 $self->{ERRSTR}="missing required parameter 'string'";
1995 return;
1996 }
1997
1998 unless($input{font}) {
1999 $self->{ERRSTR}="missing required parameter 'font'";
2000 return;
2001 }
2002
faa9b3e7
TC
2003 unless ($input{font}->draw(image=>$self, %input)) {
2004 $self->{ERRSTR} = $self->_error_as_msg();
2005 return;
2006 }
02d1d628
AMH
2007
2008 return $self;
2009}
2010
02d1d628
AMH
2011# Shortcuts that can be exported
2012
2013sub newcolor { Imager::Color->new(@_); }
2014sub newfont { Imager::Font->new(@_); }
2015
2016*NC=*newcolour=*newcolor;
2017*NF=*newfont;
2018
2019*open=\&read;
2020*circle=\&arc;
2021
2022
2023#### Utility routines
2024
faa9b3e7
TC
2025sub errstr {
2026 ref $_[0] ? $_[0]->{ERRSTR} : $ERRSTR
2027}
02d1d628
AMH
2028
2029# Default guess for the type of an image from extension
2030
2031sub def_guess_type {
2032 my $name=lc(shift);
2033 my $ext;
2034 $ext=($name =~ m/\.([^\.]+)$/)[0];
2035 return 'tiff' if ($ext =~ m/^tiff?$/);
2036 return 'jpeg' if ($ext =~ m/^jpe?g$/);
2037 return 'pnm' if ($ext =~ m/^p[pgb]m$/);
2038 return 'png' if ($ext eq "png");
705fd961 2039 return 'bmp' if ($ext eq "bmp" || $ext eq "dib");
1ec86afa 2040 return 'tga' if ($ext eq "tga");
02d1d628
AMH
2041 return 'gif' if ($ext eq "gif");
2042 return ();
2043}
2044
2045# get the minimum of a list
2046
2047sub min {
2048 my $mx=shift;
2049 for(@_) { if ($_<$mx) { $mx=$_; }}
2050 return $mx;
2051}
2052
2053# get the maximum of a list
2054
2055sub max {
2056 my $mx=shift;
2057 for(@_) { if ($_>$mx) { $mx=$_; }}
2058 return $mx;
2059}
2060
2061# string stuff for iptc headers
2062
2063sub clean {
2064 my($str)=$_[0];
2065 $str = substr($str,3);
2066 $str =~ s/[\n\r]//g;
2067 $str =~ s/\s+/ /g;
2068 $str =~ s/^\s//;
2069 $str =~ s/\s$//;
2070 return $str;
2071}
2072
2073# A little hack to parse iptc headers.
2074
2075sub parseiptc {
2076 my $self=shift;
2077 my(@sar,$item,@ar);
2078 my($caption,$photogr,$headln,$credit);
2079
2080 my $str=$self->{IPTCRAW};
2081
2082 #print $str;
2083
2084 @ar=split(/8BIM/,$str);
2085
2086 my $i=0;
2087 foreach (@ar) {
2088 if (/^\004\004/) {
2089 @sar=split(/\034\002/);
2090 foreach $item (@sar) {
2091 if ($item =~ m/^x/) {
2092 $caption=&clean($item);
2093 $i++;
2094 }
2095 if ($item =~ m/^P/) {
2096 $photogr=&clean($item);
2097 $i++;
2098 }
2099 if ($item =~ m/^i/) {
2100 $headln=&clean($item);
2101 $i++;
2102 }
2103 if ($item =~ m/^n/) {
2104 $credit=&clean($item);
2105 $i++;
2106 }
2107 }
2108 }
2109 }
2110 return (caption=>$caption,photogr=>$photogr,headln=>$headln,credit=>$credit);
2111}
2112
02d1d628
AMH
2113# Autoload methods go after =cut, and are processed by the autosplit program.
2114
21151;
2116__END__
2117# Below is the stub of documentation for your module. You better edit it!
2118
2119=head1 NAME
2120
2121Imager - Perl extension for Generating 24 bit Images
2122
2123=head1 SYNOPSIS
2124
2125 use Imager qw(init);
2126
2127 init();
2128 $img = Imager->new();
2129 $img->open(file=>'image.ppm',type=>'pnm')
2130 || print "failed: ",$img->{ERRSTR},"\n";
2131 $scaled=$img->scale(xpixels=>400,ypixels=>400);
2132 $scaled->write(file=>'sc_image.ppm',type=>'pnm')
2133 || print "failed: ",$scaled->{ERRSTR},"\n";
2134
2135=head1 DESCRIPTION
2136
2137Imager is a module for creating and altering images - It is not meant
2138as a replacement or a competitor to ImageMagick or GD. Both are
2139excellent packages and well supported.
2140
2141=head2 API
2142
2143Almost all functions take the parameters in the hash fashion.
2144Example:
2145
2146 $img->open(file=>'lena.png',type=>'png');
2147
2148or just:
2149
2150 $img->open(file=>'lena.png');
2151
2152=head2 Basic concept
2153
2154An Image object is created with C<$img = Imager-E<gt>new()> Should
2155this fail for some reason an explanation can be found in
2156C<$Imager::ERRSTR> usually error messages are stored in
2157C<$img-E<gt>{ERRSTR}>, but since no object is created this is the only
2158way to give back errors. C<$Imager::ERRSTR> is also used to report
2159all errors not directly associated with an image object. Examples:
2160
2161 $img=Imager->new(); # This is an empty image (size is 0 by 0)
2162 $img->open(file=>'lena.png',type=>'png'); # initializes from file
2163
2164or if you want to create an empty image:
2165
2166 $img=Imager->new(xsize=>400,ysize=>300,channels=>4);
2167
2168This example creates a completely black image of width 400 and
2169height 300 and 4 channels.
2170
2171If you have an existing image, use img_set() to change it's dimensions
2172- this will destroy any existing image data:
2173
2174 $img->img_set(xsize=>500, ysize=>500, channels=>4);
2175
faa9b3e7
TC
2176To create paletted images, set the 'type' parameter to 'paletted':
2177
2178 $img = Imager->new(xsize=>200, ysize=>200, channels=>3, type=>'paletted');
2179
2180which creates an image with a maxiumum of 256 colors, which you can
2181change by supplying the C<maxcolors> parameter.
2182
2183You can create a new paletted image from an existing image using the
2184to_paletted() method:
2185
2186 $palimg = $img->to_paletted(\%opts)
2187
2188where %opts contains the options specified under L<Quantization options>.
2189
2190You can convert a paletted image (or any image) to an 8-bit/channel
2191RGB image with:
2192
2193 $rgbimg = $img->to_rgb8;
2194
2195Warning: if you draw on a paletted image with colors that aren't in
2196the palette, the image will be internally converted to a normal image.
2197
2198For improved color precision you can use the bits parameter to specify
219916 bites per channel:
2200
2201 $img = Imager->new(xsize=>200, ysize=>200, channels=>3, bits=>16);
2202
2203Note that as of this writing all functions should work on 16-bit
2204images, but at only 8-bit/channel precision.
2205
2206Currently only 8 and 16/bit per channel image types are available,
2207this may change later.
2208
02d1d628
AMH
2209Color objects are created by calling the Imager::Color->new()
2210method:
2211
2212 $color = Imager::Color->new($red, $green, $blue);
2213 $color = Imager::Color->new($red, $green, $blue, $alpha);
2214 $color = Imager::Color->new("#C0C0FF"); # html color specification
2215
2216This object can then be passed to functions that require a color parameter.
2217
2218Coordinates in Imager have the origin in the upper left corner. The
2219horizontal coordinate increases to the right and the vertical
2220downwards.
2221
2222=head2 Reading and writing images
2223
2224C<$img-E<gt>read()> generally takes two parameters, 'file' and 'type'.
2225If the type of the file can be determined from the suffix of the file
2226it can be omitted. Format dependant parameters are: For images of
2227type 'raw' two extra parameters are needed 'xsize' and 'ysize', if the
2228'channel' parameter is omitted for type 'raw' it is assumed to be 3.
2229gif and png images might have a palette are converted to truecolor bit
2230when read. Alpha channel is preserved for png images irregardless of
2231them being in RGB or gray colorspace. Similarly grayscale jpegs are
2232one channel images after reading them. For jpeg images the iptc
2233header information (stored in the APP13 header) is avaliable to some
2234degree. You can get the raw header with C<$img-E<gt>{IPTCRAW}>, but
2235you can also retrieve the most basic information with
d2dfdcc9
TC
2236C<%hsh=$img-E<gt>parseiptc()> as always patches are welcome. pnm has no
2237extra options. Examples:
02d1d628
AMH
2238
2239 $img = Imager->new();
2240 $img->read(file=>"cover.jpg") or die $img->errstr; # gets type from name
2241
2242 $img = Imager->new();
2243 { local(*FH,$/); open(FH,"file.gif") or die $!; $a=<FH>; }
2244 $img->read(data=>$a,type=>'gif') or die $img->errstr;
2245
2246The second example shows how to read an image from a scalar, this is
2247usefull if your data originates from somewhere else than a filesystem
2248such as a database over a DBI connection.
2249
d2dfdcc9
TC
2250When writing to a tiff image file you can also specify the 'class'
2251parameter, which can currently take a single value, "fax". If class
2252is set to fax then a tiff image which should be suitable for faxing
2253will be written. For the best results start with a grayscale image.
4c2d6970
TC
2254By default the image is written at fine resolution you can override
2255this by setting the "fax_fine" parameter to 0.
d2dfdcc9 2256
a59ffd27
TC
2257If you are reading from a gif image file, you can supply a 'colors'
2258parameter which must be a reference to a scalar. The referenced
2259scalar will receive an array reference which contains the colors, each
e72d3bb1 2260represented as an Imager::Color object.
a59ffd27 2261
04516c2b
TC
2262If you already have an open file handle, for example a socket or a
2263pipe, you can specify the 'fd' parameter instead of supplying a
2264filename. Please be aware that you need to use fileno() to retrieve
2265the file descriptor for the file:
2266
2267 $img->read(fd=>fileno(FILE), type=>'gif') or die $img->errstr;
2268
2269For writing using the 'fd' option you will probably want to set $| for
2270that descriptor, since the writes to the file descriptor bypass Perl's
2271(or the C libraries) buffering. Setting $| should avoid out of order
70f6c2cf
TC
2272output. For example a common idiom when writing a CGI script is:
2273
2274 # the $| _must_ come before you send the content-type
2275 $| = 1;
2276 print "Content-Type: image/jpeg\n\n";
2277 $img->write(fd=>fileno(STDOUT), type=>'jpeg') or die $img->errstr;
04516c2b 2278
02d1d628
AMH
2279*Note that load() is now an alias for read but will be removed later*
2280
2281C<$img-E<gt>write> has the same interface as C<read()>. The earlier
2282comments on C<read()> for autodetecting filetypes apply. For jpegs
2283quality can be adjusted via the 'jpegquality' parameter (0-100). The
2284number of colorplanes in gifs are set with 'gifplanes' and should be
2285between 1 (2 color) and 8 (256 colors). It is also possible to choose
2286between two quantizing methods with the parameter 'gifquant'. If set
2287to mc it uses the mediancut algorithm from either giflibrary. If set
2288to lm it uses a local means algorithm. It is then possible to give
2289some extra settings. lmdither is the dither deviation amount in pixels
2290(manhattan distance). lmfixed can be an array ref who holds an array
2291of Imager::Color objects. Note that the local means algorithm needs
2292much more cpu time but also gives considerable better results than the
2293median cut algorithm.
2294
2295Currently just for gif files, you can specify various options for the
2296conversion from Imager's internal RGB format to the target's indexed
2297file format. If you set the gifquant option to 'gen', you can use the
2298options specified under L<Quantization options>.
2299
2300To see what Imager is compiled to support the following code snippet
2301is sufficient:
2302
2303 use Imager;
2304 print "@{[keys %Imager::formats]}";
2305
7febf116
TC
2306When reading raw images you need to supply the width and height of the
2307image in the xsize and ysize options:
2308
2309 $img->read(file=>'foo.raw', xsize=>100, ysize=>100)
2310 or die "Cannot read raw image\n";
2311
2312If your input file has more channels than you want, or (as is common),
2313junk in the fourth channel, you can use the datachannels and
2314storechannels options to control the number of channels in your input
2315file and the resulting channels in your image. For example, if your
2316input image uses 32-bits per pixel with red, green, blue and junk
2317values for each pixel you could do:
2318
2319 $img->read(file=>'foo.raw', xsize=>100, ysize=>100, datachannels=>4,
2320 storechannels=>3)
2321 or die "Cannot read raw image\n";
2322
d04ee244
TC
2323Normally the raw image is expected to have the value for channel 1
2324immediately following channel 0 and channel 2 immediately following
2325channel 1 for each pixel. If your input image has all the channel 0
2326values for the first line of the image, followed by all the channel 1
2327values for the first line and so on, you can use the interleave option:
2328
2329 $img->read(file=>'foo.raw', xsize=100, ysize=>100, interleave=>1)
2330 or die "Cannot read raw image\n";
2331
02d1d628
AMH
2332=head2 Multi-image files
2333
2334Currently just for gif files, you can create files that contain more
2335than one image.
2336
2337To do this:
2338
2339 Imager->write_multi(\%opts, @images)
2340
b9029e27 2341Where %opts describes 4 possible types of outputs:
02d1d628 2342
b9029e27
AMH
2343=over 5
2344
2345=item type
2346
2347This is C<gif> for gif animations.
02d1d628
AMH
2348
2349=item callback
2350
2351A code reference which is called with a single parameter, the data to
2352be written. You can also specify $opts{maxbuffer} which is the
2353maximum amount of data buffered. Note that there can be larger writes
2354than this if the file library writes larger blocks. A smaller value
2355maybe useful for writing to a socket for incremental display.
2356
2357=item fd
2358
2359The file descriptor to save the images to.
2360
2361=item file
2362
2363The name of the file to write to.
2364
2365%opts may also include the keys from L<Gif options> and L<Quantization
2366options>.
2367
2368=back
2369
f5991c03
TC
2370You must also specify the file format using the 'type' option.
2371
02d1d628
AMH
2372The current aim is to support other multiple image formats in the
2373future, such as TIFF, and to support reading multiple images from a
2374single file.
2375
2376A simple example:
2377
2378 my @images;
2379 # ... code to put images in @images
2380 Imager->write_multi({type=>'gif',
2381 file=>'anim.gif',
f5991c03 2382 gif_delays=>[ (10) x @images ] },
02d1d628
AMH
2383 @images)
2384 or die "Oh dear!";
2385
faa9b3e7
TC
2386You can read multi-image files (currently only GIF files) using the
2387read_multi() method:
2388
2389 my @imgs = Imager->read_multi(file=>'foo.gif')
2390 or die "Cannot read images: ",Imager->errstr;
2391
2392The possible parameters for read_multi() are:
2393
2394=over
2395
2396=item file
2397
2398The name of the file to read in.
2399
2400=item fh
2401
2402A filehandle to read in. This can be the name of a filehandle, but it
2403will need the package name, no attempt is currently made to adjust
2404this to the caller's package.
2405
2406=item fd
2407
2408The numeric file descriptor of an open file (or socket).
2409
2410=item callback
2411
2412A function to be called to read in data, eg. reading a blob from a
2413database incrementally.
2414
2415=item data
2416
2417The data of the input file in memory.
2418
2419=item type
2420
2421The type of file. If the file is parameter is given and provides
2422enough information to guess the type, then this parameter is optional.
2423
2424=back
2425
2426Note: you cannot use the callback or data parameter with giflib
2427versions before 4.0.
2428
2429When reading from a GIF file with read_multi() the images are returned
2430as paletted images.
2431
02d1d628
AMH
2432=head2 Gif options
2433
2434These options can be specified when calling write_multi() for gif
2435files, when writing a single image with the gifquant option set to
2436'gen', or for direct calls to i_writegif_gen and i_writegif_callback.
2437
2438Note that some viewers will ignore some of these options
2439(gif_user_input in particular).
2440
2441=over 4
2442
2443=item gif_each_palette
2444
2445Each image in the gif file has it's own palette if this is non-zero.
2446All but the first image has a local colour table (the first uses the
2447global colour table.
2448
2449=item interlace
2450
2451The images are written interlaced if this is non-zero.
2452
2453=item gif_delays
2454
2455A reference to an array containing the delays between images, in 1/100
2456seconds.
2457
ed88b092
TC
2458If you want the same delay for every frame you can simply set this to
2459the delay in 1/100 seconds.
2460
02d1d628
AMH
2461=item gif_user_input
2462
2463A reference to an array contains user input flags. If the given flag
2464is non-zero the image viewer should wait for input before displaying
2465the next image.
2466
2467=item gif_disposal
2468
2469A reference to an array of image disposal methods. These define what
2470should be done to the image before displaying the next one. These are
2471integers, where 0 means unspecified, 1 means the image should be left
2472in place, 2 means restore to background colour and 3 means restore to
2473the previous value.
2474
2475=item gif_tran_color
2476
2477A reference to an Imager::Color object, which is the colour to use for
ae235ea6
TC
2478the palette entry used to represent transparency in the palette. You
2479need to set the transp option (see L<Quantization options>) for this
2480value to be used.
02d1d628
AMH
2481
2482=item gif_positions
2483
2484A reference to an array of references to arrays which represent screen
2485positions for each image.
2486
2487=item gif_loop_count
2488
2489If this is non-zero the Netscape loop extension block is generated,
2490which makes the animation of the images repeat.
2491
2492This is currently unimplemented due to some limitations in giflib.
2493
2494=back
2495
2496=head2 Quantization options
2497
2498These options can be specified when calling write_multi() for gif
2499files, when writing a single image with the gifquant option set to
2500'gen', or for direct calls to i_writegif_gen and i_writegif_callback.
2501
2502=over 4
2503
2504=item colors
2505
2506A arrayref of colors that are fixed. Note that some color generators
2507will ignore this.
2508
2509=item transp
2510
2511The type of transparency processing to perform for images with an
2512alpha channel where the output format does not have a proper alpha
2513channel (eg. gif). This can be any of:
2514
2515=over 4
2516
2517=item none
2518
2519No transparency processing is done. (default)
2520
2521=item threshold
2522
2523Pixels more transparent that tr_threshold are rendered as transparent.
2524
2525=item errdiff
2526
2527An error diffusion dither is done on the alpha channel. Note that
2528this is independent of the translation performed on the colour
2529channels, so some combinations may cause undesired artifacts.
2530
2531=item ordered
2532
2533The ordered dither specified by tr_orddith is performed on the alpha
2534channel.
2535
2536=back
2537
ae235ea6
TC
2538This will only be used if the image has an alpha channel, and if there
2539is space in the palette for a transparency colour.
2540
02d1d628
AMH
2541=item tr_threshold
2542
2543The highest alpha value at which a pixel will be made transparent when
2544transp is 'threshold'. (0-255, default 127)
2545
2546=item tr_errdiff
2547
2548The type of error diffusion to perform on the alpha channel when
2549transp is 'errdiff'. This can be any defined error diffusion type
2550except for custom (see errdiff below).
2551
626cabcc 2552=item tr_orddith
02d1d628
AMH
2553
2554The type of ordered dither to perform on the alpha channel when transp
626cabcc 2555is 'ordered'. Possible values are:
02d1d628
AMH
2556
2557=over 4
2558
2559=item random
2560
529ef1f3 2561A semi-random map is used. The map is the same each time.
02d1d628
AMH
2562
2563=item dot8
2564
25658x8 dot dither.
2566
2567=item dot4
2568
25694x4 dot dither
2570
2571=item hline
2572
2573horizontal line dither.
2574
2575=item vline
2576
2577vertical line dither.
2578
2579=item "/line"
2580
2581=item slashline
2582
2583diagonal line dither
2584
2585=item '\line'
2586
2587=item backline
2588
2589diagonal line dither
2590
529ef1f3
TC
2591=item tiny
2592
2593dot matrix dither (currently the default). This is probably the best
2594for displays (like web pages).
2595
02d1d628
AMH
2596=item custom
2597
2598A custom dither matrix is used - see tr_map
2599
2600=back
2601
2602=item tr_map
2603
2604When tr_orddith is custom this defines an 8 x 8 matrix of integers
2605representing the transparency threshold for pixels corresponding to
2606each position. This should be a 64 element array where the first 8
2607entries correspond to the first row of the matrix. Values should be
2608betweern 0 and 255.
2609
2610=item make_colors
2611
2612Defines how the quantization engine will build the palette(s).
2613Currently this is ignored if 'translate' is 'giflib', but that may
2614change. Possible values are:
2615
2616=over 4
2617
2618=item none
2619
2620Only colors supplied in 'colors' are used.
2621
2622=item webmap
2623
2624The web color map is used (need url here.)
2625
2626=item addi
2627
2628The original code for generating the color map (Addi's code) is used.
2629
2630=back
2631
2632Other methods may be added in the future.
2633
2634=item colors
2635
2636A arrayref containing Imager::Color objects, which represents the
2637starting set of colors to use in translating the images. webmap will
2638ignore this. The final colors used are copied back into this array
2639(which is expanded if necessary.)
2640
2641=item max_colors
2642
2643The maximum number of colors to use in the image.
2644
2645=item translate
2646
2647The method used to translate the RGB values in the source image into
2648the colors selected by make_colors. Note that make_colors is ignored
2649whene translate is 'giflib'.
2650
2651Possible values are:
2652
2653=over 4
2654
2655=item giflib
2656
2657The giflib native quantization function is used.
2658
2659=item closest
2660
2661The closest color available is used.
2662
2663=item perturb
2664
2665The pixel color is modified by perturb, and the closest color is chosen.
2666
2667=item errdiff
2668
2669An error diffusion dither is performed.
2670
2671=back
2672
2673It's possible other transate values will be added.
2674
2675=item errdiff
2676
2677The type of error diffusion dither to perform. These values (except
2678for custom) can also be used in tr_errdif.
2679
2680=over 4
2681
2682=item floyd
2683
2684Floyd-Steinberg dither
2685
2686=item jarvis
2687
2688Jarvis, Judice and Ninke dither
2689
2690=item stucki
2691
2692Stucki dither
2693
2694=item custom
2695
2696Custom. If you use this you must also set errdiff_width,
2697errdiff_height and errdiff_map.
2698
2699=back
2700
2701=item errdiff_width
2702
2703=item errdiff_height
2704
2705=item errdiff_orig
2706
2707=item errdiff_map
2708
2709When translate is 'errdiff' and errdiff is 'custom' these define a
2710custom error diffusion map. errdiff_width and errdiff_height define
2711the size of the map in the arrayref in errdiff_map. errdiff_orig is
2712an integer which indicates the current pixel position in the top row
2713of the map.
2714
2715=item perturb
2716
2717When translate is 'perturb' this is the magnitude of the random bias
2718applied to each channel of the pixel before it is looked up in the
2719color table.
2720
2721=back
2722
2723=head2 Obtaining/setting attributes of images
2724
2725To get the size of an image in pixels the C<$img-E<gt>getwidth()> and
2726C<$img-E<gt>getheight()> are used.
2727
2728To get the number of channels in
2729an image C<$img-E<gt>getchannels()> is used. $img-E<gt>getmask() and
2730$img-E<gt>setmask() are used to get/set the channel mask of the image.
2731
2732 $mask=$img->getmask();
2733 $img->setmask(mask=>1+2); # modify red and green only
2734 $img->setmask(mask=>8); # modify alpha only
2735 $img->setmask(mask=>$mask); # restore previous mask
2736
2737The mask of an image describes which channels are updated when some
2738operation is performed on an image. Naturally it is not possible to
2739apply masks to operations like scaling that alter the dimensions of
2740images.
2741
2742It is possible to have Imager find the number of colors in an image
2743by using C<$img-E<gt>getcolorcount()>. It requires memory proportionally
2744to the number of colors in the image so it is possible to have it
2745stop sooner if you only need to know if there are more than a certain number
2746of colors in the image. If there are more colors than asked for
2747the function return undef. Examples:
2748
2749 if (!defined($img->getcolorcount(maxcolors=>512)) {
2750 print "Less than 512 colors in image\n";
2751 }
2752
faa9b3e7
TC
2753The bits() method retrieves the number of bits used to represent each
2754channel in a pixel, typically 8. The type() method returns either
2755'direct' for truecolor images or 'paletted' for paletted images. The
2756virtual() method returns non-zero if the image contains no actual
2757pixels, for example masked images.
2758
2759=head2 Paletted Images
2760
2761In general you can work with paletted images in the same way as RGB
2762images, except that if you attempt to draw to a paletted image with a
2763color that is not in the image's palette, the image will be converted
2764to an RGB image. This means that drawing on a paletted image with
2765anti-aliasing enabled will almost certainly convert the image to RGB.
2766
2767You can add colors to a paletted image with the addcolors() method:
2768
2769 my @colors = ( Imager::Color->new(255, 0, 0),
2770 Imager::Color->new(0, 255, 0) );
2771 my $index = $img->addcolors(colors=>\@colors);
2772
2773The return value is the index of the first color added, or undef if
2774adding the colors would overflow the palette.
2775
2776Once you have colors in the palette you can overwrite them with the
2777setcolors() method:
2778
2779 $img->setcolors(start=>$start, colors=>\@colors);
2780
2781Returns true on success.
2782
2783To retrieve existing colors from the palette use the getcolors() method:
2784
2785 # get the whole palette
2786 my @colors = $img->getcolors();
2787 # get a single color
2788 my $color = $img->getcolors(start=>$index);
2789 # get a range of colors
2790 my @colors = $img->getcolors(start=>$index, count=>$count);
2791
2792To quickly find a color in the palette use findcolor():
2793
2794 my $index = $img->findcolor(color=>$color);
2795
2796which returns undef on failure, or the index of the color.
2797
2798You can get the current palette size with $img->colorcount, and the
2799maximum size of the palette with $img->maxcolors.
2800
02d1d628
AMH
2801=head2 Drawing Methods
2802
2803IMPLEMENTATION MORE OR LESS DONE CHECK THE TESTS
02d1d628
AMH
2804DOCUMENTATION OF THIS SECTION OUT OF SYNC
2805
2806It is possible to draw with graphics primitives onto images. Such
2807primitives include boxes, arcs, circles and lines. A reference
2808oriented list follows.
2809
2810Box:
2811 $img->box(color=>$blue,xmin=>10,ymin=>30,xmax=>200,ymax=>300,filled=>1);
2812
2813The above example calls the C<box> method for the image and the box
2814covers the pixels with in the rectangle specified. If C<filled> is
2815ommited it is drawn as an outline. If any of the edges of the box are
2816ommited it will snap to the outer edge of the image in that direction.
2817Also if a color is omitted a color with (255,255,255,255) is used
2818instead.
2819
2820Arc:
2821 $img->arc(color=>$red, r=20, x=>200, y=>100, d1=>10, d2=>20 );
2822
2823This creates a filled red arc with a 'center' at (200, 100) and spans
282410 degrees and the slice has a radius of 20. SEE section on BUGS.
2825
f1ac5027
TC
2826Both the arc() and box() methods can take a C<fill> parameter which
2827can either be an Imager::Fill object, or a reference to a hash
2828containing the parameters used to create the fill:
2829
2830 $img->box(xmin=>10, ymin=>30, xmax=>150, ymax=>60,
2831 fill => { hatch=>'cross2' });
2832 use Imager::Fill;
2833 my $fill = Imager::Fill->new(hatch=>'stipple');
2834 $img->box(fill=>$fill);
2835
2836See L<Imager::Fill> for the type of fills you can use.
2837
02d1d628
AMH
2838Circle:
2839 $img->circle(color=>$green, r=50, x=>200, y=>100);
2840
2841This creates a green circle with its center at (200, 100) and has a
2842radius of 20.
2843
2844Line:
2845 $img->line(color=>$green, x1=10, x2=>100,
2846 y1=>20, y2=>50, antialias=>1 );
2847
2848That draws an antialiased line from (10,100) to (20,50).
2849
2850Polyline:
2851 $img->polyline(points=>[[$x0,$y0],[$x1,$y1],[$x2,$y2]],color=>$red);
2852 $img->polyline(x=>[$x0,$x1,$x2], y=>[$y0,$y1,$y2], antialias=>1);
2853
2854Polyline is used to draw multilple lines between a series of points.
2855The point set can either be specified as an arrayref to an array of
2856array references (where each such array represents a point). The
2857other way is to specify two array references.
2858
cc6483e0
TC
2859You can fill a region that all has the same color using the
2860flood_fill() method, for example:
2861
2862 $img->flood_fill(x=>50, y=>50, color=>$color);
2863
2864will fill all regions the same color connected to the point (50, 50).
2865
2866You can also use a general fill, so you could fill the same region
2867with a check pattern using:
2868
2869 $img->flood_fill(x=>50, y=>50, fill=>{ hatch=>'check2x2' });
2870
2871See L<Imager::Fill> for more information on general fills.
2872
02d1d628
AMH
2873=head2 Text rendering
2874
2875Text rendering is described in the Imager::Font manpage.
2876
2877=head2 Image resizing
2878
2879To scale an image so porportions are maintained use the
2880C<$img-E<gt>scale()> method. if you give either a xpixels or ypixels
2881parameter they will determine the width or height respectively. If
2882both are given the one resulting in a larger image is used. example:
2883C<$img> is 700 pixels wide and 500 pixels tall.
2884
2885 $img->scale(xpixels=>400); # 400x285
2886 $img->scale(ypixels=>400); # 560x400
2887
2888 $img->scale(xpixels=>400,ypixels=>400); # 560x400
2889 $img->scale(xpixels=>400,ypixels=>400,type=>min); # 400x285
2890
2891 $img->scale(scalefactor=>0.25); 175x125 $img->scale(); # 350x250
2892
2893if you want to create low quality previews of images you can pass
2894C<qtype=E<gt>'preview'> to scale and it will use nearest neighbor
2895sampling instead of filtering. It is much faster but also generates
2896worse looking images - especially if the original has a lot of sharp
2897variations and the scaled image is by more than 3-5 times smaller than
2898the original.
2899
2900If you need to scale images per axis it is best to do it simply by
2901calling scaleX and scaleY. You can pass either 'scalefactor' or
2902'pixels' to both functions.
2903
2904Another way to resize an image size is to crop it. The parameters
2905to crop are the edges of the area that you want in the returned image.
2906If a parameter is omited a default is used instead.
2907
2908 $newimg = $img->crop(left=>50, right=>100, top=>10, bottom=>100);
2909 $newimg = $img->crop(left=>50, top=>10, width=>50, height=>90);
2910 $newimg = $img->crop(left=>50, right=>100); # top
2911
2912You can also specify width and height parameters which will produce a
2913new image cropped from the center of the input image, with the given
2914width and height.
2915
2916 $newimg = $img->crop(width=>50, height=>50);
2917
2918The width and height parameters take precedence over the left/right
2919and top/bottom parameters respectively.
2920
2921=head2 Copying images
2922
2923To create a copy of an image use the C<copy()> method. This is usefull
2924if you want to keep an original after doing something that changes the image
2925inplace like writing text.
2926
2927 $img=$orig->copy();
2928
2929To copy an image to onto another image use the C<paste()> method.
2930
2931 $dest->paste(left=>40,top=>20,img=>$logo);
2932
2933That copies the entire C<$logo> image onto the C<$dest> image so that the
2934upper left corner of the C<$logo> image is at (40,20).
2935
142c26ff
AMH
2936
2937=head2 Flipping images
2938
2939An inplace horizontal or vertical flip is possible by calling the
9191e525
AMH
2940C<flip()> method. If the original is to be preserved it's possible to
2941make a copy first. The only parameter it takes is the C<dir>
2942parameter which can take the values C<h>, C<v>, C<vh> and C<hv>.
142c26ff 2943
9191e525
AMH
2944 $img->flip(dir=>"h"); # horizontal flip
2945 $img->flip(dir=>"vh"); # vertical and horizontal flip
2946 $nimg = $img->copy->flip(dir=>"v"); # make a copy and flip it vertically
142c26ff 2947
faa9b3e7
TC
2948=head2 Rotating images
2949
2950Use the rotate() method to rotate an image.
2951
2952To rotate by an exact amount in degrees or radians, use the 'degrees'
2953or 'radians' parameter:
2954
2955 my $rot20 = $img->rotate(degrees=>20);
2956 my $rotpi4 = $img->rotate(radians=>3.14159265/4);
2957
2958To rotate in steps of 90 degrees, use the 'right' parameter:
2959
2960 my $rotated = $img->rotate(right=>270);
2961
2962Rotations are clockwise for positive values.
2963
9191e525 2964=head2 Blending Images
142c26ff 2965
9191e525 2966To put an image or a part of an image directly
142c26ff
AMH
2967into another it is best to call the C<paste()> method on the image you
2968want to add to.
02d1d628
AMH
2969
2970 $img->paste(img=>$srcimage,left=>30,top=>50);
2971
2972That will take paste C<$srcimage> into C<$img> with the upper
2973left corner at (30,50). If no values are given for C<left>
2974or C<top> they will default to 0.
2975
2976A more complicated way of blending images is where one image is
2977put 'over' the other with a certain amount of opaqueness. The
2978method that does this is rubthrough.
2979
2980 $img->rubthrough(src=>$srcimage,tx=>30,ty=>50);
2981
faa9b3e7
TC
2982That will take the image C<$srcimage> and overlay it with the upper
2983left corner at (30,50). You can rub 2 or 4 channel images onto a 3
2984channel image, or a 2 channel image onto a 1 channel image. The last
2985channel is used as an alpha channel.
02d1d628
AMH
2986
2987
2988=head2 Filters
2989
2990A special image method is the filter method. An example is:
2991
2992 $img->filter(type=>'autolevels');
2993
2994This will call the autolevels filter. Here is a list of the filters
2995that are always avaliable in Imager. This list can be obtained by
2996running the C<filterlist.perl> script that comes with the module
2997source.
2998
2999 Filter Arguments
02d1d628 3000 autolevels lsat(0.1) usat(0.1) skew(0)
d08b8f85 3001 bumpmap bump elevation(0) lightx lighty st(2)
02d1d628 3002 contrast intensity
faa9b3e7 3003 conv coef
efdc2568 3004 fountain xa ya xb yb ftype(linear) repeat(none) combine(none)
6607600c 3005 super_sample(none) ssample_param(4) segments(see below)
faa9b3e7 3006 gaussian stddev
02d1d628 3007 gradgen xo yo colors dist
faa9b3e7 3008 hardinvert
6607600c 3009 mosaic size(20)
faa9b3e7 3010 noise amount(3) subtype(0)
d08b8f85 3011 postlevels levels(10)
faa9b3e7
TC
3012 radnoise xo(100) yo(100) ascale(17.0) rscale(0.02)
3013 turbnoise xo(0.0) yo(0.0) scale(10.0)
d08b8f85 3014 watermark wmark pixdiff(10) tx(0) ty(0)
02d1d628
AMH
3015
3016The default values are in parenthesis. All parameters must have some
3017value but if a parameter has a default value it may be omitted when
3018calling the filter function.
3019
faa9b3e7
TC
3020The filters are:
3021
3022=over
3023
3024=item autolevels
3025
3026scales the value of each channel so that the values in the image will
3027cover the whole possible range for the channel. I<lsat> and I<usat>
3028truncate the range by the specified fraction at the top and bottom of
3029the range respectivly..
3030
d08b8f85
TC
3031=item bumpmap
3032
3033uses the channel I<elevation> image I<bump> as a bumpmap on your
3034image, with the light at (I<lightx>, I<lightty>), with a shadow length
3035of I<st>.
3036
faa9b3e7
TC
3037=item contrast
3038
3039scales each channel by I<intensity>. Values of I<intensity> < 1.0
3040will reduce the contrast.
3041
3042=item conv
3043
3044performs 2 1-dimensional convolutions on the image using the values
3045from I<coef>. I<coef> should be have an odd length.
3046
6607600c
TC
3047=item fountain
3048
3049renders a fountain fill, similar to the gradient tool in most paint
3050software. The default fill is a linear fill from opaque black to
3051opaque white. The points A(xa, ya) and B(xb, yb) control the way the
3052fill is performed, depending on the ftype parameter:
3053
3054=over
3055
3056=item linear
3057
3058the fill ramps from A through to B.
3059
3060=item bilinear
3061
3062the fill ramps in both directions from A, where AB defines the length
3063of the gradient.
3064
3065=item radial
3066
3067A is the center of a circle, and B is a point on it's circumference.
3068The fill ramps from the center out to the circumference.
3069
3070=item radial_square
3071
3072A is the center of a square and B is the center of one of it's sides.
3073This can be used to rotate the square. The fill ramps out to the
3074edges of the square.
3075
3076=item revolution
3077
3078A is the centre of a circle and B is a point on it's circumference. B
3079marks the 0 and 360 point on the circle, with the fill ramping
3080clockwise.
3081
3082=item conical
3083
3084A is the center of a circle and B is a point on it's circumference. B
3085marks the 0 and point on the circle, with the fill ramping in both
3086directions to meet opposite.
3087
3088=back
3089
3090The I<repeat> option controls how the fill is repeated for some
3091I<ftype>s after it leaves the AB range:
3092
3093=over
3094
3095=item none
3096
3097no repeats, points outside of each range are treated as if they were
3098on the extreme end of that range.
3099
3100=item sawtooth
3101
3102the fill simply repeats in the positive direction
3103
3104=item triangle
3105
3106the fill repeats in reverse and then forward and so on, in the
3107positive direction
3108
3109=item saw_both
3110
3111the fill repeats in both the positive and negative directions (only
3112meaningful for a linear fill).
3113
3114=item tri_both
3115
3116as for triangle, but in the negative direction too (only meaningful
3117for a linear fill).
3118
3119=back
3120
3121By default the fill simply overwrites the whole image (unless you have
3122parts of the range 0 through 1 that aren't covered by a segment), if
3123any segments of your fill have any transparency, you can set the
efdc2568
TC
3124I<combine> option to 'normal' to have the fill combined with the
3125existing pixels. See the description of I<combine> in L<Imager/Fill>.
6607600c
TC
3126
3127If your fill has sharp edges, for example between steps if you use
3128repeat set to 'triangle', you may see some aliased or ragged edges.
3129You can enable super-sampling which will take extra samples within the
3130pixel in an attempt anti-alias the fill.
3131
3132The possible values for the super_sample option are:
3133
3134=over
3135
3136=item none
3137
3138no super-sampling is done
3139
3140=item grid
3141
3142a square grid of points are sampled. The number of points sampled is
3143the square of ceil(0.5 + sqrt(ssample_param)).
3144
3145=item random
3146
3147a random set of points within the pixel are sampled. This looks
3148pretty bad for low ssample_param values.
3149
3150=item circle
3151
3152the points on the radius of a circle within the pixel are sampled.
3153This seems to produce the best results, but is fairly slow (for now).
3154
3155=back
3156
3157You can control the level of sampling by setting the ssample_param
3158option. This is roughly the number of points sampled, but depends on
3159the type of sampling.
3160
3161The segments option is an arrayref of segments. You really should use
3162the Imager::Fountain class to build your fountain fill. Each segment
3163is an array ref containing:
3164
3165=over
3166
3167=item start
3168
3169a floating point number between 0 and 1, the start of the range of fill parameters covered by this segment.
3170
3171=item middle
3172
3173a floating point number between start and end which can be used to
3174push the color range towards one end of the segment.
3175
3176=item end
3177
3178a floating point number between 0 and 1, the end of the range of fill
3179parameters covered by this segment. This should be greater than
3180start.
3181
3182=item c0
3183
3184=item c1
3185
3186The colors at each end of the segment. These can be either
3187Imager::Color or Imager::Color::Float objects.
3188
3189=item segment type
3190
3191The type of segment, this controls the way the fill parameter varies
3192over the segment. 0 for linear, 1 for curved (unimplemented), 2 for
3193sine, 3 for sphere increasing, 4 for sphere decreasing.
3194
3195=item color type
3196
3197The way the color varies within the segment, 0 for simple RGB, 1 for
3198hue increasing and 2 for hue decreasing.
3199
3200=back
3201
3202Don't forgot to use Imager::Fountain instead of building your own.
3203Really. It even loads GIMP gradient files.
3204
faa9b3e7
TC
3205=item gaussian
3206
3207performs a gaussian blur of the image, using I<stddev> as the standard
3208deviation of the curve used to combine pixels, larger values give
3209bigger blurs. For a definition of Gaussian Blur, see:
3210
3211 http://www.maths.abdn.ac.uk/~igc/tch/mx4002/notes/node99.html
3212
3213=item gradgen
3214
3215renders a gradient, with the given I<colors> at the corresponding
3216points (x,y) in I<xo> and I<yo>. You can specify the way distance is
3217measured for color blendeing by setting I<dist> to 0 for Euclidean, 1
3218for Euclidean squared, and 2 for Manhattan distance.
3219
3220=item hardinvert
3221
3222inverts the image, black to white, white to black. All channels are
3223inverted, including the alpha channel if any.
3224
6607600c
TC
3225=item mosaic
3226
3227produces averaged tiles of the given I<size>.
3228
faa9b3e7
TC
3229=item noise
3230
3231adds noise of the given I<amount> to the image. If I<subtype> is
3232zero, the noise is even to each channel, otherwise noise is added to
3233each channel independently.
3234
3235=item radnoise
3236
3237renders radiant Perlin turbulent noise. The centre of the noise is at
3238(I<xo>, I<yo>), I<ascale> controls the angular scale of the noise ,
3239and I<rscale> the radial scale, higher numbers give more detail.
3240
d08b8f85
TC
3241=item postlevels
3242
3243alters the image to have only I<levels> distinct level in each
3244channel.
3245
faa9b3e7
TC
3246=item turbnoise
3247
3248renders Perlin turbulent noise. (I<xo>, I<yo>) controls the origin of
3249the noise, and I<scale> the scale of the noise, with lower numbers
3250giving more detail.
3251
d08b8f85
TC
3252=item watermark
3253
3254applies I<wmark> as a watermark on the image with strength I<pixdiff>,
3255with an origin at (I<tx>, I<ty>)
3256
faa9b3e7
TC
3257=back
3258
d08b8f85 3259A demonstration of most of the filters can be found at:
faa9b3e7
TC
3260
3261 http://www.develop-help.com/imager/filters.html
3262
3263(This is a slow link.)
02d1d628 3264
f5991c03
TC
3265=head2 Color transformations
3266
3267You can use the convert method to transform the color space of an
3268image using a matrix. For ease of use some presets are provided.
3269
3270The convert method can be used to:
3271
3272=over 4
3273
3274=item *
3275
3276convert an RGB or RGBA image to grayscale.
3277
3278=item *
3279
3280convert a grayscale image to RGB.
3281
3282=item *
3283
3284extract a single channel from an image.
3285
3286=item *
3287
3288set a given channel to a particular value (or from another channel)
3289
3290=back
3291
3292The currently defined presets are:
3293
3294=over
3295
3296=item gray
3297
3298=item grey
3299
3300converts an RGBA image into a grayscale image with alpha channel, or
3301an RGB image into a grayscale image without an alpha channel.
3302
3303This weights the RGB channels at 22.2%, 70.7% and 7.1% respectively.
3304
3305=item noalpha
3306
3307removes the alpha channel from a 2 or 4 channel image. An identity
3308for other images.
3309
3310=item red
3311
3312=item channel0
3313
3314extracts the first channel of the image into a single channel image
3315
3316=item green
3317
3318=item channel1
3319
3320extracts the second channel of the image into a single channel image
3321
3322=item blue
3323
3324=item channel2
3325
3326extracts the third channel of the image into a single channel image
3327
3328=item alpha
3329
3330extracts the alpha channel of the image into a single channel image.
3331
3332If the image has 1 or 3 channels (assumed to be grayscale of RGB) then
3333the resulting image will be all white.
3334
3335=item rgb
3336
3337converts a grayscale image to RGB, preserving the alpha channel if any
3338
3339=item addalpha
3340
3341adds an alpha channel to a grayscale or RGB image. Preserves an
3342existing alpha channel for a 2 or 4 channel image.
3343
3344=back
3345
3346For example, to convert an RGB image into a greyscale image:
3347
3348 $new = $img->convert(preset=>'grey'); # or gray
3349
3350or to convert a grayscale image to an RGB image:
3351
3352 $new = $img->convert(preset=>'rgb');
3353
3354The presets aren't necessary simple constants in the code, some are
3355generated based on the number of channels in the input image.
3356
3357If you want to perform some other colour transformation, you can use
3358the 'matrix' parameter.
3359
3360For each output pixel the following matrix multiplication is done:
3361
3362 channel[0] [ [ $c00, $c01, ... ] inchannel[0]
3363 [ ... ] = ... x [ ... ]
3364 channel[n-1] [ $cn0, ..., $cnn ] ] inchannel[max]
3365 1
3366
3367So if you want to swap the red and green channels on a 3 channel image:
3368
3369 $new = $img->convert(matrix=>[ [ 0, 1, 0 ],
3370 [ 1, 0, 0 ],
3371 [ 0, 0, 1 ] ]);
3372
3373or to convert a 3 channel image to greyscale using equal weightings:
3374
3375 $new = $img->convert(matrix=>[ [ 0.333, 0.333, 0.334 ] ])
3376
9495ee93
AMH
3377=head2 Color Mappings
3378
3379You can use the map method to map the values of each channel of an
3380image independently using a list of lookup tables. It's important to
3381realize that the modification is made inplace. The function simply
3382returns the input image again or undef on failure.
3383
3384Each channel is mapped independently through a lookup table with 256
3385entries. The elements in the table should not be less than 0 and not
3386greater than 255. If they are out of the 0..255 range they are
3387clamped to the range. If a table does not contain 256 entries it is
3388silently ignored.
3389
3390Single channels can mapped by specifying their name and the mapping
3391table. The channel names are C<red>, C<green>, C<blue>, C<alpha>.
3392
3393 @map = map { int( $_/2 } 0..255;
3394 $img->map( red=>\@map );
3395
3396It is also possible to specify a single map that is applied to all
3397channels, alpha channel included. For example this applies a gamma
3398correction with a gamma of 1.4 to the input image.
3399
3400 $gamma = 1.4;
3401 @map = map { int( 0.5 + 255*($_/255)**$gamma ) } 0..255;
3402 $img->map(all=> \@map);
3403
3404The C<all> map is used as a default channel, if no other map is
3405specified for a channel then the C<all> map is used instead. If we
3406had not wanted to apply gamma to the alpha channel we would have used:
3407
3408 $img->map(all=> \@map, alpha=>[]);
3409
3410Since C<[]> contains fewer than 256 element the gamma channel is
3411unaffected.
3412
3413It is also possible to simply specify an array of maps that are
3414applied to the images in the rgba order. For example to apply
3415maps to the C<red> and C<blue> channels one would use:
3416
3417 $img->map(maps=>[\@redmap, [], \@bluemap]);
3418
3419
3420
02d1d628
AMH
3421=head2 Transformations
3422
3423Another special image method is transform. It can be used to generate
3424warps and rotations and such features. It can be given the operations
3425in postfix notation or the module Affix::Infix2Postfix can be used.
3426Look in the test case t/t55trans.t for an example.
3427
3428transform() needs expressions (or opcodes) that determine the source
3429pixel for each target pixel. Source expressions are infix expressions
3430using any of the +, -, *, / or ** binary operators, the - unary
3431operator, ( and ) for grouping and the sin() and cos() functions. The
3432target pixel is input as the variables x and y.
3433
3434You specify the x and y expressions as xexpr and yexpr respectively.
3435You can also specify opcodes directly, but that's magic deep enough
3436that you can look at the source code.
3437
3438You can still use the transform() function, but the transform2()
3439function is just as fast and is more likely to be enhanced and
3440maintained.
3441
3442Later versions of Imager also support a transform2() class method
3443which allows you perform a more general set of operations, rather than
3444just specifying a spatial transformation as with the transform()
3445method, you can also perform colour transformations, image synthesis
3446and image combinations.
3447
3448transform2() takes an reference to an options hash, and a list of
3449images to operate one (this list may be empty):
3450
3451 my %opts;
3452 my @imgs;
3453 ...
3454 my $img = Imager::transform2(\%opts, @imgs)
3455 or die "transform2 failed: $Imager::ERRSTR";
3456
3457The options hash may define a transformation function, and optionally:
3458
3459=over 4
3460
3461=item *
3462
3463width - the width of the image in pixels. If this isn't supplied the
3464width of the first input image is used. If there are no input images
3465an error occurs.
3466
3467=item *
3468
3469height - the height of the image in pixels. If this isn't supplied
3470the height of the first input image is used. If there are no input
3471images an error occurs.
3472
3473=item *
3474
3475constants - a reference to hash of constants to define for the
3476expression engine. Some extra constants are defined by Imager
3477
3478=back
3479
3480The tranformation function is specified using either the expr or
3481rpnexpr member of the options.
3482
3483=over 4
3484
3485=item Infix expressions
3486
3487You can supply infix expressions to transform 2 with the expr keyword.
3488
3489$opts{expr} = 'return getp1(w-x, h-y)'
3490
3491The 'expression' supplied follows this general grammar:
3492
3493 ( identifier '=' expr ';' )* 'return' expr
3494
3495This allows you to simplify your expressions using variables.
3496
3497A more complex example might be:
3498
3499$opts{expr} = 'pix = getp1(x,y); return if(value(pix)>0.8,pix*0.8,pix)'
3500
3501Currently to use infix expressions you must have the Parse::RecDescent
3502module installed (available from CPAN). There is also what might be a
3503significant delay the first time you run the infix expression parser
3504due to the compilation of the expression grammar.
3505
3506=item Postfix expressions
3507
3508You can supply postfix or reverse-polish notation expressions to
3509transform2() through the rpnexpr keyword.
3510
3511The parser for rpnexpr emulates a stack machine, so operators will
3512expect to see their parameters on top of the stack. A stack machine
3513isn't actually used during the image transformation itself.
3514
3515You can store the value at the top of the stack in a variable called
3516foo using !foo and retrieve that value again using @foo. The !foo
3517notation will pop the value from the stack.
3518
3519An example equivalent to the infix expression above:
3520
3521 $opts{rpnexpr} = 'x y getp1 !pix @pix value 0.8 gt @pix 0.8 * @pix ifp'
3522
3523=back
3524
3525transform2() has a fairly rich range of operators.
3526
3527=over 4
3528
3529=item +, *, -, /, %, **
3530
3531multiplication, addition, subtraction, division, remainder and
3532exponentiation. Multiplication, addition and subtraction can be used
3533on colour values too - though you need to be careful - adding 2 white
3534values together and multiplying by 0.5 will give you grey, not white.
3535
3536Division by zero (or a small number) just results in a large number.
3537Modulo zero (or a small number) results in zero.
3538
3539=item sin(N), cos(N), atan2(y,x)
3540
3541Some basic trig functions. They work in radians, so you can't just
3542use the hue values.
3543
3544=item distance(x1, y1, x2, y2)
3545
3546Find the distance between two points. This is handy (along with
3547atan2()) for producing circular effects.
3548
3549=item sqrt(n)
3550
3551Find the square root. I haven't had much use for this since adding
3552the distance() function.
3553
3554=item abs(n)
3555
3556Find the absolute value.
3557
3558=item getp1(x,y), getp2(x,y), getp3(x, y)
3559
3560Get the pixel at position (x,y) from the first, second or third image
3561respectively. I may add a getpn() function at some point, but this
3562prevents static checking of the instructions against the number of
3563images actually passed in.
3564
3565=item value(c), hue(c), sat(c), hsv(h,s,v)
3566
3567Separates a colour value into it's value (brightness), hue (colour)
3568and saturation elements. Use hsv() to put them back together (after
3569suitable manipulation).
3570
3571=item red(c), green(c), blue(c), rgb(r,g,b)
3572
3573Separates a colour value into it's red, green and blue colours. Use
3574rgb(r,g,b) to put it back together.
3575
3576=item int(n)
3577
3578Convert a value to an integer. Uses a C int cast, so it may break on
3579large values.
3580
3581=item if(cond,ntrue,nfalse), if(cond,ctrue,cfalse)
3582
3583A simple (and inefficient) if function.
3584
3585=item <=,<,==,>=,>,!=
3586
3587Relational operators (typically used with if()). Since we're working
3588with floating point values the equalities are 'near equalities' - an
3589epsilon value is used.
3590
3591=item &&, ||, not(n)
3592
3593Basic logical operators.
3594
3595=back
3596
3597A few examples:
3598
3599=over 4
3600
3601=item rpnexpr=>'x 25 % 15 * y 35 % 10 * getp1 !pat x y getp1 !pix @pix sat 0.7 gt @pat @pix ifp'
3602
9495ee93
AMH
3603tiles a smaller version of the input image over itself where the
3604colour has a saturation over 0.7.
02d1d628
AMH
3605
3606=item rpnexpr=>'x 25 % 15 * y 35 % 10 * getp1 !pat y 360 / !rat x y getp1 1 @rat - pmult @pat @rat pmult padd'
3607
3608tiles the input image over itself so that at the top of the image the
3609full-size image is at full strength and at the bottom the tiling is
3610most visible.
3611
3612=item rpnexpr=>'x y getp1 !pix @pix value 0.96 gt @pix sat 0.1 lt and 128 128 255 rgb @pix ifp'
3613
3614replace pixels that are white or almost white with a palish blue
3615
3616=item rpnexpr=>'x 35 % 10 * y 45 % 8 * getp1 !pat x y getp1 !pix @pix sat 0.2 lt @pix value 0.9 gt and @pix @pat @pix value 2 / 0.5 + pmult ifp'
3617
3618Tiles the input image overitself where the image isn't white or almost
3619white.
3620
3621=item rpnexpr=>'x y 160 180 distance !d y 180 - x 160 - atan2 !a @d 10 / @a + 3.1416 2 * % !a2 @a2 180 * 3.1416 / 1 @a2 sin 1 + 2 / hsv'
3622
3623Produces a spiral.
3624
3625=item rpnexpr=>'x y 160 180 distance !d y 180 - x 160 - atan2 !a @d 10 / @a + 3.1416 2 * % !a2 @a 180 * 3.1416 / 1 @a2 sin 1 + 2 / hsv'
3626
3627A spiral built on top of a colour wheel.
3628
3629=back
3630
3631For details on expression parsing see L<Imager::Expr>. For details on
3632the virtual machine used to transform the images, see
3633L<Imager::regmach.pod>.
3634
faa9b3e7
TC
3635=head2 Matrix Transformations
3636
3637Rather than having to write code in a little language, you can use a
3638matrix to perform transformations, using the matrix_transform()
3639method:
3640
3641 my $im2 = $im->matrix_transform(matrix=>[ -1, 0, $im->getwidth-1,
3642 0, 1, 0,
3643 0, 0, 1 ]);
3644
3645By default the output image will be the same size as the input image,
3646but you can supply the xsize and ysize parameters to change the size.
3647
3648Rather than building matrices by hand you can use the Imager::Matrix2d
3649module to build the matrices. This class has methods to allow you to
3650scale, shear, rotate, translate and reflect, and you can combine these
3651with an overloaded multiplication operator.
3652
3653WARNING: the matrix you provide in the matrix operator transforms the
3654co-ordinates within the B<destination> image to the co-ordinates
3655within the I<source> image. This can be confusing.
3656
3657Since Imager has 3 different fairly general ways of transforming an
3658image spatially, this method also has a yatf() alias. Yet Another
3659Transformation Function.
3660
3661=head2 Masked Images
3662
3663Masked images let you control which pixels are modified in an
3664underlying image. Where the first channel is completely black in the
3665mask image, writes to the underlying image are ignored.
3666
3667For example, given a base image called $img:
3668
3669 my $mask = Imager->new(xsize=>$img->getwidth, ysize=>getheight,
3670 channels=>1);
3671 # ... draw something on the mask
3672 my $maskedimg = $img->masked(mask=>$mask);
3673
3674You can specifiy the region of the underlying image that is masked
3675using the left, top, right and bottom options.
3676
3677If you just want a subset of the image, without masking, just specify
3678the region without specifying a mask.
3679
02d1d628
AMH
3680=head2 Plugins
3681
3682It is possible to add filters to the module without recompiling the
3683module itself. This is done by using DSOs (Dynamic shared object)
3684avaliable on most systems. This way you can maintain our own filters
3685and not have to get me to add it, or worse patch every new version of
3686the Module. Modules can be loaded AND UNLOADED at runtime. This
3687means that you can have a server/daemon thingy that can do something
3688like:
3689
3690 load_plugin("dynfilt/dyntest.so") || die "unable to load plugin\n";
3691 %hsh=(a=>35,b=>200,type=>lin_stretch);
3692 $img->filter(%hsh);
3693 unload_plugin("dynfilt/dyntest.so") || die "unable to load plugin\n";
3694 $img->write(type=>'pnm',file=>'testout/t60.jpg')
3695 || die "error in write()\n";
3696
3697Someone decides that the filter is not working as it should -
3698dyntest.c modified and recompiled.
3699
3700 load_plugin("dynfilt/dyntest.so") || die "unable to load plugin\n";
3701 $img->filter(%hsh);
3702
3703An example plugin comes with the module - Please send feedback to
3704addi@umich.edu if you test this.
3705
3706Note: This seems to test ok on the following systems:
3707Linux, Solaris, HPUX, OpenBSD, FreeBSD, TRU64/OSF1, AIX.
3708If you test this on other systems please let me know.
3709
faa9b3e7
TC
3710=head2 Tags
3711
3712Image tags contain meta-data about the image, ie. information not
3713stored as pixels of the image.
3714
3715At the perl level each tag has a name or code and a value, which is an
3716integer or an arbitrary string. An image can contain more than one
3717tag with the same name or code.
3718
3719You can retrieve tags from an image using the tags() method, you can
3720get all of the tags in an image, as a list of array references, with
3721the code or name of the tag followed by the value of the tag:
3722
3723 my @alltags = $img->tags;
3724
3725or you can get all tags that have a given name:
3726
3727 my @namedtags = $img->tags(name=>$name);
3728
3729or a given code:
3730
3731 my @tags = $img->tags(code=>$code);
3732
3733You can add tags using the addtag() method, either by name:
3734
3735 my $index = $img->addtag(name=>$name, value=>$value);
3736
3737or by code:
3738
3739 my $index = $img->addtag(code=>$code, value=>$value);
3740
3741You can remove tags with the deltag() method, either by index:
3742
3743 $img->deltag(index=>$index);
3744
3745or by name:
3746
3747 $img->deltag(name=>$name);
3748
3749or by code:
3750
3751 $img->deltag(code=>$code);
3752
3753In each case deltag() returns the number of tags deleted.
3754
3755When you read a GIF image using read_multi(), each image can include
3756the following tags:
3757
3758=over
3759
3760=item gif_left
3761
3762the offset of the image from the left of the "screen" ("Image Left
3763Position")
3764
3765=item gif_top
3766
3767the offset of the image from the top of the "screen" ("Image Top Position")
3768
3769=item gif_interlace
3770
3771non-zero if the image was interlaced ("Interlace Flag")
3772
3773=item gif_screen_width
3774
3775=item gif_screen_height
3776
3777the size of the logical screen ("Logical Screen Width",
3778"Logical Screen Height")
3779
3780=item gif_local_map
3781
3782Non-zero if this image had a local color map.
3783
3784=item gif_background
3785
3786The index in the global colormap of the logical screen's background
3787color. This is only set if the current image uses the global
3788colormap.
3789
3790=item gif_trans_index
3791
3792The index of the color in the colormap used for transparency. If the
3793image has a transparency then it is returned as a 4 channel image with
3794the alpha set to zero in this palette entry. ("Transparent Color Index")
3795
3796=item gif_delay
3797
3798The delay until the next frame is displayed, in 1/100 of a second.
3799("Delay Time").
3800
3801=item gif_user_input
3802
3803whether or not a user input is expected before continuing (view dependent)
3804("User Input Flag").
3805
3806=item gif_disposal
3807
3808how the next frame is displayed ("Disposal Method")
3809
3810=item gif_loop
3811
3812the number of loops from the Netscape Loop extension. This may be zero.
3813
3814=item gif_comment
3815
3816the first block of the first gif comment before each image.
3817
3818=back
3819
3820Where applicable, the ("name") is the name of that field from the GIF89
3821standard.
3822
705fd961 3823The following tags are set in a TIFF image when read, and can be set
faa9b3e7
TC
3824to control output:
3825
3826=over
3827
3828=item tiff_resolutionunit
3829
3830The value of the ResolutionUnit tag. This is ignored on writing if
3831the i_aspect_only tag is non-zero.
3832
3833=back
3834
1ec86afa 3835The following tags are set when a Windows BMP file is read:
705fd961
TC
3836
3837=over
3838
3839=item bmp_compression
3840
3841The type of compression, if any.
3842
3843=item bmp_important_colors
3844
3845The number of important colors as defined by the writer of the image.
3846
3847=back
3848
faa9b3e7
TC
3849Some standard tags will be implemented as time goes by:
3850
3851=over
3852
3853=item i_xres
3854
3855=item i_yres
3856
3857The spatial resolution of the image in pixels per inch. If the image
3858format uses a different scale, eg. pixels per meter, then this value
3859is converted. A floating point number stored as a string.
3860
3861=item i_aspect_only
3862
3863If this is non-zero then the values in i_xres and i_yres are treated
3864as a ratio only. If the image format does not support aspect ratios
3865then this is scaled so the smaller value is 72dpi.
3866
3867=back
3868
02d1d628
AMH
3869=head1 BUGS
3870
3871box, arc, circle do not support antialiasing yet. arc, is only filled
3872as of yet. Some routines do not return $self where they should. This
3873affects code like this, C<$img-E<gt>box()-E<gt>arc()> where an object
3874is expected.
3875
3876When saving Gif images the program does NOT try to shave of extra
3877colors if it is possible. If you specify 128 colors and there are
3878only 2 colors used - it will have a 128 colortable anyway.
3879
3880=head1 AUTHOR
3881
9495ee93
AMH
3882Arnar M. Hrafnkelsson, addi@umich.edu, and recently lots of assistance
3883from Tony Cook. See the README for a complete list.
02d1d628 3884
9495ee93 3885=head1 SEE ALSO
02d1d628 3886
faa9b3e7
TC
3887perl(1), Imager::Color(3), Imager::Font(3), Imager::Matrix2d(3),
3888Affix::Infix2Postfix(3), Parse::RecDescent(3)
3889http://www.eecs.umich.edu/~addi/perl/Imager/
02d1d628
AMH
3890
3891=cut