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