#!/usr/bin/env perl
use strict;
use warnings;
use 5.010;

use Data::Dumper;
use Getopt::Long 2.33 qw(HelpMessage :config bundling);

our $VERSION = '1.02';

GetOptions(\my %opt,
	'raw|r',  # full output
	'version=i',  # force version
) or HelpMessage(-exitval => 2);


package Shiar_Parse::WormEdit;

use strict;
use warnings;

our %MAGICID = (
	"WormEdit053\000LVL" => 53,
	"WormEdit\34195\000LVL" => 95,
	"WormEdit\34194\000LVL" => 94,
	"WormEdit\34193\000LVL" => 93,
);

my @FORMAT = (
	magic       => 'a15',
	version     => 'C',
	name        => 'Ca32',
	description => 'Ca64x256',
	levelcount  => [1,
		single => 'C',
		multi  => 'C',
		race   => 'C',
		ctf    => 'C',
		total  => 'C',
	],
	moderef     => [1,
		map { (start => $_, end => $_) } [1,
			single     => 'C',
			peaworm    => 'C',
			tron       => 'C',
			deathmatch => 'C',
			foodmatch  => 'C',
			multifood  => 'C',
			timematch  => 'C',
			race       => 'C',
			ctf        => 'Cx',
		],
	],
	sprite     => ['8C',
		line => 'B8',
	],
	endtype     => 's',
	endstr      => 'Ca255',
	enddata     => 'Ca255x256',
	hiname      => 'a3',
	levels      => ['*', # levelcount->total actually
		id         => 'Ca22',
		name       => 'Ca22',
		size       => 'C',
		peas       => 'C',
		delay      => 'C',
		growth     => 'C',
		bsize      => 'C',
		sprite     => ['8C',
			line => 'B8',
		],
		balls      => ['32C',
			y   => 'C',
			x   => 'C',
			dir => 'C',
		],
		worms      => [4,
			d => 'C',
			y => 'C',
			x => 'C',
		],
		width      => 'C',
		height     => 'C',
		flags      => [2,
			y => 'C',
			x => 'C',
		],
		objects    => ['128C',
			type => 'C',
			x1   => 'C',
			y1   => 'C',
			x2   => 'C',
			y2   => 'C',
		],
	],
);

sub read {
	my ($self, $input) = @_;
	my ($id, $subid) = (substr($input, 0, 15), ord substr($input, 15, 1));
	my $version = $opt{version} // $MAGICID{$id}
		or die "File does not match any known WormEdit level header\n";
	$subid == $version
		or warn "Unsupported version $subid (expecting $version)\n";
	given ($version) {
		when (53) {
			# current @FORMAT
		}
		when ($_ <= 95 and $_ > 90) {
			ref $_ and pop @$_ for @{ $FORMAT[11] }; # only 8 moderefs
			$FORMAT[-1]->[-1]->[0] = '32C'; # less objects
			continue;
		}
		when (95) {
			$FORMAT[7] = 'Ca64'; # no reserved space after description
			#ref $_ and $_->[-1] = 'C' for @{ $FORMAT[11] }; # only 9 moderefs
			$FORMAT[19] = 'Ca255'; # enddata
			splice @FORMAT, 6, 2 if $subid < 95;  # early (sub)version without description
		}
		when ($_ <= 94 and $_ > 90) {
			splice @FORMAT, 6, 2;  # no description
			splice @{ $FORMAT[7] }, 4, 2;  # no race
			splice @FORMAT, 16, 2; # no enddata
			splice @{ $FORMAT[-1] }, 1, 2; # no name
			continue if $_ < 94;
		}
		when (93) {
			splice @FORMAT, 16, 2; # no hiname
			$FORMAT[-1]->[0] = 64; # constant amount of levels
		}
		default {
			die "Cannot parse data for Wormedit $version\n";
		}
	}

	# convert to an easily accessible hash
	my @values = unpack Shiar_Parse::Nested->template(\@FORMAT).'a*', $input;
	my $data = Shiar_Parse::Nested->convert(\@FORMAT, \@values);
	warn "Trailing data left unparsed\n" if grep {length} @values;
	$data->{format} = 'WormEdit';
	return $data;
}


package Shiar_Parse::WormyLevel;

