path: root/editor/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);