Several people have asked me for the source code, so I'm posting it here. This is the original code, which both creates the "multiple-layer" image, and the final compressed image, and then uncompresses and "peels" each layer off to provide individual the individual image frames which are morphed in progression.
#!/usr/bin/perl -w
#
# Creates a "morph" of words.
#
# May 2006 by liverpole
#
##############
### Strict ###
##############
use strict;
use warnings;
#################
### Libraries ###
#################
eval { require Win32::Console::ANSI };
use Data::Dumper;
use File::Basename;
####################
### User-defined ###
####################
my $maxlayer = 6; # Maximum allowable combined layers
my $maxrow = 17; # Maximum number of rows in any layer
my $startsym = 63; # The starting symbol (represents bitmask
+zero)
my $countsym = 33; # The starting symbol (represents a count
+of 3)
my $joinchar = '>'; # What character used to join lines?
my $regchar = '='; # The character to split the regex on
my $trunc = 70; # If nonzero, # of chars to truncate image
+ to
my $maxx = 78; # Limit of x
my $maxy = 21; # Limit of y
my $blank = " " x 79; # 1 blank line
my $is_win = ($^O =~ /win/i); # Are we running on Windows?
my $cbase = $is_win? 31: 101; # The base color value
# The largest encodable 'count' value, used during final compression
# of the merged image layers.
#
my $maxcount = $startsym - $countsym + 1;
#############################################################
### Layers (up to 6 allowed with current symbol mappings) ###
#############################################################
my @layers = (
'
###### ###
###### ###
### ###
### ### ### ##### #######
### ### ### ####### #######
### ### ### ### # ###
### ### ### #### ###
### ### ### ####### ###
### ### ### ####### ###
### ### ### #### ###
#### ######### # ### ###
####### ######### ####### ######
###### #### ### ##### #####
',
'
#### ### ###
#### ### ###
###### ### ###
###### ### #### #### ####### ### #### ###### ###
+ ##
###### ######### ######## ####### ######### ######## ###
+####
### ### ######### ### ### ### ######### #### #### ###
+####
### ### ### ### ### ### ### ### ### ### ### ###
### ### ### ### ### ### ### ### ### ########## ###
######## ### ### ### ### ### ### ### ########## ###
########## ### ### ### ### ### ### ### ### ###
### ### ### ### ### ### ### ### ### #### # ###
### ### ### ### ######## ###### ### ### ######### ###
### ### ### ### #### ##### ### ### ####### ###
',
'
######## ###
########## ###
### #### ###
### ### ###### ### ## ###
### ### ######## ####### ###
### ### #### #### ####### ###
########## ### ### ### ###
######### ########## ### ###
### ########## ### ###
### ### ### ###
### #### # ### ###
### ######### ### ###
### ####### ### #####
',
'
### ### ###
### ### ###
### ### ###
### ### ###### ##### ### #### ###### ### ##
### ### ######## ######## ### #### ######## #######
########### ## #### ### # ### ### #### #### #######
########### ### ### ### ### ### ### ###
### ### ####### ### ###### ########## ###
### ### ######## ### ####### ########## ###
### ### ### ### ### ### #### ### ###
### ### ### ### ### # ### ### #### # ###
### ### ######### ######## ### ### ######### ###
+ ###
### ### #### ### ##### ### #### ####### ###
+ #####
+ ####
+ ##
+ ##
+ ##
',
+
'
### ###
### ###
### ### ###
### ### ### ### ###### ### ## ######## #### ###
+ ######
### ### ### ######## ####### ########## ######## ###
+########
### ### ### ### #### #### ####### ### ### ### ### ### #
+### ####
### ### ### ### ### ### ### ### ### ### ### ### #
+## ###
### ### ### ### ########## ### ### ### ### ### ### #
+#########
### ### ### ### ########## ### ### ### ### ### ### #
+#########
### ### ### ### ### ### ########## ### ### ### #
+##
### ### ###### #### # ### ######### ### ### ### #
+### #
### ### #### ######### ### ### ######## ###
+#########
### ### ## ####### ### ### #### ###
+ #######
###
############################### ### #######################
+#######
############################### ### #######################
+#######
###
',
'
######
####### #################
######## ####### #####################
################### #########################
########### ###############################
############# ####################################
#####################################################
######################################################
######################################################
############################################### ####
########################################### ###
######### ################## ###### ###
######## ######### ###### ######
###### ######## ##### #####
##### ##### ##### ####
#### ##### ##### ####
#### ######## ###
#### ######### ####
#### ####### #### ######
###### #######
',
);
###############
### Globals ###
###############
my $iam = basename $0;
my $image = ""; # The merge of all image layers
####################
### Command-line ###
####################
my $delay = shift || 0;
my $entropy_radius = shift || 240;
####################
### Main program ###
####################
my $nlayers = @layers;
($nlayers > $maxlayer) and die "$iam: max of $maxlayer exceeded!\n";
# Merge the image to a single layer
for (my $mask = 1, my $i = 0; $i < $nlayers; $i++, $mask <<= 1) {
my $layer = $layers[$i];
$image = merge($image, $layer, $mask);
}
# show("Image after merge", $image);
# Compress the single layer image
$image = compress($image);
# show("Image after compression", $image);
#+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+++++++++
# HALF-WAY
#
# Display the image at this point (with "show('Compressed image', $ima
+ge)")
# to see what the encoded part of "Morphological Japh" looks like.
#+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+++++++++
# Decompress the single layer image
$image = decompress($image);
# show("Image after decompression", $image);
# Morph forever
my $idx = 0;
my @layer = map { peel_golf(1<<$_, $image) } (0 .. $nlayers-1);
my $color = 0;
print "\e[2J\n";
while (1) {
my $from = $layer[$idx];
my $to = $layer[($idx+1)%$nlayers];
$idx = ($idx + 1) % $nlayers;
morph($from, $to, $color++);
$color %= $nlayers;
}
###################
### Subroutines ###
###################
#
# show(): (debugging routine) displays the current image;
# waits for user to hit <RETURN>.
#
sub show {
my ($msg, $pimg) = @_;
print "=" x 79, "\n";
print " $msg\n";
print "=" x 79, "\n";
print "\e[${cbase}m";
my $ref = ref $pimg;
if ($ref eq "") {
print "$pimg\n";
} elsif ($ref eq "ARRAY") {
for (my $i = 0; $i < @$pimg; $i++) {
my $p = $pimg->[$i];
$ref = ref $p;
if ($ref eq "") {
print "$p\n";
} else {
map { print "$_\n" } @$p;
print "-" x 79, "\n";
}
}
} else {
die "$iam: Unknown reference '$ref'\n";
}
print "\e[m\e[K";
<STDIN>;
}
#
# merge(): merges all layers (up to 6) into a single layer, using
# a different bitmask for each layer.
#
sub merge {
my ($image, $layer, $mask) = @_;
$layer =~ s/^\n//s;
my @image = split("\n", $image);
my @layer = split("\n", $layer);
map { s/\s+$// } @layer;
my @result;
while (@image || @layer) {
my $merge = shift @image || "";
my $line = shift @layer || "";
my @vals = split(//, $merge);
my @next = split(//, $line);
my $result = "";
while (@vals || @next) {
my $char = shift @vals || chr($startsym);
my $next = shift @next || " ";
my $val = ord($char) - $startsym;
my $new = ($next eq '#')? $mask: 0;
my $c = chr($startsym + $val + $new);
$result .= $c;
}
push @result, $result;
}
my $merge = join("\n", @result);
return $merge;
}
#
# peel(): the inverse of merge()
#
sub peel {
my ($mask, $img) = @_;
my @lines = split("\n", $img);
my $text = "\n";
foreach my $line (@lines) {
my @chars = split(//, $line);
foreach my $char (@chars) {
my $val = ord($char) - $startsym;
$text .= ($val & $mask)? '@': ' ';
}
$text .= "\n";
}
return $text;
}
#
# peel_golf(): a "golfed" version of peel()
#
sub peel_golf {
no warnings;
no strict;
$; = "";
map {
$_ .= '?' x (79 - length $_);
map{
$; .= $_[0] & (-63+ord$_)? '@':' '
} split//;
$;.=$/;
} split$/, pop;
$/.$;
}
#
# compress(): further compress the 'merged' image, by finding multip
+le
# occurrences of a character, and replacing them with an
# encoded version of <count><character>.
#
sub compress {
my ($image) = @_;
my @lines = split(/\n/, $image);
my $count = $maxcount;
while ($count-- > 2) {
foreach my $line (@lines) {
while ($line =~ /((.)\2{$count})/) {
my $char = $2;
my $str = $char x ($count + 1);
my $cnt = chr($countsym + $count - 2);
$line =~ s/\Q$str\E/$cnt$char/g;
}
}
}
my $img = join($joinchar, @lines);
if ($trunc) {
my $cnt = $trunc - 3;
$img =~ s/(.{$cnt})(.+)/$1\n$2/;
$img =~ s/(.{$trunc})/$1\n/g;
}
return $img;
}
#
# decompress(): the inverse of compress()
#
sub decompress {
my ($img) = @_;
my $endsym = $startsym + (2 ** $maxlayer) - 1;
$img =~ s/\n//gs;
$img =~ s/\Q$joinchar\E/\n/g;
foreach my $count (3..$maxcount) {
my $cnt = chr($countsym + $count - 3);
foreach my $val ($startsym..$endsym) {
my $sym = chr($val);
my $str = $sym x $count;
$img =~ s/\Q${cnt}${sym}\E/$str/g;
}
}
return $img;
}
#
# coordinates(): breaks up an image into its (X,Y) coordinates.
#
sub coordinates {
my ($img) = @_;
my $pcoor = { };
my @lines = split("\n", $img);
my $idx = 0;
for (my $y = 0; $y < @lines; $y++) {
my $line = $lines[$y];
my @points = split(//, $line);
for (my $x = 0; $x < @points; $x++) {
($points[$x] eq " ") or $pcoor->{$idx++} = [ $x, $y ];
}
}
$pcoor->{'count'} = $idx;
return $pcoor;
}
#
# scatter(): creates a random entropic 'scatter', towards which each
# image will morph individually.
#
sub scatter {
my ($count, $xcenter, $ycenter, $radius) = @_;
$radius ||= 1;
my $ppoints = { };
for (my $i = 0; $i < $count; $i++) {
while (1) {
my $x = int rand $maxx;
my $y = int rand $maxy;
if ((($x - $xcenter)**2 + ($y - $ycenter)**2) <= $radius)
+{
$ppoints->{$i} = [$x, $y];
last;
}
}
}
$ppoints->{'count'} = $count;
return $ppoints;
}
sub colorize {
my ($img, $color) = @_;
$color += $cbase;
my $cstr = $is_win? "\e[4;7;${color}m": "\e[${color}m";
$img =~ s/( +)/\e[m$1$cstr/g;
return $img;
}
#
# randchar(): generate a random character
#
sub randchar { chr 33 + int(rand 93) }
#
# migrate(): migrate all points 1 step towards the destination scatt
+er
#
# Inputs: $1 ... A pointer to hash of coordinates
# $2 ... A pointer to the "scatter" hash
# $3 ... A pointer to the array of progressively entropic im
+ages
# $4 ... The color escape sequence
#
sub migrate {
my ($pxy, $psc, $parray, $color) = @_;
my $count0 = $pxy->{'count'};
my $count1 = $psc->{'count'};
my @lines = ($blank) x ($maxy + 1);
my $b_moved = 0;
for (my $i = 0; $i < $count0; $i++) {
my $p1 = $pxy->{$i % $count0};
my $p2 = $psc->{$i % $count1};
my ($x1, $y1) = (@$p1);
my ($x2, $y2) = (@$p2);
if ($x1 != $x2 || $y1 != $y2) {
$x1 = ($p1->[0] -= ($x1 <=> $x2));
$y1 = ($p1->[1] -= ($y1 <=> $y2));
++$b_moved;
}
substr($lines[$y1], $x1, 1, randchar)
}
push @$parray, colorize(join($/,@lines), $color);
return $b_moved;
}
#
# output(): Display a single image
#
sub output {
print "\e[H", $_[0];
$delay and select(undef, undef, undef, $delay);
}
#
# morph(): Performs a "morph" from one image into another.
#
sub morph {
my ($from, $to, $color) = @_;
my $pfr = coordinates($from);
my $pto = coordinates($to);
my @from = ( );
my @to = ( );
my $psc = scatter($pto->{'count'}, 40, 10, $entropy_radius);
my $m1 = my $m2 = 1;
while ($m1 || $m2) {
$m1 &&= migrate($pfr, $psc, \@from, $color);
$m2 &&= migrate($pto, $psc, \@to, ($color+1) % $nlayers);
}
output(colorize($from, $color));
map { output $_ } (@from, reverse @to);
output(colorize($to, ($color+1) % $nlayers));
}