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