sub read {
	my ($self, $input) = @_;
	my ($psize, $ptype, $size, $type, $vsize, $dsize, $id, $subid) = unpack q{
		x11 x42    # file signature and comment
		S a2 S a2  # file size, type; data size, type
		x8         # var name
		S S        # var size; content size
		CC         # wormy header
	}, $input;
	$ptype eq "\014\000"
		or die "Not a calculator string, thus cannot be a Wormy level file\n";
	$size == $psize - 16
		or warn "File size ($size) does not correspond with data size ($psize)\n";
	$type eq "\014\010"
		or die "Not a calculator string, thus cannot be a Wormy level file\n";
	$size == $vsize and $vsize == $dsize+2
		or warn "Mismatch in string data size declarations\n";
#	substr($input, -2) eq $CHECKSUM

	$input = substr $input, 73, -2;
	$id eq ord 'w'
		or die "Wormy level identifier not found\n";
	my @FORMAT = (
		magic       => 'a1',
		version     => 'C',
		name        => 'Z*',
		description => 'Z*',
		levelcount  => [1,
			total  => 'S',
		],
		moderef     => [1,
			map { (
				start => [1, map {$_ => 'S'} @$_],
				end   => [1, map {$_ => 'C'} @$_],
			) }
			[qw/single peaworm tron deathmatch foodmatch multifood timematch race ctf/]
		],
		theanswer => 'C', # 42
		sprite     => ['C',
			line => 'B8',
		],
		leveldata => 'a*',
	);
	my @LEVELFORM = (
		peas       => 'C',
		delay      => 'C',
		growth     => 'C',
		bsize      => 'C',
		sprite     => ['C',
			line => 'B8',
		],
		balls      => ['C',
			y   => 'C',
			x   => 'C',
			dir => 'C',
		],
		worms      => [1,
			d => 'C',
			y => 'C',
			x => 'C',
		],
		width      => 'C',
		height     => 'C',
		#levels
		#enddata
		#levels-multi
		#hinames
	);
	my @OBJECTFORM = (
			type => 'C',
			x1   => 'C',
			y1   => 'C',
			x2   => 'C',
			y2   => 'C',
	);

	given ($subid) {
		when (97) {
		}
		default {
			die "Unsupported level version $subid\n";
		}
	}

	my $data = Shiar_Parse::Nested->unpack(\@FORMAT, $input);
	while (length $data->{leveldata}) {
		my $level = Shiar_Parse::Nested->unpack([@LEVELFORM], $data->{leveldata});
		my $offset = 13
			+ 3 * (ref $level->{worms} eq 'ARRAY' ? scalar @{$level->{worms}} : 1)
			+ ($level->{sprite} ? scalar @{$level->{sprite}} : 0)
			+ ($level->{balls} ? 3 * scalar @{$level->{balls}} : 0);
		$level->{objects} = [];
		while (my $object = ord substr($data->{leveldata}, $offset, 1)) {
			push @{ $level->{objects} }, Shiar_Parse::Nested->unpack(
				[@OBJECTFORM], substr($data->{leveldata}, $offset, 5)
			);
			$offset += 5;
		}
		$level->{size} = $offset;
		$offset++;
		push @{ $data->{levels} }, $level;
		substr($data->{leveldata}, 0, $offset) = '';
		last if substr($data->{leveldata}, 0, 1) eq chr(255);
	}
	my $slots = 1; #TODO
	$data->{hinames} = [ unpack '(a3)*', substr($data->{leveldata}, -3 * $slots) ];
	$data->{enddata} = substr delete($data->{leveldata}), 0, -3 * $slots;
	$data->{format} = '86s';
	$data->{levelcount}->{single} = scalar @{ $data->{levels} };
	return $data;
}


package Shiar_Parse::Nested;

