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