#!/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);

my %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',
		],
	],
);

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
local $/;
my $rawdata = readline;
my ($id, $subid) = (substr($rawdata, 0, 15), ord substr($rawdata, 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";
	}
}
my @rawdata = unpack Shiar_Parse::Nested->template(\@FORMAT).'a*', $rawdata;

# convert to an easily accessible hash
my $data = Shiar_Parse::Nested->convert(\@FORMAT, \@rawdata);
warn "Trailing data left unparsed\n" if grep {length} @rawdata;

# 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", "WormEdit 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 ":";
		printf("\n- %-22s%4s:%3s+%2s%3s %3sx%-3s%s",
			$_->{id} || $_->{name},
			@$_{qw/size bsize growth/},
			$variant eq 'single' && "x$_->{peas}",
			@$_{qw/width height/},
			join(';', map {" $_"} grep {$_}
				@{$_->{objects}} && sprintf('%2d object%s (%s)',
					scalar @{$_->{objects}}, @{$_->{objects}} != 1 && 's',
					objsummary($_->{objects}),
				),
				@{$_->{sprite}} && sprintf('sprite %d',
					scalar @{$_->{sprite}},
				),
			),
		) for map { $data->{levels}->[$_ + $startnr] }
			0 .. $count - 1;
		$startnr += $count;
	}
	continue {
		print "\n";
		printf("-- %-21s%4s: %s (%s)\n",
			'(ending)',
			defined $data->{enddata} ? length $data->{enddata} : '?',
			$ENDTYPE[$data->{endtype}] || 'unknown', $data->{endstr},
		) if $variant eq 'single';
	}
}

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;
			$max ||= $count;
			$res{$field}->[$_] = $self->convert([@subformat], $data) for 0 .. $max-1;
			splice @{ $res{$field} }, $count if $max > $count;
			$res{$field} = $res{$field}->[0] if $max == 1;
			next;
		}
		elsif ($template =~ /^Ca/) {
			$data->[0] = unpack 'C/a', $data->[0];
		}
		$res{$field} = shift @$data;
	}
	return \%res;
}

__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.