From: Tony Cook Date: Mon, 14 Mar 2005 02:44:49 +0000 (+0000) Subject: initial version X-Git-Tag: Imager-0.48^2~201 X-Git-Url: http://git.imager.perl.org/imager.git/commitdiff_plain/50c4902821f1aa9ec161c7722ff7ab81ddc601b8 initial version --- diff --git a/samples/interleave.pl b/samples/interleave.pl new file mode 100644 index 00000000..86db3e36 --- /dev/null +++ b/samples/interleave.pl @@ -0,0 +1,133 @@ +#!perl -w +use strict; +use Imager; + +my $in0_name = shift; +my $in1_name = shift; +my $out_name = shift + or usage(); + +my $in0 = Imager->new; +$in0->read(file=>$in0_name) + or die "Cannot load $in0_name: ", $in0->errstr, "\n"; + +my $in1 = Imager->new; +$in1->read(file=>$in1_name) + or die "Cannot load $in1_name: ", $in1->errstr, "\n"; + +$in0->getwidth == $in1->getwidth + && $in0->getheight == $in1->getheight + or die "Images must be the same width and height\n"; + +$in0->getwidth == $in1->getwidth + or die "Images must have the same number of channels\n"; + +my $out = interleave_images3($in0, $in1); + +$out->write(file=>$out_name) + or die "Cannot write $out_name: ", $out->errstr, "\n"; + +sub usage { + print <getwidth; + my $height = 2 * $even->getheight; + my $expr = <$expr, + width =>$width, + height=>$height + }, + $even, $odd) or die Imager->errstr; + + $out; +} + +# i_copyto() +# this should really have been possible through the paste method too, +# but the paste() interface is too limited for this +# so we call i_copyto() directly +# http://rt.cpan.org/NoAuth/Bug.html?id=11858 +# the code as written here does work though +sub interleave_images2 { + my ($even, $odd) = @_; + + my $width = $even->getwidth; + my $out = Imager->new(xsize=>$width, ysize=>2 * $even->getheight, + channels => $even->getchannels); + + for my $y (0 .. $even->getheight-1) { + Imager::i_copyto($out->{IMG}, $even->{IMG}, 0, $y, $width, $y+1, + 0, $y*2); + Imager::i_copyto($out->{IMG}, $odd->{IMG}, 0, $y, $width, $y+1, + 0, 1+$y*2); + } + + $out; +} + +# this version uses the internal i_glin() and i_plin() functions +# as of 0.44 the XS for i_glin() has a bug in that it doesn't copy +# the returned colors into the returned color objects +# http://rt.cpan.org/NoAuth/Bug.html?id=11860 +sub interleave_images3 { + my ($even, $odd) = @_; + + my $width = $even->getwidth; + my $out = Imager->new(xsize=>$width, ysize=>2 * $even->getheight, + channels => $even->getchannels); + + for my $y (0 .. $even->getheight-1) { + my @row = Imager::i_glin($even->{IMG}, 0, $width, $y); + Imager::i_plin($out->{IMG}, 0, $y*2, @row); + + @row = Imager::i_glin($odd->{IMG}, 0, $width, $y); + Imager::i_plin($out->{IMG}, 0, 1+$y*2, @row); + } + + $out; +} + +=head1 NAME + +interleave.pl - given two identically sized images create an image twice the height with interleaved rows from the source images. + +=head1 SYNOPSIS + + perl interleave.pl even_input odd_output output + +=head1 DESCRIPTION + +This sample produces an output image with interleaved rows from the +two input images. + +Multiple implementations are included, including two that revealed +bugs or limitations in Imager, to demonstrate some different +approaches. + +See http://www.3dexpo.com/interleaved.htm for an example where this +might be useful. + +=head1 AUTHOR + +Tony Cook + +Thanks to Dan Oppenheim, who provided the impetus for this sample. + +=head1 REVISION + +$Revision$ + +=cut