#!/usr/bin/perl -w
use strict;

# Titus the Fox / Moktar level file format by Jesses (mail at ttf dot mine dot nu)
# Visit https://ttf.mine.nu for more TTF/Moktar stuff

# Sample SQZ decoder in perl, v1.2.
# Version history:
#   1.2 - add '-altlzw' option
#   1.1 - ask for input/output filenames if STDIN is a terminal
#   1.0 - initial version

# This program reads SQZ-encoded data from STDIN, and writes the result to STDOUT.
# Usage: ./unpack.pl [-altlzw] < INPUT.SQZ > OUTPUT
# The optional '-altlzw' parameter enables alternate LZW decompression, as used by CDRUN.COM on the '10 Great Games' CDROM by 'Telstar Fun and Games'.
# If STDIN is detected to be a terminal, it will instead first prompt for filenames.

# If "< INPUT.SQZ" was not used to redirect input, this prompts for filenames and redirects STDIN/STDOUT
if (-t STDIN) {
	print STDERR "Enter filename of INPUT file: ";
	my $inputFile = <STDIN>;
	chomp($inputFile);
	die "Could not read file '$inputFile'!\n" unless (-r $inputFile);
	print STDERR "Enter filename of OUTPUT file: ";
	my $outputFile = <STDIN>;
	chomp($outputFile);
	if (-e $outputFile) {
		print STDERR "Warning: file '$outputFile' already exists! Press ENTER to overwrite it or Ctrl-C to abort...\n";
		<STDIN>;
	}
	print STDERR "Unpacking '$inputFile' to '$outputFile'\n";
	open(STDIN, "<", $inputFile) or die $!;
	open(STDOUT, ">", $outputFile) or die $!;
}

binmode(STDIN);
binmode(STDOUT);

# Enable altlzw mode if parameter was given
my $altlzw = (@ARGV >= 1) && ($ARGV[0] eq '-altlzw');

# Read first 4 bytes
my $buf;
read(STDIN, $buf, 4);

# Get uncompressed size from bytes 0, 2, 3
my $unpsize = (unpack("C", $buf) << 16) + unpack("x2v", $buf);

my $size; # Number of bytes written to STDOUT, for size-check later on

# Check byte 1 for format and call the appropriate sub
if (unpack("xC", $buf) == 0x10) {
	# LZW
	print STDERR "Unpacking LZW...\n";
	$size = decodeLZW($altlzw);
} else {
	# Huffman
	print STDERR "Unpacking Huffman...\n";
	$size = decodeHuffman();
}

# Emit a warning if the unpacked size differs from the one specified in the stream
if ($size != $unpsize) {
	warn "Warning: Unpacked file should be ".$unpsize." bytes but is ".$size." bytes!\n".
	     "The '-altlzw' option may help, especially if this is an SQZ executable from the '10 Great Games' CDROM by 'Telstar Fun and Games'.\n"
}

# Done.


sub nextbyte { # return the next byte from STDIN, or zero if there are no more bytes
	my $c = getc;
	return (defined $c ? ord($c) : 0);
}

sub decodeLZW {
	my ($altlzw) = @_;

	# constants; first two are swapped if altlzw is enabled
	my $CLEAR_CODE	= 0x100;
	my $END_CODE	= 0x101;
	my $FIRST	= 0x102;
	my $MAX_TABLE	= 0x1000;
	if ($altlzw) {
		print STDERR "altlzw mode enabled.\n";
		$CLEAR_CODE	= 0x101;
		$END_CODE	= 0x100;
	}

	# variables
	my $nbit;	# Current word size
	my @dict;	# Dictionary: each entry holds [prefix_pointer, postfix, first_byte(prefix)]
	my $dictsize = $FIRST;

	my $size = 0;	# Returned to caller, number of bytes written to STDOUT

	# variables for extracting the next codeword
	my $buf24 = (ord(getc) << 16) + (ord(getc) << 8) + ord(getc);
	my $bitpos = 0;

	my $prev = $CLEAR_CODE; # Previous codeword
	while ($prev != $END_CODE) {
		if ($prev == $CLEAR_CODE) {
			$nbit = 9;
			$dictsize = $FIRST;
		}
		# Get next codeword
		$bitpos += $nbit;
		my $cw = ($buf24 >> (24-$bitpos)) & (2**$nbit - 1);
		$buf24 = ($buf24 << 8) + nextbyte();
		if ($bitpos >= 16) {
			$buf24 = ($buf24 << 8) + nextbyte();
		}
		$buf24 &= 0xFFFFFF;
		$bitpos &= 7;
		# Process the codeword $cw
		if (($cw != $CLEAR_CODE) && ($cw != $END_CODE)) {
			my $newbyte;
			if ($cw < $dictsize) {
				$newbyte = $cw < $FIRST ? $cw : ${$dict[$cw - $FIRST]}[2];
			} else {
				die "prev == CLEAR_CODE!" unless ($prev != $CLEAR_CODE);
				die "num_elem(dict) >= MAX_TABLE!" unless ($dictsize < $MAX_TABLE);
				die "cw != num_elem(dict)!" unless ($cw == $dictsize);
				$newbyte = $prev < $FIRST ? $prev : ${$dict[$prev - $FIRST]}[2];
			}
			if (($prev != $CLEAR_CODE) && ($dictsize < $MAX_TABLE)) {
				$dict[$dictsize - $FIRST] = [$prev, $newbyte, $prev < $FIRST ? $prev : ${$dict[$prev - $FIRST]}[2]];
				$dictsize++;
				if (($dictsize == 2**$nbit) && ($nbit < 12)) {
					$nbit++;
				}
			}
			my $output = '';
			my $outcw = $cw;
			while ($outcw >= $FIRST) {
				my ($prefix, $byte) = @{$dict[$outcw - $FIRST]};
				$outcw = $prefix;
				$output .= chr($byte);
			}
			$output .= chr($outcw);
			$output = reverse($output);
			print $output;
			$size += length($output);
		}
		$prev = $cw;
	}
	return $size;
}

sub decodeHuffman {
	my $HTS = ord(getc) + (ord(getc) << 8);
	my $buf;
	read(STDIN, $buf, $HTS);
	my @HT = unpack("v".($HTS/2), $buf);

	my $size = 0;	# Returned to caller, number of bytes written to STDOUT

	# Huffman decoding variables
	my $node = 0;

	# RLE decoding variables
	my $state = 0;
	my $last;
	my $count;

	while (defined(my $word = getc)) {
		$word = ord($word);
		for (my $bit=128; $bit>=1; $bit >>= 1) {
			if ($word & $bit) {
				$node++;
			}
			unless ($HT[$node] & 0x8000) {
				$node = $HT[$node] / 2;
			} else {
				my $cw = $HT[$node] & 0x7FFF;
				my $L = $cw & 255;
				my $H = $cw >> 8;
				if ($state == 0) {
					if ($H == 0) {
						$last = chr($L);
						print $last;
						$size++;
					} elsif ($L == 0) {
						$state = 1;
					} elsif ($L == 1) {
						$state = 2;
					} else {
						print $last x $L;
						$size += $L;
					}
				} elsif ($state == 1) {
					print $last x $cw;
					$size += $cw;
					$state = 0;
				} elsif ($state == 2) {
					$count = $L*256;
					$state = 3;
				} elsif ($state == 3) {
					$count += $L;
					print $last x $count;
					$size += $count;
					$state = 0;
				}
				$node = 0;
			}
		}
	}
	return $size;
}