#!/usr/bin/perl -w
#
#  Parse AUXDATA file to stdout.
#
#  Usage: perl parseaux.pl game/dir/auxdata.hst
#
#  Initial version hacked together in June 2001; upgraded to PHost 4.x
#  file format in May 2003.
#
#  This works similar in spirit to the util.dat parser: to add a new
#  record, add a `parseXX' function. This isn't the most nice piece of
#  code there is, but it seems to work quite well.
#

use strict;

if (@ARGV != 1) {
    print "$0 - Parse AUXDATA.HST file

Usage: $0 gamedir/auxdata.hst

Supported PHost versions: 3.0 to 4.0i-pre
Last update: 29/Aug/2004 by Stefan Reuther\n";
    exit 1;
}
open AUX, "<$ARGV[0]" or die "can't open $ARGV[0]";
binmode AUX;

# File header. This one's the same in all PHost versions.
my $header;
read AUX, $header, 38;
my ($maj, $min, $ts, $turn, $fbi, $resvd) = unpack "CCA18vvA14", $header;
print "PHost Version:     $maj.$min
Timestamp:         $ts
Turn Number:       $turn
First Battle Info: ", &unpack_bitset ($fbi), "\n";

if ($maj == 3) {
    # The version 3 file format is hardwired to this sequence of
    # records:
    do_record (1, 501);
    do_record (2, 338);
    do_record (3, 1002);
    do_record (4, 26*500);
    do_record (5, 4*13);
    do_record (6, 4*501);
} elsif ($maj == 4) {
    # The version 4 file format has tags, like util.dat.
    my $head;
    while (read AUX, $head, 4) {
        my ($type, $size) = unpack "vv", $head;
        do_record ($type, $size);
    }
} else {
    die "Unsupported PHost version.\n";
}
close AUX;
exit 0;

sub do_record {
    my ($id, $size) = @_;
    my $value;
    printf "Record %d (%d bytes) at %06Xh:\n", $id, $size, tell(AUX);
    if (read (AUX, $value, $size) != $size) {
        die "read error";
    }
    eval "parse$id (\$id, \$value)" || parse_default ($id, $value);
}

############################# Parser Functions ############################

sub parse_default {
    print "  (unable to decode)\n";
}

# Original base natives
sub parse1 {
    my ($id, $data) = @_;
    my @values = unpack "c*", $data;
    print "- Original Base Natives:\n";
    my $accum;
    foreach (0 .. $#values) {
        $accum .= sprintf "    %3d: %-5s", $_, unpack_native($values[$_])
            if $values[$_];
        if (defined($accum) && length($accum) > 60) {
            print "$accum\n";
            $accum = undef;
        }
    }
    print "$accum\n" if defined $accum;
    1;
}

# Alliances
sub parse2 {
    my ($id, $data) = @_;
    print "- Alliances:\n";
    if (length($data) != 338) {
        print "  Invalid length.\n";
        return 0;
    } else {
        print "      ";
        foreach (1..12) {
            printf "|%3d  ", $_;
        }
        print "\n  ----", "|-----" x 12, "\n";
        $data = substr($data, 26); # skip line zero
        foreach (1..12) {
            my $line = substr($data, 0, 26);
            $data = substr($data, 26);
            my @ally = unpack "v13", $line;
            printf "   %2d ", $_;
            foreach (1..12) {
                my $what = "";
                if($ally[$_] & 32) {
                    # active alliance
                    foreach my $lvl (0..4) {
                        if($ally[$_] & (1 << $lvl)) {
                            # offer exists
                            my $letter = ("S", "P", "M", "C", "V")[$lvl];
                            $letter = lc $letter if $ally[$_] & (256 << $lvl);
                            $what .= $letter;
                        }
                    }
                    $what = "+" if $what eq "";
                } else {
                    $what = "-";
                }
                printf "|%-5s", $what;
            }
            print "\n";
        }
    }
    1;
}

# Ship Scan
sub parse3 {
    my ($id, $data) = @_;
    my @d = unpack "v*", $data;
    my $ok = 0;
    print "- Ship Scan Information:\n";
    foreach (0 .. $#d) {
        my $i = $d[$_];
        if ($i) {
            printf "  + ship %3d: %s%s\n", $_, &unpack_bitset ($i & 0x7fff), ($i & 0x8000) ? " (cloaked)" : "";
            $ok = 1;
        }
    }
    print "  (no ship is visible)\n" unless $ok;
    1;
}

