Decode a .codea rtfd file

decodea.pl

#!/usr/bin/perl

# Tom's nasty and ugly .codea (rtfd) decoder
# I release this bad boy to the public domain, you can't stop me!

$debug=1;

$f = shift @ARGV || "Font.codea";

open ($fh, $f);
my $c = do { local $/; <$fh> }; # slurp
close $fh;

$header = unpack("A4", $c); $c = substr($c, 4);
if ($header ne "rtfd") { die "The file $f is not a Codea archive\n"; }
$buffer = unpack("N", $c); $c = substr($c, 4);
$version = unpack("l", $c); $c = substr($c, 4); # just guessing!
$files = unpack("l", $c); $c = substr($c, 4);
if ($debug) { print "$files files:\n"; }
for $f (1..$files) {
   $namelen = unpack("l", $c); $c = substr($c, 4);
   $name = unpack("A$namelen", $c); $c = substr($c, $namelen);
   if ($debug) { print "$f: $name\n"; }
   $NAME{$f} = $name;
}
for $f (1..$files) {
   $size = unpack("l", $c); $c = substr($c, 4);
   if ($debug) { print "$f: $NAME{$f} chunk is $size\n"; }
   $SIZE{$f} = $size;
}
$thisfile = 0;
while ($thisfile < $files) { # now process each chunk
   $thisfile++;
   $quiet = 0; # skip garbage files
   if ($NAME{$thisfile} eq '.') { $quiet++; }
   if ($NAME{$thisfile} =~ /@/) { $quiet++; }
   $s = $SIZE{$thisfile};
   if (! $quiet) { print "file $thisfile $NAME{$thisfile} - "; }
   $fc = unpack("A$s", $c); $c = substr($c, $s);
   $x = unpack("l", $fc); $fc = substr($fc, 4); # junk
   $x = unpack("l", $fc); $fc = substr($fc, 4); # size, or 
   if ($x == -2147483648) { # Why??? minval
      $x = unpack("l", $fc); $fc = substr($fc, 4); # then size. Weird. 
      }
   if (! $quiet) {
      print "$x bytes\n" . substr($fc, -$x);
      print "\n---------------------------------------------------------\n\n";
      }
}