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