# Build Queue
sub parse4 {
    my ($id, $data) = @_;
    my $ok = 0;
    my $index = 0;
    print "- Build Queue:\n";
    while (length($data) >= 26) {
        my ($base, $hull, $eng, $beamt, $beamc, $tubet, $tubec, $clone, $owner, $pri)
            = unpack "v9V", substr($data, 0, 26);
        $data = substr($data, 26);
        ++$index;
        if ($base) {
            print "  + Entry $index:
    . Base:   $base
    . Hull:   $hull
    . Engine: $eng
    . Beams:  $beamc x $beamt
    . Torps:  $tubec x $tubet
    . Clone?  $clone
    . Owner:  $owner
    . Prio:   $pri
";
            ++$ok;
        }
    }
    print "  (queue is empty)\n" if !$ok;
    1;
}

# PAL
sub parse5 {
    my ($id, $data) = @_;
    my @d = unpack "V*", $data;
    my $ok = 0;
    print "- Build Points:\n";
    foreach (0 .. $#d) {
        if ($d[$_]) {
            printf "  + player %2d: %5d\n", $_, $d[$_];
            $ok++;
        }
    }
    print "  (all values zero)\n" unless $ok;
    1;
}

# Remote Control
sub parse6 {
    my ($id, $data) = @_;
    my @array = unpack "v*", $data;
    my $count = @array/2;
    my $ok = 0;
    print "- Remote Control:\n";
    foreach (0..$count-1) {
        if ($array[$_]) {
            printf " %3d: controlled by %d, owned by %d\n", $_, $array[$_], $array[$_+$count];
            $ok++;
        }
    }
    print "  (not active)\n" unless $ok;
    1;
}

# Ship Specials
sub parse7 {
    parse_ship_specials("Ship Specials", @_);
}

# Experience
sub parse9 {
    my ($id, $data) = @_;
    my $ok = 0;
    my @d = unpack "V*", $data;
    print (($id == 9) ? "- Ship Experience\n" : "- Planet Experience\n");
    foreach (0 .. $#d) {
        if ($d[$_]) {
            printf "   %3d: %5d", $_+1, $d[$_];
            print "\n" if (++$ok % 5 == 0);
        }
    }
    if (!$ok) {
        print "  (none used)\n";
    } elsif ($ok % 5 != 0) {
        print "\n";
    }
    1;
}

sub parse10 { parse9(@_); }

# permanent primary enemies
sub parse11 {
    my ($id, $data) = @_;
    my @d = unpack "v*", $data;
    my $ok = 0;
    print "- Enemy Data:\n";
    foreach (0 .. $#d) {
        if ($d[$_]) {
            printf "  + player %2d: %s\n", $_+1, unpack_bitset($d[$_]);
            $ok++;
        }
    }
    print "  (all values zero)\n" unless $ok;
    1;
}

sub parse12 {
    my ($id, $data) = @_;
    my $sid = 0;
    my $ok = 0;
    print "- Synthesized per-ship specials:\n";
    while (length($data) >= 8) {
        my @array = unpack "V2", substr($data, 0, 8);
        $data = substr($data, 8);
        ++$sid;
        next if ($array[0] == 0 && $array[1] == 0);
        printf "  + ship %d: %08X %08X:", $sid, @array;
        foreach (0..31) {
            print " $_" if ($array[0] & (1 << $_));
        }
        foreach (0..31) {
            print " ", ($_+32)
              if ($array[1] & (1 << $_));
        }
        print "\n";
        ++$ok;
    }
    print "  (none used)\n" if !$ok;
    1;
}

sub parse13 {
    my ($id, $data) = @_;
    my @d = unpack "v*", $data;
    my $index = 0;
    while (@d >= 2) {
        my $type = shift(@d);
        my $exp = shift(@d);
        if ($exp) {
            print "  + entry $index: ", unpack_ability($type), ": level";
            foreach (0 .. 15) {
                if ($exp & (1 << $_)) {
                    print " $_";
                }
            }
            print "\n";
        }
        ++$index;
    }
    1;
}

