From 98c8b421ef7aa421c1377fd00da609cccac84067 Mon Sep 17 00:00:00 2001
From: Mischa Poslawsky <wormy@shiar.org>
Date: Tue, 24 Feb 2009 13:54:04 +0100
Subject: [PATCH] parse-wormedit: perl script to parse wormedit level data

Quickish script to summarise level contents, without requiring to
execute the editor (which involves an DOS environment and unparseable
output).

Code should also be much more readable than my horrible Pascal blob, so
simultaneously serves as a format description (and can return all data
in JSON structure, in case anyone has the desire to read it).
---
 parse-wormedit | 189 +++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 189 insertions(+)
 create mode 100755 parse-wormedit

diff --git a/parse-wormedit b/parse-wormedit
new file mode 100755
index 0000000..4f92959
--- /dev/null
+++ b/parse-wormedit
@@ -0,0 +1,189 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+
+use Data::Dumper;
+use Getopt::Long 2.33 qw(HelpMessage :config bundling);
+
+our $VERSION = '1.00';
+
+GetOptions(\my %opt,
+	'raw|r',
+) or HelpMessage(-exitval => 2);
+
+my $MAGICID = "WormEdit053\000LVL";
+
+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',
+		],
+	],
+);
+
+# read and parse all input data
+local $/;
+my @rawdata = unpack Shiar_Parse::Nested->template(\@FORMAT).'a*', readline;
+$rawdata[0] eq $MAGICID
+	or die "File does not match WormEdit level header\n";
+$rawdata[1] == 53
+	or warn "Unsupported version $rawdata[1] (expecting 53)\n";
+
+# 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} ($data->{description})\n";
+	my $startnr = 0;
+	for my $variant (qw/single multi race ctf/) {
+		print "\n";
+		my $count = $data->{levelcount}->{$variant};
+		printf "\u$variant ($count)";
+		$count or next;
+		print ":";
+		printf("\n- %-22s (%3sx%3s, %d objects)",
+			$_->{id}, $_->{width}, $_->{height}, scalar @{ $_->{objects} },
+		) for map { $data->{levels}->[$_ + $startnr] }
+			0 .. $count - 1;
+		$startnr += $count;
+	}
+	continue {
+		print "\n";
+	}
+}
+
+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.
+
-- 
2.30.0