Commit | Line | Data |
---|---|---|
02d1d628 AMH |
1 | package Imager; |
2 | ||
02d1d628 AMH |
3 | use strict; |
4 | use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS %formats $DEBUG %filters %DSOs $ERRSTR $fontstate %OPCODES $I2P $FORMATGUESS); | |
5 | use IO::File; | |
6 | ||
7 | use Imager::Color; | |
8 | use 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 |
145 | BEGIN { |
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 | ||
154 | BEGIN { | |
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 | ||
248 | sub 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 | ||
261 | END { | |
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 | ||
272 | sub 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 | ||
295 | sub 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 |
310 | sub _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 | ||
322 | sub 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 | ||
339 | sub 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 | ||
351 | sub 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 | ||
371 | sub 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 | ||
417 | sub 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 | |
443 | sub 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 | |
466 | sub 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 | |
487 | sub 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 | ||
500 | sub 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 | ||
509 | sub 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 | ||
517 | sub 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 | ||
536 | sub colorcount { | |
537 | i_colorcount($_[0]{IMG}); | |
538 | } | |
539 | ||
540 | sub maxcolors { | |
541 | i_maxcolors($_[0]{IMG}); | |
542 | } | |
543 | ||
544 | sub 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 | ||
552 | sub bits { | |
553 | my $self = shift; | |
554 | $self->{IMG} and i_img_bits($self->{IMG}); | |
555 | } | |
556 | ||
557 | sub type { | |
558 | my $self = shift; | |
559 | if ($self->{IMG}) { | |
560 | return i_img_type($self->{IMG}) ? "paletted" : "direct"; | |
561 | } | |
562 | } | |
563 | ||
564 | sub virtual { | |
565 | my $self = shift; | |
566 | $self->{IMG} and i_img_virtual($self->{IMG}); | |
567 | } | |
568 | ||
569 | sub 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 | ||
604 | sub 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 | ||
652 | sub 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 | ||
675 | sub 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 | ||
865 | sub 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 | ||
1002 | sub 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 |
1045 | sub 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 | ||
1120 | sub 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 | ||
1138 | sub 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 | ||
1176 | sub 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 | ||
1208 | sub 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 | ||
1227 | sub 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 | ||
1250 | sub 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 |
1403 | sub 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 |
1418 | sub 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 |
1429 | sub 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 | ||
1474 | sub 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 | ||
1500 | sub i_color_new { | |
faa9b3e7 | 1501 | return Imager::Color->new(@_); |
02d1d628 AMH |
1502 | } |
1503 | ||
1504 | sub 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 |
1509 | sub 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 | ||
1529 | sub 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 | ||
1544 | sub 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 | ||
1564 | sub 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 | ||
1598 | sub 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 |
1621 | sub _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 | |
1632 | sub 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 |
1734 | sub 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 | ||
1757 | sub 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 | ||
1766 | sub 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 | ||
1774 | sub 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 | ||
1782 | sub 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 | ||
1790 | sub 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 | ||
1798 | sub 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 | ||
1807 | sub 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 | ||
1817 | sub 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 | ||
1844 | sub newcolor { Imager::Color->new(@_); } | |
1845 | sub 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 |
1856 | sub errstr { |
1857 | ref $_[0] ? $_[0]->{ERRSTR} : $ERRSTR | |
1858 | } | |
02d1d628 AMH |
1859 | |
1860 | # Default guess for the type of an image from extension | |
1861 | ||
1862 | sub 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 | ||
1877 | sub min { | |
1878 | my $mx=shift; | |
1879 | for(@_) { if ($_<$mx) { $mx=$_; }} | |
1880 | return $mx; | |
1881 | } | |
1882 | ||
1883 | # get the maximum of a list | |
1884 | ||
1885 | sub max { | |
1886 | my $mx=shift; | |
1887 | for(@_) { if ($_>$mx) { $mx=$_; }} | |
1888 | return $mx; | |
1889 | } | |
1890 | ||
1891 | # string stuff for iptc headers | |
1892 | ||
1893 | sub 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 | ||
1905 | sub 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 | ||
1945 | 1; | |
1946 | __END__ | |
1947 | # Below is the stub of documentation for your module. You better edit it! | |
1948 | ||
1949 | =head1 NAME | |
1950 | ||
1951 | Imager - 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 | ||
1967 | Imager is a module for creating and altering images - It is not meant | |
1968 | as a replacement or a competitor to ImageMagick or GD. Both are | |
1969 | excellent packages and well supported. | |
1970 | ||
1971 | =head2 API | |
1972 | ||
1973 | Almost all functions take the parameters in the hash fashion. | |
1974 | Example: | |
1975 | ||
1976 | $img->open(file=>'lena.png',type=>'png'); | |
1977 | ||
1978 | or just: | |
1979 | ||
1980 | $img->open(file=>'lena.png'); | |
1981 | ||
1982 | =head2 Basic concept | |
1983 | ||
1984 | An Image object is created with C<$img = Imager-E<gt>new()> Should | |
1985 | this fail for some reason an explanation can be found in | |
1986 | C<$Imager::ERRSTR> usually error messages are stored in | |
1987 | C<$img-E<gt>{ERRSTR}>, but since no object is created this is the only | |
1988 | way to give back errors. C<$Imager::ERRSTR> is also used to report | |
1989 | all 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 | ||
1994 | or if you want to create an empty image: | |
1995 | ||
1996 | $img=Imager->new(xsize=>400,ysize=>300,channels=>4); | |
1997 | ||
1998 | This example creates a completely black image of width 400 and | |
1999 | height 300 and 4 channels. | |
2000 | ||
2001 | If 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 |
2006 | To create paletted images, set the 'type' parameter to 'paletted': |
2007 | ||
2008 | $img = Imager->new(xsize=>200, ysize=>200, channels=>3, type=>'paletted'); | |
2009 | ||
2010 | which creates an image with a maxiumum of 256 colors, which you can | |
2011 | change by supplying the C<maxcolors> parameter. | |
2012 | ||
2013 | You can create a new paletted image from an existing image using the | |
2014 | to_paletted() method: | |
2015 | ||
2016 | $palimg = $img->to_paletted(\%opts) | |
2017 | ||
2018 | where %opts contains the options specified under L<Quantization options>. | |
2019 | ||
2020 | You can convert a paletted image (or any image) to an 8-bit/channel | |
2021 | RGB image with: | |
2022 | ||
2023 | $rgbimg = $img->to_rgb8; | |
2024 | ||
2025 | Warning: if you draw on a paletted image with colors that aren't in | |
2026 | the palette, the image will be internally converted to a normal image. | |
2027 | ||
2028 | For improved color precision you can use the bits parameter to specify | |
2029 | 16 bites per channel: | |
2030 | ||
2031 | $img = Imager->new(xsize=>200, ysize=>200, channels=>3, bits=>16); | |
2032 | ||
2033 | Note that as of this writing all functions should work on 16-bit | |
2034 | images, but at only 8-bit/channel precision. | |
2035 | ||
2036 | Currently only 8 and 16/bit per channel image types are available, | |
2037 | this may change later. | |
2038 | ||
02d1d628 AMH |
2039 | Color objects are created by calling the Imager::Color->new() |
2040 | method: | |
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 | ||
2046 | This object can then be passed to functions that require a color parameter. | |
2047 | ||
2048 | Coordinates in Imager have the origin in the upper left corner. The | |
2049 | horizontal coordinate increases to the right and the vertical | |
2050 | downwards. | |
2051 | ||
2052 | =head2 Reading and writing images | |
2053 | ||
2054 | C<$img-E<gt>read()> generally takes two parameters, 'file' and 'type'. | |
2055 | If the type of the file can be determined from the suffix of the file | |
2056 | it can be omitted. Format dependant parameters are: For images of | |
2057 | type '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. | |
2059 | gif and png images might have a palette are converted to truecolor bit | |
2060 | when read. Alpha channel is preserved for png images irregardless of | |
2061 | them being in RGB or gray colorspace. Similarly grayscale jpegs are | |
2062 | one channel images after reading them. For jpeg images the iptc | |
2063 | header information (stored in the APP13 header) is avaliable to some | |
2064 | degree. You can get the raw header with C<$img-E<gt>{IPTCRAW}>, but | |
2065 | you can also retrieve the most basic information with | |
d2dfdcc9 TC |
2066 | C<%hsh=$img-E<gt>parseiptc()> as always patches are welcome. pnm has no |
2067 | extra 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 | ||
2076 | The second example shows how to read an image from a scalar, this is | |
2077 | usefull if your data originates from somewhere else than a filesystem | |
2078 | such as a database over a DBI connection. | |
2079 | ||
d2dfdcc9 TC |
2080 | When writing to a tiff image file you can also specify the 'class' |
2081 | parameter, which can currently take a single value, "fax". If class | |
2082 | is set to fax then a tiff image which should be suitable for faxing | |
2083 | will be written. For the best results start with a grayscale image. | |
4c2d6970 TC |
2084 | By default the image is written at fine resolution you can override |
2085 | this by setting the "fax_fine" parameter to 0. | |
d2dfdcc9 | 2086 | |
a59ffd27 TC |
2087 | If you are reading from a gif image file, you can supply a 'colors' |
2088 | parameter which must be a reference to a scalar. The referenced | |
2089 | scalar will receive an array reference which contains the colors, each | |
e72d3bb1 | 2090 | represented as an Imager::Color object. |
a59ffd27 | 2091 | |
04516c2b TC |
2092 | If you already have an open file handle, for example a socket or a |
2093 | pipe, you can specify the 'fd' parameter instead of supplying a | |
2094 | filename. Please be aware that you need to use fileno() to retrieve | |
2095 | the file descriptor for the file: | |
2096 | ||
2097 | $img->read(fd=>fileno(FILE), type=>'gif') or die $img->errstr; | |
2098 | ||
2099 | For writing using the 'fd' option you will probably want to set $| for | |
2100 | that descriptor, since the writes to the file descriptor bypass Perl's | |
2101 | (or the C libraries) buffering. Setting $| should avoid out of order | |
2102 | output. | |
2103 | ||
02d1d628 AMH |
2104 | *Note that load() is now an alias for read but will be removed later* |
2105 | ||
2106 | C<$img-E<gt>write> has the same interface as C<read()>. The earlier | |
2107 | comments on C<read()> for autodetecting filetypes apply. For jpegs | |
2108 | quality can be adjusted via the 'jpegquality' parameter (0-100). The | |
2109 | number of colorplanes in gifs are set with 'gifplanes' and should be | |
2110 | between 1 (2 color) and 8 (256 colors). It is also possible to choose | |
2111 | between two quantizing methods with the parameter 'gifquant'. If set | |
2112 | to mc it uses the mediancut algorithm from either giflibrary. If set | |
2113 | to lm it uses a local means algorithm. It is then possible to give | |
2114 | some extra settings. lmdither is the dither deviation amount in pixels | |
2115 | (manhattan distance). lmfixed can be an array ref who holds an array | |
2116 | of Imager::Color objects. Note that the local means algorithm needs | |
2117 | much more cpu time but also gives considerable better results than the | |
2118 | median cut algorithm. | |
2119 | ||
2120 | Currently just for gif files, you can specify various options for the | |
2121 | conversion from Imager's internal RGB format to the target's indexed | |
2122 | file format. If you set the gifquant option to 'gen', you can use the | |
2123 | options specified under L<Quantization options>. | |
2124 | ||
2125 | To see what Imager is compiled to support the following code snippet | |
2126 | is sufficient: | |
2127 | ||
2128 | use Imager; | |
2129 | print "@{[keys %Imager::formats]}"; | |
2130 | ||
7febf116 TC |
2131 | When reading raw images you need to supply the width and height of the |
2132 | image 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 | ||
2137 | If your input file has more channels than you want, or (as is common), | |
2138 | junk in the fourth channel, you can use the datachannels and | |
2139 | storechannels options to control the number of channels in your input | |
2140 | file and the resulting channels in your image. For example, if your | |
2141 | input image uses 32-bits per pixel with red, green, blue and junk | |
2142 | values 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 |
2148 | Normally the raw image is expected to have the value for channel 1 |
2149 | immediately following channel 0 and channel 2 immediately following | |
2150 | channel 1 for each pixel. If your input image has all the channel 0 | |
2151 | values for the first line of the image, followed by all the channel 1 | |
2152 | values 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 | ||
2159 | Currently just for gif files, you can create files that contain more | |
2160 | than one image. | |
2161 | ||
2162 | To do this: | |
2163 | ||
2164 | Imager->write_multi(\%opts, @images) | |
2165 | ||
b9029e27 | 2166 | Where %opts describes 4 possible types of outputs: |
02d1d628 | 2167 | |
b9029e27 AMH |
2168 | =over 5 |
2169 | ||
2170 | =item type | |
2171 | ||
2172 | This is C<gif> for gif animations. | |
02d1d628 AMH |
2173 | |
2174 | =item callback | |
2175 | ||
2176 | A code reference which is called with a single parameter, the data to | |
2177 | be written. You can also specify $opts{maxbuffer} which is the | |
2178 | maximum amount of data buffered. Note that there can be larger writes | |
2179 | than this if the file library writes larger blocks. A smaller value | |
2180 | maybe useful for writing to a socket for incremental display. | |
2181 | ||
2182 | =item fd | |
2183 | ||
2184 | The file descriptor to save the images to. | |
2185 | ||
2186 | =item file | |
2187 | ||
2188 | The name of the file to write to. | |
2189 | ||
2190 | %opts may also include the keys from L<Gif options> and L<Quantization | |
2191 | options>. | |
2192 | ||
2193 | =back | |
2194 | ||
f5991c03 TC |
2195 | You must also specify the file format using the 'type' option. |
2196 | ||
02d1d628 AMH |
2197 | The current aim is to support other multiple image formats in the |
2198 | future, such as TIFF, and to support reading multiple images from a | |
2199 | single file. | |
2200 | ||
2201 | A 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 |
2211 | You can read multi-image files (currently only GIF files) using the |
2212 | read_multi() method: | |
2213 | ||
2214 | my @imgs = Imager->read_multi(file=>'foo.gif') | |
2215 | or die "Cannot read images: ",Imager->errstr; | |
2216 | ||
2217 | The possible parameters for read_multi() are: | |
2218 | ||
2219 | =over | |
2220 | ||
2221 | =item file | |
2222 | ||
2223 | The name of the file to read in. | |
2224 | ||
2225 | =item fh | |
2226 | ||
2227 | A filehandle to read in. This can be the name of a filehandle, but it | |
2228 | will need the package name, no attempt is currently made to adjust | |
2229 | this to the caller's package. | |
2230 | ||
2231 | =item fd | |
2232 | ||
2233 | The numeric file descriptor of an open file (or socket). | |
2234 | ||
2235 | =item callback | |
2236 | ||
2237 | A function to be called to read in data, eg. reading a blob from a | |
2238 | database incrementally. | |
2239 | ||
2240 | =item data | |
2241 | ||
2242 | The data of the input file in memory. | |
2243 | ||
2244 | =item type | |
2245 | ||
2246 | The type of file. If the file is parameter is given and provides | |
2247 | enough information to guess the type, then this parameter is optional. | |
2248 | ||
2249 | =back | |
2250 | ||
2251 | Note: you cannot use the callback or data parameter with giflib | |
2252 | versions before 4.0. | |
2253 | ||
2254 | When reading from a GIF file with read_multi() the images are returned | |
2255 | as paletted images. | |
2256 | ||
02d1d628 AMH |
2257 | =head2 Gif options |
2258 | ||
2259 | These options can be specified when calling write_multi() for gif | |
2260 | files, 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 | ||
2263 | Note 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 | ||
2270 | Each image in the gif file has it's own palette if this is non-zero. | |
2271 | All but the first image has a local colour table (the first uses the | |
2272 | global colour table. | |
2273 | ||
2274 | =item interlace | |
2275 | ||
2276 | The images are written interlaced if this is non-zero. | |
2277 | ||
2278 | =item gif_delays | |
2279 | ||
2280 | A reference to an array containing the delays between images, in 1/100 | |
2281 | seconds. | |
2282 | ||
ed88b092 TC |
2283 | If you want the same delay for every frame you can simply set this to |
2284 | the delay in 1/100 seconds. | |
2285 | ||
02d1d628 AMH |
2286 | =item gif_user_input |
2287 | ||
2288 | A reference to an array contains user input flags. If the given flag | |
2289 | is non-zero the image viewer should wait for input before displaying | |
2290 | the next image. | |
2291 | ||
2292 | =item gif_disposal | |
2293 | ||
2294 | A reference to an array of image disposal methods. These define what | |
2295 | should be done to the image before displaying the next one. These are | |
2296 | integers, where 0 means unspecified, 1 means the image should be left | |
2297 | in place, 2 means restore to background colour and 3 means restore to | |
2298 | the previous value. | |
2299 | ||
2300 | =item gif_tran_color | |
2301 | ||
2302 | A reference to an Imager::Color object, which is the colour to use for | |
ae235ea6 TC |
2303 | the palette entry used to represent transparency in the palette. You |
2304 | need to set the transp option (see L<Quantization options>) for this | |
2305 | value to be used. | |
02d1d628 AMH |
2306 | |
2307 | =item gif_positions | |
2308 | ||
2309 | A reference to an array of references to arrays which represent screen | |
2310 | positions for each image. | |
2311 | ||
2312 | =item gif_loop_count | |
2313 | ||
2314 | If this is non-zero the Netscape loop extension block is generated, | |
2315 | which makes the animation of the images repeat. | |
2316 | ||
2317 | This is currently unimplemented due to some limitations in giflib. | |
2318 | ||
2319 | =back | |
2320 | ||
2321 | =head2 Quantization options | |
2322 | ||
2323 | These options can be specified when calling write_multi() for gif | |
2324 | files, 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 | ||
2331 | A arrayref of colors that are fixed. Note that some color generators | |
2332 | will ignore this. | |
2333 | ||
2334 | =item transp | |
2335 | ||
2336 | The type of transparency processing to perform for images with an | |
2337 | alpha channel where the output format does not have a proper alpha | |
2338 | channel (eg. gif). This can be any of: | |
2339 | ||
2340 | =over 4 | |
2341 | ||
2342 | =item none | |
2343 | ||
2344 | No transparency processing is done. (default) | |
2345 | ||
2346 | =item threshold | |
2347 | ||
2348 | Pixels more transparent that tr_threshold are rendered as transparent. | |
2349 | ||
2350 | =item errdiff | |
2351 | ||
2352 | An error diffusion dither is done on the alpha channel. Note that | |
2353 | this is independent of the translation performed on the colour | |
2354 | channels, so some combinations may cause undesired artifacts. | |
2355 | ||
2356 | =item ordered | |
2357 | ||
2358 | The ordered dither specified by tr_orddith is performed on the alpha | |
2359 | channel. | |
2360 | ||
2361 | =back | |
2362 | ||
ae235ea6 TC |
2363 | This will only be used if the image has an alpha channel, and if there |
2364 | is space in the palette for a transparency colour. | |
2365 | ||
02d1d628 AMH |
2366 | =item tr_threshold |
2367 | ||
2368 | The highest alpha value at which a pixel will be made transparent when | |
2369 | transp is 'threshold'. (0-255, default 127) | |
2370 | ||
2371 | =item tr_errdiff | |
2372 | ||
2373 | The type of error diffusion to perform on the alpha channel when | |
2374 | transp is 'errdiff'. This can be any defined error diffusion type | |
2375 | except for custom (see errdiff below). | |
2376 | ||
626cabcc | 2377 | =item tr_orddith |
02d1d628 AMH |
2378 | |
2379 | The type of ordered dither to perform on the alpha channel when transp | |
626cabcc | 2380 | is 'ordered'. Possible values are: |
02d1d628 AMH |
2381 | |
2382 | =over 4 | |
2383 | ||
2384 | =item random | |
2385 | ||
529ef1f3 | 2386 | A semi-random map is used. The map is the same each time. |
02d1d628 AMH |
2387 | |
2388 | =item dot8 | |
2389 | ||
2390 | 8x8 dot dither. | |
2391 | ||
2392 | =item dot4 | |
2393 | ||
2394 | 4x4 dot dither | |
2395 | ||
2396 | =item hline | |
2397 | ||
2398 | horizontal line dither. | |
2399 | ||
2400 | =item vline | |
2401 | ||
2402 | vertical line dither. | |
2403 | ||
2404 | =item "/line" | |
2405 | ||
2406 | =item slashline | |
2407 | ||
2408 | diagonal line dither | |
2409 | ||
2410 | =item '\line' | |
2411 | ||
2412 | =item backline | |
2413 | ||
2414 | diagonal line dither | |
2415 | ||
529ef1f3 TC |
2416 | =item tiny |
2417 | ||
2418 | dot matrix dither (currently the default). This is probably the best | |
2419 | for displays (like web pages). | |
2420 | ||
02d1d628 AMH |
2421 | =item custom |
2422 | ||
2423 | A custom dither matrix is used - see tr_map | |
2424 | ||
2425 | =back | |
2426 | ||
2427 | =item tr_map | |
2428 | ||
2429 | When tr_orddith is custom this defines an 8 x 8 matrix of integers | |
2430 | representing the transparency threshold for pixels corresponding to | |
2431 | each position. This should be a 64 element array where the first 8 | |
2432 | entries correspond to the first row of the matrix. Values should be | |
2433 | betweern 0 and 255. | |
2434 | ||
2435 | =item make_colors | |
2436 | ||
2437 | Defines how the quantization engine will build the palette(s). | |
2438 | Currently this is ignored if 'translate' is 'giflib', but that may | |
2439 | change. Possible values are: | |
2440 | ||
2441 | =over 4 | |
2442 | ||
2443 | =item none | |
2444 | ||
2445 | Only colors supplied in 'colors' are used. | |
2446 | ||
2447 | =item webmap | |
2448 | ||
2449 | The web color map is used (need url here.) | |
2450 | ||
2451 | =item addi | |
2452 | ||
2453 | The original code for generating the color map (Addi's code) is used. | |
2454 | ||
2455 | =back | |
2456 | ||
2457 | Other methods may be added in the future. | |
2458 | ||
2459 | =item colors | |
2460 | ||
2461 | A arrayref containing Imager::Color objects, which represents the | |
2462 | starting set of colors to use in translating the images. webmap will | |
2463 | ignore this. The final colors used are copied back into this array | |
2464 | (which is expanded if necessary.) | |
2465 | ||
2466 | =item max_colors | |
2467 | ||
2468 | The maximum number of colors to use in the image. | |
2469 | ||
2470 | =item translate | |
2471 | ||
2472 | The method used to translate the RGB values in the source image into | |
2473 | the colors selected by make_colors. Note that make_colors is ignored | |
2474 | whene translate is 'giflib'. | |
2475 | ||
2476 | Possible values are: | |
2477 | ||
2478 | =over 4 | |
2479 | ||
2480 | =item giflib | |
2481 | ||
2482 | The giflib native quantization function is used. | |
2483 | ||
2484 | =item closest | |
2485 | ||
2486 | The closest color available is used. | |
2487 | ||
2488 | =item perturb | |
2489 | ||
2490 | The pixel color is modified by perturb, and the closest color is chosen. | |
2491 | ||
2492 | =item errdiff | |
2493 | ||
2494 | An error diffusion dither is performed. | |
2495 | ||
2496 | =back | |
2497 | ||
2498 | It's possible other transate values will be added. | |
2499 | ||
2500 | =item errdiff | |
2501 | ||
2502 | The type of error diffusion dither to perform. These values (except | |
2503 | for custom) can also be used in tr_errdif. | |
2504 | ||
2505 | =over 4 | |
2506 | ||
2507 | =item floyd | |
2508 | ||
2509 | Floyd-Steinberg dither | |
2510 | ||
2511 | =item jarvis | |
2512 | ||
2513 | Jarvis, Judice and Ninke dither | |
2514 | ||
2515 | =item stucki | |
2516 | ||
2517 | Stucki dither | |
2518 | ||
2519 | =item custom | |
2520 | ||
2521 | Custom. If you use this you must also set errdiff_width, | |
2522 | errdiff_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 | ||
2534 | When translate is 'errdiff' and errdiff is 'custom' these define a | |
2535 | custom error diffusion map. errdiff_width and errdiff_height define | |
2536 | the size of the map in the arrayref in errdiff_map. errdiff_orig is | |
2537 | an integer which indicates the current pixel position in the top row | |
2538 | of the map. | |
2539 | ||
2540 | =item perturb | |
2541 | ||
2542 | When translate is 'perturb' this is the magnitude of the random bias | |
2543 | applied to each channel of the pixel before it is looked up in the | |
2544 | color table. | |
2545 | ||
2546 | =back | |
2547 | ||
2548 | =head2 Obtaining/setting attributes of images | |
2549 | ||
2550 | To get the size of an image in pixels the C<$img-E<gt>getwidth()> and | |
2551 | C<$img-E<gt>getheight()> are used. | |
2552 | ||
2553 | To get the number of channels in | |
2554 | an 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 | ||
2562 | The mask of an image describes which channels are updated when some | |
2563 | operation is performed on an image. Naturally it is not possible to | |
2564 | apply masks to operations like scaling that alter the dimensions of | |
2565 | images. | |
2566 | ||
2567 | It is possible to have Imager find the number of colors in an image | |
2568 | by using C<$img-E<gt>getcolorcount()>. It requires memory proportionally | |
2569 | to the number of colors in the image so it is possible to have it | |
2570 | stop sooner if you only need to know if there are more than a certain number | |
2571 | of colors in the image. If there are more colors than asked for | |
2572 | the 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 |
2578 | The bits() method retrieves the number of bits used to represent each |
2579 | channel in a pixel, typically 8. The type() method returns either | |
2580 | 'direct' for truecolor images or 'paletted' for paletted images. The | |
2581 | virtual() method returns non-zero if the image contains no actual | |
2582 | pixels, for example masked images. | |
2583 | ||
2584 | =head2 Paletted Images | |
2585 | ||
2586 | In general you can work with paletted images in the same way as RGB | |
2587 | images, except that if you attempt to draw to a paletted image with a | |
2588 | color that is not in the image's palette, the image will be converted | |
2589 | to an RGB image. This means that drawing on a paletted image with | |
2590 | anti-aliasing enabled will almost certainly convert the image to RGB. | |
2591 | ||
2592 | You 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 | ||
2598 | The return value is the index of the first color added, or undef if | |
2599 | adding the colors would overflow the palette. | |
2600 | ||
2601 | Once you have colors in the palette you can overwrite them with the | |
2602 | setcolors() method: | |
2603 | ||
2604 | $img->setcolors(start=>$start, colors=>\@colors); | |
2605 | ||
2606 | Returns true on success. | |
2607 | ||
2608 | To 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 | ||
2617 | To quickly find a color in the palette use findcolor(): | |
2618 | ||
2619 | my $index = $img->findcolor(color=>$color); | |
2620 | ||
2621 | which returns undef on failure, or the index of the color. | |
2622 | ||
2623 | You can get the current palette size with $img->colorcount, and the | |
2624 | maximum size of the palette with $img->maxcolors. | |
2625 | ||
02d1d628 AMH |
2626 | =head2 Drawing Methods |
2627 | ||
2628 | IMPLEMENTATION MORE OR LESS DONE CHECK THE TESTS | |
02d1d628 AMH |
2629 | DOCUMENTATION OF THIS SECTION OUT OF SYNC |
2630 | ||
2631 | It is possible to draw with graphics primitives onto images. Such | |
2632 | primitives include boxes, arcs, circles and lines. A reference | |
2633 | oriented list follows. | |
2634 | ||
2635 | Box: | |
2636 | $img->box(color=>$blue,xmin=>10,ymin=>30,xmax=>200,ymax=>300,filled=>1); | |
2637 | ||
2638 | The above example calls the C<box> method for the image and the box | |
2639 | covers the pixels with in the rectangle specified. If C<filled> is | |
2640 | ommited it is drawn as an outline. If any of the edges of the box are | |
2641 | ommited it will snap to the outer edge of the image in that direction. | |
2642 | Also if a color is omitted a color with (255,255,255,255) is used | |
2643 | instead. | |
2644 | ||
2645 | Arc: | |
2646 | $img->arc(color=>$red, r=20, x=>200, y=>100, d1=>10, d2=>20 ); | |
2647 | ||
2648 | This creates a filled red arc with a 'center' at (200, 100) and spans | |
2649 | 10 degrees and the slice has a radius of 20. SEE section on BUGS. | |
2650 | ||
2651 | Circle: | |
2652 | $img->circle(color=>$green, r=50, x=>200, y=>100); | |
2653 | ||
2654 | This creates a green circle with its center at (200, 100) and has a | |
2655 | radius of 20. | |
2656 | ||
2657 | Line: | |
2658 | $img->line(color=>$green, x1=10, x2=>100, | |
2659 | y1=>20, y2=>50, antialias=>1 ); | |
2660 | ||
2661 | That draws an antialiased line from (10,100) to (20,50). | |
2662 | ||
2663 | Polyline: | |
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 | ||
2667 | Polyline is used to draw multilple lines between a series of points. | |
2668 | The point set can either be specified as an arrayref to an array of | |
2669 | array references (where each such array represents a point). The | |
2670 | other way is to specify two array references. | |
2671 | ||
2672 | =head2 Text rendering | |
2673 | ||
2674 | Text rendering is described in the Imager::Font manpage. | |
2675 | ||
2676 | =head2 Image resizing | |
2677 | ||
2678 | To scale an image so porportions are maintained use the | |
2679 | C<$img-E<gt>scale()> method. if you give either a xpixels or ypixels | |
2680 | parameter they will determine the width or height respectively. If | |
2681 | both are given the one resulting in a larger image is used. example: | |
2682 | C<$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 | ||
2692 | if you want to create low quality previews of images you can pass | |
2693 | C<qtype=E<gt>'preview'> to scale and it will use nearest neighbor | |
2694 | sampling instead of filtering. It is much faster but also generates | |
2695 | worse looking images - especially if the original has a lot of sharp | |
2696 | variations and the scaled image is by more than 3-5 times smaller than | |
2697 | the original. | |
2698 | ||
2699 | If you need to scale images per axis it is best to do it simply by | |
2700 | calling scaleX and scaleY. You can pass either 'scalefactor' or | |
2701 | 'pixels' to both functions. | |
2702 | ||
2703 | Another way to resize an image size is to crop it. The parameters | |
2704 | to crop are the edges of the area that you want in the returned image. | |
2705 | If 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 | ||
2711 | You can also specify width and height parameters which will produce a | |
2712 | new image cropped from the center of the input image, with the given | |
2713 | width and height. | |
2714 | ||
2715 | $newimg = $img->crop(width=>50, height=>50); | |
2716 | ||
2717 | The width and height parameters take precedence over the left/right | |
2718 | and top/bottom parameters respectively. | |
2719 | ||
2720 | =head2 Copying images | |
2721 | ||
2722 | To create a copy of an image use the C<copy()> method. This is usefull | |
2723 | if you want to keep an original after doing something that changes the image | |
2724 | inplace like writing text. | |
2725 | ||
2726 | $img=$orig->copy(); | |
2727 | ||
2728 | To copy an image to onto another image use the C<paste()> method. | |
2729 | ||
2730 | $dest->paste(left=>40,top=>20,img=>$logo); | |
2731 | ||
2732 | That copies the entire C<$logo> image onto the C<$dest> image so that the | |
2733 | upper left corner of the C<$logo> image is at (40,20). | |
2734 | ||
142c26ff AMH |
2735 | |
2736 | =head2 Flipping images | |
2737 | ||
2738 | An inplace horizontal or vertical flip is possible by calling the | |
9191e525 AMH |
2739 | C<flip()> method. If the original is to be preserved it's possible to |
2740 | make a copy first. The only parameter it takes is the C<dir> | |
2741 | parameter 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 | ||
2749 | Use the rotate() method to rotate an image. | |
2750 | ||
2751 | To rotate by an exact amount in degrees or radians, use the 'degrees' | |
2752 | or 'radians' parameter: | |
2753 | ||
2754 | my $rot20 = $img->rotate(degrees=>20); | |
2755 | my $rotpi4 = $img->rotate(radians=>3.14159265/4); | |
2756 | ||
2757 | To rotate in steps of 90 degrees, use the 'right' parameter: | |
2758 | ||
2759 | my $rotated = $img->rotate(right=>270); | |
2760 | ||
2761 | Rotations are clockwise for positive values. | |
2762 | ||
9191e525 | 2763 | =head2 Blending Images |
142c26ff | 2764 | |
9191e525 | 2765 | To put an image or a part of an image directly |
142c26ff AMH |
2766 | into another it is best to call the C<paste()> method on the image you |
2767 | want to add to. | |
02d1d628 AMH |
2768 | |
2769 | $img->paste(img=>$srcimage,left=>30,top=>50); | |
2770 | ||
2771 | That will take paste C<$srcimage> into C<$img> with the upper | |
2772 | left corner at (30,50). If no values are given for C<left> | |
2773 | or C<top> they will default to 0. | |
2774 | ||
2775 | A more complicated way of blending images is where one image is | |
2776 | put 'over' the other with a certain amount of opaqueness. The | |
2777 | method that does this is rubthrough. | |
2778 | ||
2779 | $img->rubthrough(src=>$srcimage,tx=>30,ty=>50); | |
2780 | ||
faa9b3e7 TC |
2781 | That will take the image C<$srcimage> and overlay it with the upper |
2782 | left corner at (30,50). You can rub 2 or 4 channel images onto a 3 | |
2783 | channel image, or a 2 channel image onto a 1 channel image. The last | |
2784 | channel is used as an alpha channel. | |
02d1d628 AMH |
2785 | |
2786 | ||
2787 | =head2 Filters | |
2788 | ||
2789 | A special image method is the filter method. An example is: | |
2790 | ||
2791 | $img->filter(type=>'autolevels'); | |
2792 | ||
2793 | This will call the autolevels filter. Here is a list of the filters | |
2794 | that are always avaliable in Imager. This list can be obtained by | |
2795 | running the C<filterlist.perl> script that comes with the module | |
2796 | source. | |
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 | |
2809 | The default values are in parenthesis. All parameters must have some | |
2810 | value but if a parameter has a default value it may be omitted when | |
2811 | calling the filter function. | |
2812 | ||
faa9b3e7 TC |
2813 | The filters are: |
2814 | ||
2815 | =over | |
2816 | ||
2817 | =item autolevels | |
2818 | ||
2819 | scales the value of each channel so that the values in the image will | |
2820 | cover the whole possible range for the channel. I<lsat> and I<usat> | |
2821 | truncate the range by the specified fraction at the top and bottom of | |
2822 | the range respectivly.. | |
2823 | ||
2824 | =item contrast | |
2825 | ||
2826 | scales each channel by I<intensity>. Values of I<intensity> < 1.0 | |
2827 | will reduce the contrast. | |
2828 | ||
2829 | =item conv | |
2830 | ||
2831 | performs 2 1-dimensional convolutions on the image using the values | |
2832 | from I<coef>. I<coef> should be have an odd length. | |
2833 | ||
2834 | =item gaussian | |
2835 | ||
2836 | performs a gaussian blur of the image, using I<stddev> as the standard | |
2837 | deviation of the curve used to combine pixels, larger values give | |
2838 | bigger 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 | ||
2844 | renders a gradient, with the given I<colors> at the corresponding | |
2845 | points (x,y) in I<xo> and I<yo>. You can specify the way distance is | |
2846 | measured for color blendeing by setting I<dist> to 0 for Euclidean, 1 | |
2847 | for Euclidean squared, and 2 for Manhattan distance. | |
2848 | ||
2849 | =item hardinvert | |
2850 | ||
2851 | inverts the image, black to white, white to black. All channels are | |
2852 | inverted, including the alpha channel if any. | |
2853 | ||
2854 | =item noise | |
2855 | ||
2856 | adds noise of the given I<amount> to the image. If I<subtype> is | |
2857 | zero, the noise is even to each channel, otherwise noise is added to | |
2858 | each channel independently. | |
2859 | ||
2860 | =item radnoise | |
2861 | ||
2862 | renders 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 , | |
2864 | and I<rscale> the radial scale, higher numbers give more detail. | |
2865 | ||
2866 | =item turbnoise | |
2867 | ||
2868 | renders Perlin turbulent noise. (I<xo>, I<yo>) controls the origin of | |
2869 | the noise, and I<scale> the scale of the noise, with lower numbers | |
2870 | giving more detail. | |
2871 | ||
2872 | =back | |
2873 | ||
2874 | A 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 | ||
2882 | You can use the convert method to transform the color space of an | |
2883 | image using a matrix. For ease of use some presets are provided. | |
2884 | ||
2885 | The convert method can be used to: | |
2886 | ||
2887 | =over 4 | |
2888 | ||
2889 | =item * | |
2890 | ||
2891 | convert an RGB or RGBA image to grayscale. | |
2892 | ||
2893 | =item * | |
2894 | ||
2895 | convert a grayscale image to RGB. | |
2896 | ||
2897 | =item * | |
2898 | ||
2899 | extract a single channel from an image. | |
2900 | ||
2901 | =item * | |
2902 | ||
2903 | set a given channel to a particular value (or from another channel) | |
2904 | ||
2905 | =back | |
2906 | ||
2907 | The currently defined presets are: | |
2908 | ||
2909 | =over | |
2910 | ||
2911 | =item gray | |
2912 | ||
2913 | =item grey | |
2914 | ||
2915 | converts an RGBA image into a grayscale image with alpha channel, or | |
2916 | an RGB image into a grayscale image without an alpha channel. | |
2917 | ||
2918 | This weights the RGB channels at 22.2%, 70.7% and 7.1% respectively. | |
2919 | ||
2920 | =item noalpha | |
2921 | ||
2922 | removes the alpha channel from a 2 or 4 channel image. An identity | |
2923 | for other images. | |
2924 | ||
2925 | =item red | |
2926 | ||
2927 | =item channel0 | |
2928 | ||
2929 | extracts the first channel of the image into a single channel image | |
2930 | ||
2931 | =item green | |
2932 | ||
2933 | =item channel1 | |
2934 | ||
2935 | extracts the second channel of the image into a single channel image | |
2936 | ||
2937 | =item blue | |
2938 | ||
2939 | =item channel2 | |
2940 | ||
2941 | extracts the third channel of the image into a single channel image | |
2942 | ||
2943 | =item alpha | |
2944 | ||
2945 | extracts the alpha channel of the image into a single channel image. | |
2946 | ||
2947 | If the image has 1 or 3 channels (assumed to be grayscale of RGB) then | |
2948 | the resulting image will be all white. | |
2949 | ||
2950 | =item rgb | |
2951 | ||
2952 | converts a grayscale image to RGB, preserving the alpha channel if any | |
2953 | ||
2954 | =item addalpha | |
2955 | ||
2956 | adds an alpha channel to a grayscale or RGB image. Preserves an | |
2957 | existing alpha channel for a 2 or 4 channel image. | |
2958 | ||
2959 | =back | |
2960 | ||
2961 | For example, to convert an RGB image into a greyscale image: | |
2962 | ||
2963 | $new = $img->convert(preset=>'grey'); # or gray | |
2964 | ||
2965 | or to convert a grayscale image to an RGB image: | |
2966 | ||
2967 | $new = $img->convert(preset=>'rgb'); | |
2968 | ||
2969 | The presets aren't necessary simple constants in the code, some are | |
2970 | generated based on the number of channels in the input image. | |
2971 | ||
2972 | If you want to perform some other colour transformation, you can use | |
2973 | the 'matrix' parameter. | |
2974 | ||
2975 | For 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 | ||
2982 | So 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 | ||
2988 | or 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 | ||
2994 | You can use the map method to map the values of each channel of an | |
2995 | image independently using a list of lookup tables. It's important to | |
2996 | realize that the modification is made inplace. The function simply | |
2997 | returns the input image again or undef on failure. | |
2998 | ||
2999 | Each channel is mapped independently through a lookup table with 256 | |
3000 | entries. The elements in the table should not be less than 0 and not | |
3001 | greater than 255. If they are out of the 0..255 range they are | |
3002 | clamped to the range. If a table does not contain 256 entries it is | |
3003 | silently ignored. | |
3004 | ||
3005 | Single channels can mapped by specifying their name and the mapping | |
3006 | table. 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 | ||
3011 | It is also possible to specify a single map that is applied to all | |
3012 | channels, alpha channel included. For example this applies a gamma | |
3013 | correction 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 | ||
3019 | The C<all> map is used as a default channel, if no other map is | |
3020 | specified for a channel then the C<all> map is used instead. If we | |
3021 | had not wanted to apply gamma to the alpha channel we would have used: | |
3022 | ||
3023 | $img->map(all=> \@map, alpha=>[]); | |
3024 | ||
3025 | Since C<[]> contains fewer than 256 element the gamma channel is | |
3026 | unaffected. | |
3027 | ||
3028 | It is also possible to simply specify an array of maps that are | |
3029 | applied to the images in the rgba order. For example to apply | |
3030 | maps 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 | ||
3038 | Another special image method is transform. It can be used to generate | |
3039 | warps and rotations and such features. It can be given the operations | |
3040 | in postfix notation or the module Affix::Infix2Postfix can be used. | |
3041 | Look in the test case t/t55trans.t for an example. | |
3042 | ||
3043 | transform() needs expressions (or opcodes) that determine the source | |
3044 | pixel for each target pixel. Source expressions are infix expressions | |
3045 | using any of the +, -, *, / or ** binary operators, the - unary | |
3046 | operator, ( and ) for grouping and the sin() and cos() functions. The | |
3047 | target pixel is input as the variables x and y. | |
3048 | ||
3049 | You specify the x and y expressions as xexpr and yexpr respectively. | |
3050 | You can also specify opcodes directly, but that's magic deep enough | |
3051 | that you can look at the source code. | |
3052 | ||
3053 | You can still use the transform() function, but the transform2() | |
3054 | function is just as fast and is more likely to be enhanced and | |
3055 | maintained. | |
3056 | ||
3057 | Later versions of Imager also support a transform2() class method | |
3058 | which allows you perform a more general set of operations, rather than | |
3059 | just specifying a spatial transformation as with the transform() | |
3060 | method, you can also perform colour transformations, image synthesis | |
3061 | and image combinations. | |
3062 | ||
3063 | transform2() takes an reference to an options hash, and a list of | |
3064 | images 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 | ||
3072 | The options hash may define a transformation function, and optionally: | |
3073 | ||
3074 | =over 4 | |
3075 | ||
3076 | =item * | |
3077 | ||
3078 | width - the width of the image in pixels. If this isn't supplied the | |
3079 | width of the first input image is used. If there are no input images | |
3080 | an error occurs. | |
3081 | ||
3082 | =item * | |
3083 | ||
3084 | height - the height of the image in pixels. If this isn't supplied | |
3085 | the height of the first input image is used. If there are no input | |
3086 | images an error occurs. | |
3087 | ||
3088 | =item * | |
3089 | ||
3090 | constants - a reference to hash of constants to define for the | |
3091 | expression engine. Some extra constants are defined by Imager | |
3092 | ||
3093 | =back | |
3094 | ||
3095 | The tranformation function is specified using either the expr or | |
3096 | rpnexpr member of the options. | |
3097 | ||
3098 | =over 4 | |
3099 | ||
3100 | =item Infix expressions | |
3101 | ||
3102 | You can supply infix expressions to transform 2 with the expr keyword. | |
3103 | ||
3104 | $opts{expr} = 'return getp1(w-x, h-y)' | |
3105 | ||
3106 | The 'expression' supplied follows this general grammar: | |
3107 | ||
3108 | ( identifier '=' expr ';' )* 'return' expr | |
3109 | ||
3110 | This allows you to simplify your expressions using variables. | |
3111 | ||
3112 | A more complex example might be: | |
3113 | ||
3114 | $opts{expr} = 'pix = getp1(x,y); return if(value(pix)>0.8,pix*0.8,pix)' | |
3115 | ||
3116 | Currently to use infix expressions you must have the Parse::RecDescent | |
3117 | module installed (available from CPAN). There is also what might be a | |
3118 | significant delay the first time you run the infix expression parser | |
3119 | due to the compilation of the expression grammar. | |
3120 | ||
3121 | =item Postfix expressions | |
3122 | ||
3123 | You can supply postfix or reverse-polish notation expressions to | |
3124 | transform2() through the rpnexpr keyword. | |
3125 | ||
3126 | The parser for rpnexpr emulates a stack machine, so operators will | |
3127 | expect to see their parameters on top of the stack. A stack machine | |
3128 | isn't actually used during the image transformation itself. | |
3129 | ||
3130 | You can store the value at the top of the stack in a variable called | |
3131 | foo using !foo and retrieve that value again using @foo. The !foo | |
3132 | notation will pop the value from the stack. | |
3133 | ||
3134 | An 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 | ||
3140 | transform2() has a fairly rich range of operators. | |
3141 | ||
3142 | =over 4 | |
3143 | ||
3144 | =item +, *, -, /, %, ** | |
3145 | ||
3146 | multiplication, addition, subtraction, division, remainder and | |
3147 | exponentiation. Multiplication, addition and subtraction can be used | |
3148 | on colour values too - though you need to be careful - adding 2 white | |
3149 | values together and multiplying by 0.5 will give you grey, not white. | |
3150 | ||
3151 | Division by zero (or a small number) just results in a large number. | |
3152 | Modulo zero (or a small number) results in zero. | |
3153 | ||
3154 | =item sin(N), cos(N), atan2(y,x) | |
3155 | ||
3156 | Some basic trig functions. They work in radians, so you can't just | |
3157 | use the hue values. | |
3158 | ||
3159 | =item distance(x1, y1, x2, y2) | |
3160 | ||
3161 | Find the distance between two points. This is handy (along with | |
3162 | atan2()) for producing circular effects. | |
3163 | ||
3164 | =item sqrt(n) | |
3165 | ||
3166 | Find the square root. I haven't had much use for this since adding | |
3167 | the distance() function. | |
3168 | ||
3169 | =item abs(n) | |
3170 | ||
3171 | Find the absolute value. | |
3172 | ||
3173 | =item getp1(x,y), getp2(x,y), getp3(x, y) | |
3174 | ||
3175 | Get the pixel at position (x,y) from the first, second or third image | |
3176 | respectively. I may add a getpn() function at some point, but this | |
3177 | prevents static checking of the instructions against the number of | |
3178 | images actually passed in. | |
3179 | ||
3180 | =item value(c), hue(c), sat(c), hsv(h,s,v) | |
3181 | ||
3182 | Separates a colour value into it's value (brightness), hue (colour) | |
3183 | and saturation elements. Use hsv() to put them back together (after | |
3184 | suitable manipulation). | |
3185 | ||
3186 | =item red(c), green(c), blue(c), rgb(r,g,b) | |
3187 | ||
3188 | Separates a colour value into it's red, green and blue colours. Use | |
3189 | rgb(r,g,b) to put it back together. | |
3190 | ||
3191 | =item int(n) | |
3192 | ||
3193 | Convert a value to an integer. Uses a C int cast, so it may break on | |
3194 | large values. | |
3195 | ||
3196 | =item if(cond,ntrue,nfalse), if(cond,ctrue,cfalse) | |
3197 | ||
3198 | A simple (and inefficient) if function. | |
3199 | ||
3200 | =item <=,<,==,>=,>,!= | |
3201 | ||
3202 | Relational operators (typically used with if()). Since we're working | |
3203 | with floating point values the equalities are 'near equalities' - an | |
3204 | epsilon value is used. | |
3205 | ||
3206 | =item &&, ||, not(n) | |
3207 | ||
3208 | Basic logical operators. | |
3209 | ||
3210 | =back | |
3211 | ||
3212 | A 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 |
3218 | tiles a smaller version of the input image over itself where the |
3219 | colour 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 | ||
3223 | tiles the input image over itself so that at the top of the image the | |
3224 | full-size image is at full strength and at the bottom the tiling is | |
3225 | most 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 | ||
3229 | replace 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 | ||
3233 | Tiles the input image overitself where the image isn't white or almost | |
3234 | white. | |
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 | ||
3238 | Produces 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 | ||
3242 | A spiral built on top of a colour wheel. | |
3243 | ||
3244 | =back | |
3245 | ||
3246 | For details on expression parsing see L<Imager::Expr>. For details on | |
3247 | the virtual machine used to transform the images, see | |
3248 | L<Imager::regmach.pod>. | |
3249 | ||
faa9b3e7 TC |
3250 | =head2 Matrix Transformations |
3251 | ||
3252 | Rather than having to write code in a little language, you can use a | |
3253 | matrix to perform transformations, using the matrix_transform() | |
3254 | method: | |
3255 | ||
3256 | my $im2 = $im->matrix_transform(matrix=>[ -1, 0, $im->getwidth-1, | |
3257 | 0, 1, 0, | |
3258 | 0, 0, 1 ]); | |
3259 | ||
3260 | By default the output image will be the same size as the input image, | |
3261 | but you can supply the xsize and ysize parameters to change the size. | |
3262 | ||
3263 | Rather than building matrices by hand you can use the Imager::Matrix2d | |
3264 | module to build the matrices. This class has methods to allow you to | |
3265 | scale, shear, rotate, translate and reflect, and you can combine these | |
3266 | with an overloaded multiplication operator. | |
3267 | ||
3268 | WARNING: the matrix you provide in the matrix operator transforms the | |
3269 | co-ordinates within the B<destination> image to the co-ordinates | |
3270 | within the I<source> image. This can be confusing. | |
3271 | ||
3272 | Since Imager has 3 different fairly general ways of transforming an | |
3273 | image spatially, this method also has a yatf() alias. Yet Another | |
3274 | Transformation Function. | |
3275 | ||
3276 | =head2 Masked Images | |
3277 | ||
3278 | Masked images let you control which pixels are modified in an | |
3279 | underlying image. Where the first channel is completely black in the | |
3280 | mask image, writes to the underlying image are ignored. | |
3281 | ||
3282 | For 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 | ||
3289 | You can specifiy the region of the underlying image that is masked | |
3290 | using the left, top, right and bottom options. | |
3291 | ||
3292 | If you just want a subset of the image, without masking, just specify | |
3293 | the region without specifying a mask. | |
3294 | ||
02d1d628 AMH |
3295 | =head2 Plugins |
3296 | ||
3297 | It is possible to add filters to the module without recompiling the | |
3298 | module itself. This is done by using DSOs (Dynamic shared object) | |
3299 | avaliable on most systems. This way you can maintain our own filters | |
3300 | and not have to get me to add it, or worse patch every new version of | |
3301 | the Module. Modules can be loaded AND UNLOADED at runtime. This | |
3302 | means that you can have a server/daemon thingy that can do something | |
3303 | like: | |
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 | ||
3312 | Someone decides that the filter is not working as it should - | |
3313 | dyntest.c modified and recompiled. | |
3314 | ||
3315 | load_plugin("dynfilt/dyntest.so") || die "unable to load plugin\n"; | |
3316 | $img->filter(%hsh); | |
3317 | ||
3318 | An example plugin comes with the module - Please send feedback to | |
3319 | addi@umich.edu if you test this. | |
3320 | ||
3321 | Note: This seems to test ok on the following systems: | |
3322 | Linux, Solaris, HPUX, OpenBSD, FreeBSD, TRU64/OSF1, AIX. | |
3323 | If you test this on other systems please let me know. | |
3324 | ||
faa9b3e7 TC |
3325 | =head2 Tags |
3326 | ||
3327 | Image tags contain meta-data about the image, ie. information not | |
3328 | stored as pixels of the image. | |
3329 | ||
3330 | At the perl level each tag has a name or code and a value, which is an | |
3331 | integer or an arbitrary string. An image can contain more than one | |
3332 | tag with the same name or code. | |
3333 | ||
3334 | You can retrieve tags from an image using the tags() method, you can | |
3335 | get all of the tags in an image, as a list of array references, with | |
3336 | the code or name of the tag followed by the value of the tag: | |
3337 | ||
3338 | my @alltags = $img->tags; | |
3339 | ||
3340 | or you can get all tags that have a given name: | |
3341 | ||
3342 | my @namedtags = $img->tags(name=>$name); | |
3343 | ||
3344 | or a given code: | |
3345 | ||
3346 | my @tags = $img->tags(code=>$code); | |
3347 | ||
3348 | You can add tags using the addtag() method, either by name: | |
3349 | ||
3350 | my $index = $img->addtag(name=>$name, value=>$value); | |
3351 | ||
3352 | or by code: | |
3353 | ||
3354 | my $index = $img->addtag(code=>$code, value=>$value); | |
3355 | ||
3356 | You can remove tags with the deltag() method, either by index: | |
3357 | ||
3358 | $img->deltag(index=>$index); | |
3359 | ||
3360 | or by name: | |
3361 | ||
3362 | $img->deltag(name=>$name); | |
3363 | ||
3364 | or by code: | |
3365 | ||
3366 | $img->deltag(code=>$code); | |
3367 | ||
3368 | In each case deltag() returns the number of tags deleted. | |
3369 | ||
3370 | When you read a GIF image using read_multi(), each image can include | |
3371 | the following tags: | |
3372 | ||
3373 | =over | |
3374 | ||
3375 | =item gif_left | |
3376 | ||
3377 | the offset of the image from the left of the "screen" ("Image Left | |
3378 | Position") | |
3379 | ||
3380 | =item gif_top | |
3381 | ||
3382 | the offset of the image from the top of the "screen" ("Image Top Position") | |
3383 | ||
3384 | =item gif_interlace | |
3385 | ||
3386 | non-zero if the image was interlaced ("Interlace Flag") | |
3387 | ||
3388 | =item gif_screen_width | |
3389 | ||
3390 | =item gif_screen_height | |
3391 | ||
3392 | the size of the logical screen ("Logical Screen Width", | |
3393 | "Logical Screen Height") | |
3394 | ||
3395 | =item gif_local_map | |
3396 | ||
3397 | Non-zero if this image had a local color map. | |
3398 | ||
3399 | =item gif_background | |
3400 | ||
3401 | The index in the global colormap of the logical screen's background | |
3402 | color. This is only set if the current image uses the global | |
3403 | colormap. | |
3404 | ||
3405 | =item gif_trans_index | |
3406 | ||
3407 | The index of the color in the colormap used for transparency. If the | |
3408 | image has a transparency then it is returned as a 4 channel image with | |
3409 | the alpha set to zero in this palette entry. ("Transparent Color Index") | |
3410 | ||
3411 | =item gif_delay | |
3412 | ||
3413 | The delay until the next frame is displayed, in 1/100 of a second. | |
3414 | ("Delay Time"). | |
3415 | ||
3416 | =item gif_user_input | |
3417 | ||
3418 | whether or not a user input is expected before continuing (view dependent) | |
3419 | ("User Input Flag"). | |
3420 | ||
3421 | =item gif_disposal | |
3422 | ||
3423 | how the next frame is displayed ("Disposal Method") | |
3424 | ||
3425 | =item gif_loop | |
3426 | ||
3427 | the number of loops from the Netscape Loop extension. This may be zero. | |
3428 | ||
3429 | =item gif_comment | |
3430 | ||
3431 | the first block of the first gif comment before each image. | |
3432 | ||
3433 | =back | |
3434 | ||
3435 | Where applicable, the ("name") is the name of that field from the GIF89 | |
3436 | standard. | |
3437 | ||
705fd961 | 3438 | The following tags are set in a TIFF image when read, and can be set |
faa9b3e7 TC |
3439 | to control output: |
3440 | ||
3441 | =over | |
3442 | ||
3443 | =item tiff_resolutionunit | |
3444 | ||
3445 | The value of the ResolutionUnit tag. This is ignored on writing if | |
3446 | the i_aspect_only tag is non-zero. | |
3447 | ||
3448 | =back | |
3449 | ||
705fd961 TC |
3450 | The following tags are set when reading a Windows BMP file is read: |
3451 | ||
3452 | =over | |
3453 | ||
3454 | =item bmp_compression | |
3455 | ||
3456 | The type of compression, if any. | |
3457 | ||
3458 | =item bmp_important_colors | |
3459 | ||
3460 | The number of important colors as defined by the writer of the image. | |
3461 | ||
3462 | =back | |
3463 | ||
faa9b3e7 TC |
3464 | Some standard tags will be implemented as time goes by: |
3465 | ||
3466 | =over | |
3467 | ||
3468 | =item i_xres | |
3469 | ||
3470 | =item i_yres | |
3471 | ||
3472 | The spatial resolution of the image in pixels per inch. If the image | |
3473 | format uses a different scale, eg. pixels per meter, then this value | |
3474 | is converted. A floating point number stored as a string. | |
3475 | ||
3476 | =item i_aspect_only | |
3477 | ||
3478 | If this is non-zero then the values in i_xres and i_yres are treated | |
3479 | as a ratio only. If the image format does not support aspect ratios | |
3480 | then this is scaled so the smaller value is 72dpi. | |
3481 | ||
3482 | =back | |
3483 | ||
02d1d628 AMH |
3484 | =head1 BUGS |
3485 | ||
3486 | box, arc, circle do not support antialiasing yet. arc, is only filled | |
3487 | as of yet. Some routines do not return $self where they should. This | |
3488 | affects code like this, C<$img-E<gt>box()-E<gt>arc()> where an object | |
3489 | is expected. | |
3490 | ||
3491 | When saving Gif images the program does NOT try to shave of extra | |
3492 | colors if it is possible. If you specify 128 colors and there are | |
3493 | only 2 colors used - it will have a 128 colortable anyway. | |
3494 | ||
3495 | =head1 AUTHOR | |
3496 | ||
9495ee93 AMH |
3497 | Arnar M. Hrafnkelsson, addi@umich.edu, and recently lots of assistance |
3498 | from Tony Cook. See the README for a complete list. | |
02d1d628 | 3499 | |
9495ee93 | 3500 | =head1 SEE ALSO |
02d1d628 | 3501 | |
faa9b3e7 TC |
3502 | perl(1), Imager::Color(3), Imager::Font(3), Imager::Matrix2d(3), |
3503 | Affix::Infix2Postfix(3), Parse::RecDescent(3) | |
3504 | http://www.eecs.umich.edu/~addi/perl/Imager/ | |
02d1d628 AMH |
3505 | |
3506 | =cut |