samples/interleave.pl

   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
 109   perl interleave.pl even_input odd_input output
 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
 125 Tony Cook <tonyc@cpan.org>
 126
 127 =for stopwords Oppenheim
 128
 129 Thanks to Dan Oppenheim, who provided the impetus for this sample.
 130
 131 =head1 REVISION
 132
 133 $Revision$
 134
 135 =cut