#!/usr/bin/perl
#
# z2pdb: convert a Z-Machine format file to a PDB format file
# suitable for installing on a Palm device for use with 
# Frobnitz or Pilot-Frotz.
#
# Perl author: Jonathan Ferro <jonrock@yahoo.com>
# Based on C code by: Alien Hunter <alien_hunter@hotmail.com>

$USAGE = <<__USAGE__;
Usage: z2pdb [ options ] <z_file> <pdb_file> [ <game_title> ]
If no game title is specified, the name of the frotz file, with any
suffix removed, will be used instead.  In either case, the game title
will be truncated to 31 characters.
Options:
    -pfrotz    Produce PDB for use with Pilot-Frotz
    -frobnitz  Produce PDB for use with Frobnitz (default)
__USAGE__

$frobnitz = 1; # Set default.

while (@ARGV && $ARGV[0] =~ /^-/) {
    $ARGV[0] eq '-frobnitz' && do { $frobnitz = 1; shift; next; } ;
    $ARGV[0] eq '-pfrotz' && do { $frobnitz = 0; shift; next; } ;
    $ARGV[0] eq '--' && do { shift; last; } ;
    $ARGV[0] eq '-h' && die $USAGE;
    die "unknown flag: $ARGV[0]\n" . $USAGE;
}

if (@ARGV < 2 || @ARGV > 3) {
    die $USAGE;
}

($zfile, $pdbfile, $title) = @ARGV;
$reclen = 4096; # Use 4K chunks.

## Construct a title if none was given.
if (! defined $title) {
    $title = $zfile;
    $title =~ s!^.*/!! ; # Remove leading directories (maximal match).
    $title =~ s/\.[^.]*//; # Strip off suffix, if any.
}

## Open appropriate files and check for errors.
open $zfile, "$zfile" 
    or die "Can't open $zfile: $!\n";
binmode $zfile;
open $pdbfile, ">$pdbfile"
    or die "Can't write to $pdbfile: $!\n";
binmode $pdbfile;

## Slurp in zcode file, counting the number of resulting records.
$records = 0;
while (read $zfile, $buf, $reclen) {
    if(frobnitz) {
        $zdata .= $buf;
    }
    else {
        # Make sure that the last record is null-filled for Frotz
        $zdata .= pack "a$reclen", $buf;
    }
    $records++;
}

## Construct and write database header.
$pdbheader = pack "a31xn2N6a4a4N2n",
    $title, # Name of database
    0, # Database attributes
    1, # Version number
    0x34ac829f, # Creation date
    0x34ac829f, # Modification date
    0, # Last backup date
    0, # Modification number
    0, # App info area (nonexistent)
    0, # Sort info area (nonexistent)
    "ZCOD", # Database type
    $frobnitz ? "Frtz" : "Fotz", # Database creator ID
    0, # Unique ID seed
    0, # Next record list ID (unused?)
    $records # Number of records
    ;
print $pdbfile $pdbheader;

## Calculate offset of first record, using dummy record header for size.
$recheader = pack "NCx3";
$offset = length($pdbheader) + $records * length($recheader);

## Construct and write record headers.
for $rec (0 .. ($records - 1)) {
    $recheader = pack "NCx3",
        $rec * $reclen + $offset, # Record data offset
        0x60 # Record attributes (BUSY|DIRTY)
;
    print $pdbfile $recheader;
}

## Finally, write the records themselves.
print $pdbfile $zdata;
