Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 136 lines (100 sloc) 3.312 kB
50c4902 initial version
Tony Cook authored
1 #!perl -w
2 use strict;
3 use Imager;
4
5 my $in0_name = shift;
6 my $in1_name = shift;
7 my $out_name = shift
8 or usage();
9
10 my $in0 = Imager->new;
11 $in0->read(file=>$in0_name)
12 or die "Cannot load $in0_name: ", $in0->errstr, "\n";
13
14 my $in1 = Imager->new;
15 $in1->read(file=>$in1_name)
16 or die "Cannot load $in1_name: ", $in1->errstr, "\n";
17
18 $in0->getwidth == $in1->getwidth
19 && $in0->getheight == $in1->getheight
20 or die "Images must be the same width and height\n";
21
22 $in0->getwidth == $in1->getwidth
23 or die "Images must have the same number of channels\n";
24
25 my $out = interleave_images3($in0, $in1);
26
27 $out->write(file=>$out_name)
28 or die "Cannot write $out_name: ", $out->errstr, "\n";
29
30 sub usage {
31 print <<EOS;
32 Usage: $0 even_image odd_image out_image
33 EOS
34 exit;
35 }
36
37 # this one uses transform2()
38 # see perldoc Imager::Engines
39 sub interleave_images {
40 my ($even, $odd) = @_;
41
42 my $width = $even->getwidth;
43 my $height = 2 * $even->getheight;
44 my $expr = <<EXPR; # if odd get pixel from img2[x,y/2] else from img1[x,y/2]
45 y 2 % x y 2 / getp2 x y 2 / getp1 ifp
46 EXPR
47 my $out = Imager::transform2
48 ({
49 rpnexpr=>$expr,
50 width =>$width,
51 height=>$height
52 },
53 $even, $odd) or die Imager->errstr;
54
55 $out;
56 }
57
58 # i_copyto()
59 # this should really have been possible through the paste method too,
60 # but the paste() interface is too limited for this
61 # so we call i_copyto() directly
62 # http://rt.cpan.org/NoAuth/Bug.html?id=11858
63 # the code as written here does work though
64 sub interleave_images2 {
65 my ($even, $odd) = @_;
66
67 my $width = $even->getwidth;
68 my $out = Imager->new(xsize=>$width, ysize=>2 * $even->getheight,
69 channels => $even->getchannels);
70
71 for my $y (0 .. $even->getheight-1) {
72 Imager::i_copyto($out->{IMG}, $even->{IMG}, 0, $y, $width, $y+1,
73 0, $y*2);
74 Imager::i_copyto($out->{IMG}, $odd->{IMG}, 0, $y, $width, $y+1,
75 0, 1+$y*2);
76 }
77
78 $out;
79 }
80
81 # this version uses the internal i_glin() and i_plin() functions
82 # as of 0.44 the XS for i_glin() has a bug in that it doesn't copy
83 # the returned colors into the returned color objects
84 # http://rt.cpan.org/NoAuth/Bug.html?id=11860
85 sub interleave_images3 {
86 my ($even, $odd) = @_;
87
88 my $width = $even->getwidth;
89 my $out = Imager->new(xsize=>$width, ysize=>2 * $even->getheight,
90 channels => $even->getchannels);
91
92 for my $y (0 .. $even->getheight-1) {
93 my @row = Imager::i_glin($even->{IMG}, 0, $width, $y);
94 Imager::i_plin($out->{IMG}, 0, $y*2, @row);
95
96 @row = Imager::i_glin($odd->{IMG}, 0, $width, $y);
97 Imager::i_plin($out->{IMG}, 0, 1+$y*2, @row);
98 }
99
100 $out;
101 }
102
103 =head1 NAME
104
105 interleave.pl - given two identically sized images create an image twice the height with interleaved rows from the source images.
106
107 =head1 SYNOPSIS
108
44cbcb0 fix the second argument in the synopsis
Tony Cook authored
109 perl interleave.pl even_input odd_input output
50c4902 initial version
Tony Cook authored
110
111 =head1 DESCRIPTION
112
113 This sample produces an output image with interleaved rows from the
114 two input images.
115
116 Multiple implementations are included, including two that revealed
117 bugs or limitations in Imager, to demonstrate some different
118 approaches.
119
120 See http://www.3dexpo.com/interleaved.htm for an example where this
121 might be useful.
122
123 =head1 AUTHOR
124
5b480b1 @tonycoz replace (imager|tony)@imager.perl.org with tonyc@cpan.org
authored
125 Tony Cook <tonyc@cpan.org>
50c4902 initial version
Tony Cook authored
126
5715f7c huge spelling update and spell checking patch
Tony Cook authored
127 =for stopwords Oppenheim
128
50c4902 initial version
Tony Cook authored
129 Thanks to Dan Oppenheim, who provided the impetus for this sample.
130
131 =head1 REVISION
132
133 $Revision$
134
135 =cut
Something went wrong with that request. Please try again.