File: //bin/ppmfade
#!/bin/sh
##############################################################################
# This is essentially a Perl program. We exec the Perl interpreter specifying
# this same file as the Perl program and use the -x option to cause the Perl
# interpreter to skip down to the Perl code. The reason we do this instead of
# just making /usr/bin/perl the script interpreter (instead of /bin/sh) is
# that the user may have multiple Perl interpreters and the one he wants to
# use is properly located in the PATH. The user's choice of Perl interpreter
# may be crucial, such as when the user also has a PERL5LIB environment
# variable and it selects modules that work with only a certain main
# interpreter program.
#
# An alternative some people use is to have /usr/bin/env as the script
# interpreter. We don't do that because we think the existence and
# compatibility of /bin/sh is more reliable.
#
# Note that we aren't concerned about efficiency because the user who needs
# high efficiency can use directly the programs that this program invokes.
#
##############################################################################
exec perl -w -x -S -- "$0" "$@"
#!/usr/bin/perl
##############################################################################
# ppmfade
##############################################################################
#
# This program creates a fade (a sequence of frames) between two images.
#
# By Bryan Henderson, Olympia WA; March 2000
#
# Contributed to the public domain by its author.
#
# Inspired by the program Pbmfade by Wesley C. Barris of AHPCRC,
# Minnesota Supercomputer Center, Inc. January 7, 1994. Pbmfade does
# much the same thing, but handles non-Netpbm formats too, and is
# implemented in a more primitive language.
#
##############################################################################
use strict;
use File::Temp;
#
# Define a couple linear ramps.
#
# We don't use element 0 of these arrays.
my @spline10 = (0, 0, 0.11, 0.22, 0.33, 0.44, 0.55, 0.66, 0.77, 0.88, 1.0);
my @spline20 = (0, 0, 0.05, 0.11, 0.16, 0.21, 0.26, 0.32, 0.37, 0.42, 0.47,
0.53, 0.58, 0.63, 0.69, 0.74, 0.79, 0.84, 0.89, 0.95, 1.0);
sub doVersionHack($) {
my ($argvR) = @_;
my $arg1 = $argvR->[0];
if (defined($arg1) && (($arg1 eq "--version") || ($arg1 eq "-version"))) {
my $termStatus = system('ppmmix', '--version');
exit($termStatus == 0 ? 0 : 1);
}
}
my $tmpdir;
$tmpdir = File::Temp::tempdir("ppmfade.XXXXXX", CLEANUP => 1);
sub commandLineArgs() {
my ($firstFileNm, $lastFileNm, $mode, $baseNm);
for (my $i = 0; $i < @ARGV; ++$i) {
my $arg = $ARGV[$i];
if (0) {
} elsif ($arg eq "-f") {
++$i;
$firstFileNm = $ARGV[$i];
} elsif ($arg eq "-l") {
++$i;
$lastFileNm = $ARGV[$i];
} elsif ($arg eq "-base") {
++$i;
$baseNm = $ARGV[$i];
} elsif ($arg eq "-spread") {
$mode = 'SPREAD';
} elsif ($arg eq "-shift") {
$mode = 'SHIFT';
} elsif ($arg eq "-relief") {
$mode = 'RELIEF';
} elsif ($arg eq "-oil") {
$mode = 'OIL';
} elsif ($arg eq "-edge") {
$mode = 'EDGE';
} elsif ($arg eq "-bentley") {
$mode ='BENTLEY';
} elsif ($arg eq "-block") {
$mode = 'BLOCK';
} elsif ($arg eq "-mix") {
$mode = 'MIX';
} else {
if (substr($arg, 0, 1) eq '-') {
print STDERR ("Unknown option '$arg'. " .
"We understand -f, -l, -base, " .
"-spread, -shift, -relief, -oil, -edge, " .
"-bentley, -block, and -mix\n");
} else {
print STDERR ("There are no non-option arguments possible. " .
"You specified '$arg'\n");
}
exit 100;
}
}
if (!defined($firstFileNm) && !defined($lastFileNm)) {
print STDERR ("You must specify -f or -l (or both)\n");
exit 90;
}
if (!defined($mode)) {
$mode = 'SPREAD';
}
if (!defined($baseNm)) {
$baseNm = 'fade';
}
return $mode, $firstFileNm, $lastFileNm, $baseNm;
}
sub imageDimensions($$) {
my ($firstFileNm, $lastFileNm) = @_;
my ($width, $height);
if (defined($firstFileNm)) {
if ((`pnmfile $firstFileNm` =~ m{\b(\d+)\sby\s(\d+)} )) {
$width = $1; $height = $2;
} else {
print STDERR
("Unrecognized results from pnmfile on $firstFileNm.\n");
exit(50);
}
} else {
# $lastFileNm is defined
if ((`pnmfile $lastFileNm` =~ m{\b(\d+)\sby\s(\d+)} )) {
$width = $1; $height = $2;
} else {
print STDERR
("Unrecognized results from pnmfile on $firstFileNm.\n");
exit(50);
}
}
return $width, $height;
}
sub spreadOne($) {
my ($frameNum) = @_;
if ($frameNum <= 10) {
my $n = $spline20[$frameNum] * 100;
system("ppmspread $n $tmpdir/first.ppm >$tmpdir/this.ppm");
} elsif ($frameNum <= 20) {
my $n;
$n = $spline20[$frameNum] * 100;
system("ppmspread $n $tmpdir/first.ppm >$tmpdir/junk1a.ppm");
$n = (1-$spline20[$frameNum-10]) * 100;
system("ppmspread $n $tmpdir/last.ppm >$tmpdir/junk2a.ppm");
$n = $spline10[$frameNum-10];
system("ppmmix $n $tmpdir/junk1a.ppm $tmpdir/junk2a.ppm " .
">$tmpdir/this.ppm");
} else {
my $n = (1-$spline20[$frameNum-10])*100;
system("ppmspread $n $tmpdir/last.ppm >$tmpdir/this.ppm");
}
}
sub shiftOne($) {
my ($frameNum) = @_;
if ($frameNum <= 10) {
my $n = $spline20[$frameNum] * 100;
system("ppmshift $n $tmpdir/first.ppm >$tmpdir/this.ppm");
} elsif ($frameNum <= 20) {
my $n;
$n = $spline20[$frameNum] * 100;
system("ppmshift $n $tmpdir/first.ppm >$tmpdir/junk1a.ppm");
$n = (1-$spline20[$frameNum-10])*100;
system("ppmshift $n $tmpdir/last.ppm >$tmpdir/junk2a.ppm");
$n = $spline10[$frameNum-10];
system("ppmmix $n $tmpdir/junk1a.ppm $tmpdir/junk2a.ppm " .
">$tmpdir/this.ppm");
} else {
my $n = (1-$spline20[$frameNum-10]) * 100;
system("ppmshift $n $tmpdir/last.ppm >$tmpdir/this.ppm");
}
}
sub reliefOne($) {
my ($frameNum) = @_;
if ($frameNum == 1) {
system("ppmrelief $tmpdir/first.ppm >$tmpdir/junk1r.ppm");
}
if ($frameNum <= 10) {
my $n = $spline10[$frameNum];
system("ppmmix $n $tmpdir/first.ppm $tmpdir/junk1r.ppm " .
">$tmpdir/this.ppm");
} elsif ($frameNum <= 20) {
my $n = $spline10[$frameNum-10];
system("ppmmix $n $tmpdir/junk1r.ppm $tmpdir/junk2r.ppm " .
">$tmpdir/this.ppm");
} else {
my $n = $spline10[$frameNum-20];
system("ppmmix $n $tmpdir/junk2r.ppm $tmpdir/last.ppm " .
">$tmpdir/this.ppm");
}
if ($frameNum == 10) {
system("ppmrelief $tmpdir/last.ppm >$tmpdir/junk2r.ppm");
}
}
sub oilOne($) {
my ($frameNum) = @_;
if ($frameNum == 1) {
system("ppmtopgm $tmpdir/first.ppm | pgmoil >$tmpdir/junko.ppm");
system("rgb3toppm " .
"$tmpdir/junko.ppm $tmpdir/junko.ppm $tmpdir/junko.ppm " .
">$tmpdir/junk1o.ppm");
}
if ($frameNum <= 10) {
my $n = $spline10[$frameNum];
system("ppmmix $n $tmpdir/first.ppm $tmpdir/junk1o.ppm " .
">$tmpdir/this.ppm");
} elsif ($frameNum <= 20) {
my $n = $spline10[$frameNum-10];
system("ppmmix $n $tmpdir/junk1o.ppm $tmpdir/junk2o.ppm " .
">$tmpdir/this.ppm");
} else {
my $n = $spline10[$frameNum-20];
system("ppmmix $n $tmpdir/junk2o.ppm $tmpdir/last.ppm " .
">$tmpdir/this.ppm");
}
if ($frameNum == 10) {
system("ppmtopgm $tmpdir/last.ppm | pgmoil >$tmpdir/junko.ppm");
system("rgb3toppm " .
"$tmpdir/junko.ppm $tmpdir/junko.ppm $tmpdir/junko.ppm " .
">$tmpdir/junk2o.ppm");
}
}
sub edgeOne($) {
my ($frameNum) = @_;
if ($frameNum == 1) {
system("ppmtopgm $tmpdir/first.ppm | pgmedge >$tmpdir/junko.ppm");
system("rgb3toppm " .
"$tmpdir/junko.ppm $tmpdir/junko.ppm $tmpdir/junko.ppm " .
">$tmpdir/junk1o.ppm");
}
if ($frameNum <= 10) {
my $n = $spline10[$frameNum];
system("ppmmix $n $tmpdir/first.ppm $tmpdir/junk1o.ppm " .
">$tmpdir/this.ppm");
} elsif ($frameNum <= 20) {
my $n = $spline10[$frameNum-10];
system("ppmmix $n $tmpdir/junk1o.ppm $tmpdir/junk2o.ppm " .
">$tmpdir/this.ppm");
} else {
my $n = $spline10[$frameNum-20];
system("ppmmix $n $tmpdir/junk2o.ppm $tmpdir/last.ppm " .
">$tmpdir/this.ppm");
}
if ($frameNum == 10) {
system("ppmtopgm $tmpdir/last.ppm | pgmedge >$tmpdir/junko.ppm");
system("rgb3toppm " .
"$tmpdir/junko.ppm $tmpdir/junko.ppm $tmpdir/junko.ppm " .
">$tmpdir/junk2o.ppm");
}
}
sub bentleyOne($) {
my ($frameNum) = @_;
if ($frameNum == 1) {
system("ppmtopgm $tmpdir/first.ppm | pgmbentley >$tmpdir/junko.ppm");
system("rgb3toppm " .
"$tmpdir/junko.ppm $tmpdir/junko.ppm $tmpdir/junko.ppm " .
">$tmpdir/junk1o.ppm");
}
if ($frameNum <= 10) {
my $n = $spline10[$frameNum];
system("ppmmix $n $tmpdir/first.ppm $tmpdir/junk1o.ppm " .
">$tmpdir/this.ppm");
} elsif ($frameNum <= 20) {
my $n = $spline10[$frameNum-10];
system("ppmmix $n $tmpdir/junk1o.ppm $tmpdir/junk2o.ppm " .
">$tmpdir/this.ppm");
} else {
my $n = $spline10[$frameNum-20];
system("ppmmix $n $tmpdir/junk2o.ppm $tmpdir/last.ppm " .
">$tmpdir/this.ppm");
}
if ($frameNum == 10) {
system("ppmtopgm $tmpdir/last.ppm | pgmbentley " .
">$tmpdir/junko.ppm");
system("rgb3toppm $tmpdir/junko.ppm $tmpdir/junko.ppm " .
"$tmpdir/junko.ppm " .
">$tmpdir/junk2o.ppm");
}
}
sub blockOne($$$) {
my ($frameNum, $width, $height) = @_;
if ($frameNum <= 10) {
my $n = 1 - 1.9*$spline20[$frameNum];
system("pamscale $n $tmpdir/first.ppm | " .
"pamscale -width $width -height $height " .
">$tmpdir/this.ppm");
if ($frameNum == 10) {
system("cp", "$tmpdir/this.ppm", "$tmpdir/junk1a.ppm");
system("pamscale $n $tmpdir/last.ppm | " .
"pamscale -width $width -height $height " .
">$tmpdir/junk2a.ppm");
}
} elsif ($frameNum <= 20) {
my $n = $spline10[$frameNum-10];
system("ppmmix $n $tmpdir/junk1a.ppm $tmpdir/junk2a.ppm " .
">$tmpdir/this.ppm");
} else {
my $n = 1 - 1.9*$spline20[31-$frameNum];
system("pamscale $n $tmpdir/last.ppm | " .
"pamscale -width $width -height $height " .
">$tmpdir/this.ppm");
}
}
sub mixOne($$) {
my ($frameNum, $nFrame) = @_;
my $fadeFactor = sqrt(1/($nFrame - $frameNum + 1));
system("ppmmix $fadeFactor $tmpdir/first.ppm $tmpdir/last.ppm " .
">$tmpdir/this.ppm");
}
sub fade($$$$$) {
my ($nFrame, $mode, $width, $height, $baseNm) = @_;
#-----------------------------------------------------------------------------
# Do the fade starting, from image "first.ppm" in the temporary direct
# $tmpdir and ending up at "last.ppm", creating $nFrame frames, including
# the first and last.
#
# Make the outputs $width by $height.
#
# Name the result files $baseNm.NNNN.ppm.
#-----------------------------------------------------------------------------
# Here's what our temporary files are:
# first.ppm: The original (fade-from) image
# last.ppm: The target (fade-from) image
# this.ppm: The frame of the fade for the current iteration of the
# the for loop.
# junk1a.ppm: If the fade involves a ppmmix sequence from one
# intermediate image to another, this is the first frame
# of that sequence.
# junk2a.ppm: This is the last frame of the above-mentioned
# ppmmix sequence
my $frameNum; # Frame number
for ($frameNum = 1; $frameNum <= $nFrame; ++$frameNum) {
print("Creating Frame $frameNum of $nFrame...\n");
if ($mode eq 'SPREAD') {
spreadOne($frameNum);
} elsif ($mode eq 'SHIFT') {
shiftOne($frameNum);
} elsif ($mode eq 'RELIEF') {
reliefOne($frameNum);
} elsif ($mode eq 'OIL') {
oilOne($frameNum);
} elsif ($mode eq 'EDGE') {
edgeOne($frameNum);
} elsif ($mode eq 'BENTLEY') {
bentleyOne($frameNum);
} elsif ($mode eq 'BLOCK') {
blockOne($frameNum, $width, $height);
} elsif ($mode eq 'MIX') {
mixOne($frameNum, $nFrame);
} else {
print("INTERNAL ERROR: impossible mode value '$mode'\n");
}
my $outFileNm = sprintf("%s.%04d.ppm", $baseNm, $frameNum);
system("cp", "$tmpdir/this.ppm", $outFileNm);
}
}
#-----------------------------------------------------------------------------
# MAINLINE
#-----------------------------------------------------------------------------
my $nFrame = 30;
# Number of images in created sequence, including the fade-from and
# fade-to images. In standard video, 30 frames is one second.
doVersionHack(\@ARGV);
my ($mode, $firstFileNm, $lastFileNm, $baseNm) = commandLineArgs();
if (defined($firstFileNm) && !-e($firstFileNm)) {
print STDERR ("First file '$firstFileNm' does not exist\n");
exit 20;
}
if (defined($lastFileNm) && !-e($lastFileNm)) {
print STDERR ("Last file '$lastFileNm' does not exist\n");
exit 20;
}
my ($width, $height) = imageDimensions($firstFileNm, $lastFileNm);
# width and height of our frames in pixels
print("Frames are " . $width . "W x " . $height . "H\n");
my $fromDesc = defined($firstFileNm) ? "'$firstFileNm'" : "black";
my $toDesc = defined($lastFileNm) ? "'$lastFileNm'" : "black";
if (!defined($firstFileNm)) {
system("ppmmake \\#000 $width $height >$tmpdir/first.ppm");
} else {
system("cp", $firstFileNm, "$tmpdir/first.ppm");
}
if (!defined($lastFileNm)) {
system("ppmmake \\#000 $width $height >$tmpdir/last.ppm");
} else {
system("cp", $lastFileNm, "$tmpdir/last.ppm");
}
print("Fading from $fromDesc to $toDesc\n");
fade($nFrame, $mode, $width, $height, $baseNm);
exit(0);