Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

file 135 lines (100 sloc) 3.318 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135
#!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 <<EOS;
Usage: $0 even_image odd_image out_image
EOS
  exit;
}

# this one uses transform2()
# see perldoc Imager::Engines
sub interleave_images {
  my ($even, $odd) = @_;

  my $width = $even->getwidth;
  my $height = 2 * $even->getheight;
  my $expr = <<EXPR; # if odd get pixel from img2[x,y/2] else from img1[x,y/2]
y 2 % x y 2 / getp2 x y 2 / getp1 ifp
EXPR
  my $out = Imager::transform2
    ({
      rpnexpr=>$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_input 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 <tony@imager.perl.org>

=for stopwords Oppenheim

Thanks to Dan Oppenheim, who provided the impetus for this sample.

=head1 REVISION

$Revision$

=cut
Something went wrong with that request. Please try again.