### Records with Id > 100 are transient, that is, they are only contained
### in auxdata files during phase 2.

# various flags
sub parse101 {
    my ($id, $data) = @_;
    my @d = unpack "V*", $data;
    my $ok = 0;
    print (($id == 101) ? "- Planet Flags [transient]\n" : "- Ship Flags [transient]\n");
    foreach (0 .. $#d) {
        next if !$d[$_];
        printf "  %3d: %d =", $_+1, $d[$_];
        $ok = 1;

        my $v = $d[$_];
        foreach (qw(recrewed b1 b2 b3 b4 b5 b6 b7 b8 b9 b10 b11 b12
                    b13 b14 b15 b16 b17 b18 b19 b20 b21 b22 b23 b24
                    b25 b26 b27 b28 b29 b30 b31))
        {
            print " $_" if $v & 1;
            $v >>= 1;
        }
        print "\n";
    }
    print "  (nothing interesting)\n" if !$ok;
    1;
}

sub parse102 { parse101(@_); }

# new experience
sub parse103 {
    my ($id, $data) = @_;
    my $ok = 0;
    my @d = unpack "V*", $data;
    print (($id == 103) ? "- New Ship Experience [transient]\n" : "- New Planet Experience [transient]\n");
    foreach (0 .. $#d) {
        if ($d[$_]) {
            printf "   %d: +%d points\n", $_+1, $d[$_];
            $ok = 1;
        }
    }
    print "  (nothing interesting)\n" if !$ok;
    1;
}

sub parse104 { parse103 (@_); }

# TAL
sub parse105 {
    my ($id, $data) = @_;
    my $num = 0;
    print "- Turn Activity Level [transient]\n";
    foreach (unpack "V*", $data) {
        printf "   %d: +%d points\n", ++$num, $_;
    }
    1;
}

# inhibited specials
sub parse106 {
    parse_ship_specials("Inhibited Ship Specials [transient]", @_);
}

################################# Helpers #################################

sub parse_ship_specials {
    my ($heading, $id, $data) = @_;
    my $sid = 0;
    my $ok = 0;
    print "- $heading:\n";
    while (length($data) >= 8) {
        my @array = unpack "V2", substr($data, 0, 8);
        $data = substr($data, 8);
        ++$sid;
        next if ($array[0] == 0 && $array[1] == 0);
        printf "  + ship %d: %08X %08X\n", $sid, @array;
        foreach (0..31) {
            print "    - ", unpack_ability($_), "\n"
                if ($array[0] & (1 << $_));
        }
        foreach (0..31) {
            print "    - ", unpack_ability(32+$_), "\n"
                if ($array[1] & (1 << $_));
        }
        ++$ok;
    }
    print "  (none used)\n" if !$ok;
    1;
}

sub unpack_bitset {
    my $bits = shift @_;
    my @res = ();
    foreach (0..15) {
	push @res, $_ if $bits & (1 << $_);
    }
    if (@res) {
        join " ", @res;
    } else {
        "empty";
    }
}

sub unpack_native {
    my $value = shift;
    if ($value >= 0 && $value < 10) {
        ("None", "Hum", "Bov", "Rep", "Avi", "Amo",
         "Ins",  "Amp", "Ghi", "Sil")[$value];
    } else {
        "$value";
    }
}

sub unpack_ability {
    my $value = shift;
    my @things = ('Alchemy',               'Refinery',
                  'Advanced Refinery',     'Heats to 50',
                  'Cools to 50',           'Heats to 100',
                  'Hyperdrive',            'Gravitonic',
                  'Scans all Wormholes',   'Gambling',
                  'Anti-cloak',            'Imperial Assault',
                  'Chunneling',            'Ramscoop',
                  'Advanced Bioscanner',   'Advanced Cloak',
                  'Cloak',                 'Bioscanner',
                  'Glory Device (10%)',    'Glory Device (20%)',
                  'Unclonable',            'Clone Once',
                  'Ungiveable',            'Give Once',
                  'Level 2 Tow');
    if ($value >= @things) {
        "unknown-$value";
    } else {
        $things[$value];
    }
}