X-Git-Url: http://git.shiar.nl/wormy.git/blobdiff_plain/98c8b421ef7aa421c1377fd00da609cccac84067..7e3af99422406dfbf962f92927e77b6907e3f757:/parse-wormedit

diff --git a/parse-wormedit b/parse-wormedit
index 4f92959..473f49e 100755
--- a/parse-wormedit
+++ b/parse-wormedit
@@ -1,17 +1,24 @@
 #!/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',
@@ -82,13 +89,59 @@ my @FORMAT = (
 	],
 );
 
+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);
@@ -101,22 +154,47 @@ if ($opt{raw}) {
 	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';
 	}
 }