sub template {
	my ($self, $format) = @_;
	# total (flattened) unpack template from nested format definitions
	return join '', map {
		my $value = $format->[-($_ << 1) - 1];
		if (ref $value eq 'ARRAY') {
			my $count = $value->[0];
			$value = $self->template($value);
			$value = $count =~ s/^([*\d]+)// ? "$count($value)$1"
				: $count."X[$count]$count/($value)";
		}
		else {
			$value =~ s/^C(a)(\d+)/$1 . ($2 + 1)/e;  # length prefix
		}
		$value;
	} reverse 0 .. ($#$format - 1) >> 1;
}

sub convert {
	my ($self, $format, $data) = @_;
	# map flat results into a named and nested hash
	my %res;
	while (my ($field, $template) = splice @$format, 0, 2) {
		if (ref $template eq 'ARRAY') {
			my ($count, @subformat) = @$template;
			my $max = $count =~ s/^(\d+)// ? $1 : 0;
			$count = !$count ? $max
				: $count eq '*' ? $res{levelcount}->{total} : shift @$data;
			$res{$field}->[$_] = $self->convert([@subformat], $data) for 0 .. ($max || $count)-1;
			splice @{ $res{$field} }, $count if $max > $count;
			$res{$field} = $res{$field}->[0] if $max == 1;
			next;
		}
		elsif ($template =~ /^Ca/) {
			$data->[0] = CORE::unpack 'C/a', $data->[0];
		}
		$res{$field} = shift @$data;
	}
	return \%res;
}

sub unpack {
	my ($self, $format, $input) = @_;
	my @data = CORE::unpack $self->template($format), $input;
	return $self->convert($format, \@data);
}


package main;

my @OBJTYPE = ('none', 'line', 'fat line', 'bar', 'circle');
my @ENDTYPE = ('none', 'message', 'small message');

sub objsummary {
	my ($objects) = @_;
	my @objtypes = map { $_->{type} } @$objects;
	my %count;
	$count{$_}++ for @objtypes;
	return (@objtypes > 1 && keys %count == 1 && 'all ') . join(', ',
		map { $OBJTYPE[$_] ? $OBJTYPE[$_] . ($count{$_} > 1 && 's') : $_ }
		sort keys %count
	);
}

# read and parse all input data
my $data;
local $/;
my $rawdata = readline;
if (substr($rawdata, 0, 11) eq "**TI86**\032\012\000") {
	# compiled calculator file
	$data = Shiar_Parse::WormyLevel->read($rawdata);
}
elsif (substr($rawdata, 0, 8) eq 'WormEdit') {
	# original wormedit source
	$data = Shiar_Parse::WormEdit->read($rawdata);
}
else {
	die "Unrecognised file type\n";
}

# output with user-preferred formatting
if ($opt{raw}) {
	require JSON::XS;
	my $output = JSON::XS->new->ascii->canonical->pretty->allow_nonref;
	print $output->encode($data), "\n";
}
else {
	print $data->{name};
	print " ($data->{description})" if defined $data->{description};
	print "\n";
	printf "File version: %s\n", "$data->{format} v$data->{version}";
	printf "Defaults: %s\n", join('; ',
		'sprite ' . scalar @{ $data->{sprite} },
		defined $data->{hiname} ? 'hiscore by ' . $data->{hiname} : (),
	);

	my $startnr = 0;
	for my $variant (qw/single multi race ctf/) {
		my $count = $data->{levelcount}->{$variant};
		print "\n";
		printf '%s (%s)', ucfirst $variant, $count // 'invalid';
		$count or next;
		print ":";
		for (0 .. $count - 1) {
			my $level = $data->{levels}->[$_ + $startnr];
			printf("\n- %-22s%4s:%3s+%2s%3s %3sx%-3s%s",
				$level->{id} || $level->{name} || '#'.($_+1),
				@$level{qw/size bsize growth/},
				$variant eq 'single' && "x$level->{peas}",
				@$level{qw/width height/},
				join(';', map {" $_"} grep {$_}
					@{$level->{objects}} && sprintf('%2d object%s (%s)',
						scalar @{$level->{objects}}, @{$level->{objects}} != 1 && 's',
						objsummary($level->{objects}),
					),
					$level->{sprite} && @{$level->{sprite}} && sprintf('sprite %d',
						scalar @{$level->{sprite}},
					),
					$level->{balls} && @{$level->{balls}} && sprintf('%d bounc%s',
						scalar @{$level->{balls}}, @{$level->{balls}} == 1 ? 'y' : 'ies',
					),
				),
			);
		}
		$startnr += $count;
	}
	continue {
		print "\n";
		printf("-- %-21s%4s: %s (%s)\n",
			'(ending)',
			defined $data->{enddata} ? length $data->{enddata} : '?',
			defined $data->{endtype} ? $ENDTYPE[$data->{endtype}] || 'unknown' : 'code',
			$data->{endstr} // '?',
		) if $variant eq 'single';
	}
}

__END__

=head1 NAME

parse-wormedit - WormEdit level data parser

=head1 SYNOPSIS

 parse-wormedit [--raw] <input.lvl>

=head1 DESCRIPTION

Reads WormEdit v0.53 levels from STDIN or given file,
and outputs contents, summarised or in full.

=head1 AUTHOR

Mischa POSLAWSKY <wormy@shiar.org>

=head1 LICENSE

GPL version 3.