parse-wormedit: perl script to parse wormedit level data
authorMischa Poslawsky <wormy@shiar.org>
Tue, 24 Feb 2009 12:54:04 +0000 (13:54 +0100)
committerMischa Poslawsky <wormy@shiar.org>
Mon, 2 Mar 2009 21:42:35 +0000 (22:42 +0100)
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 [new file with mode: 0755]

diff --git a/parse-wormedit b/parse-wormedit
new file mode 100755 (executable)
index 0000000..4f92959
--- /dev/null
@@ -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.
+