#!/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.00';
+our $VERSION = '1.02';
GetOptions(\my %opt,
- 'raw|r',
+ 'raw|r', # full output
+ 'version=i', # force version
) or HelpMessage(-exitval => 2);
-my $MAGICID = "WormEdit053\000LVL";
+my %MAGICID = (
+ "WormEdit053\000LVL" => 53,
+ "WormEdit\34195\000LVL" => 95,
+ "WormEdit\34194\000LVL" => 94,
+ "WormEdit\34193\000LVL" => 93,
+);
my @FORMAT = (
magic => 'a15',
],
);
+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 = 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";
+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);
print $output->encode($data), "\n";
}
else {
- print "$data->{name} ($data->{description})\n";
+ 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/) {
- print "\n";
my $count = $data->{levelcount}->{$variant};
- printf "\u$variant ($count)";
+ print "\n";
+ printf '%s (%s)', ucfirst $variant, $count // 'invalid';
$count or next;
print ":";
- printf("\n- %-22s (%3sx%3s, %d objects)",
- $_->{id}, $_->{width}, $_->{height}, scalar @{ $_->{objects} },
+ 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';
}
}