From 1bb353295426ce22afb72a18ca4899c52f9efee9 Mon Sep 17 00:00:00 2001
From: Mischa Poslawsky <wormy@shiar.org>
Date: Mon, 2 Mar 2009 04:49:19 +0100
Subject: [PATCH] parse-wormedit: support older 86s formats

---
 parse-wormedit | 71 +++++++++++++++++++++++++++++++++++++++-----------
 1 file changed, 56 insertions(+), 15 deletions(-)

diff --git a/parse-wormedit b/parse-wormedit
index 4fd22e7..42d9d21 100755
--- a/parse-wormedit
+++ b/parse-wormedit
@@ -163,10 +163,11 @@ use strict;
 use warnings;
 
 use List::Util qw(sum min max);
+use Data::Dumper;
 
 sub read {
 	my ($self, $input) = @_;
-	my ($psize, $ptype, $size, $type, $vsize, $dsize, $id, $subid) = unpack q{
+	my ($psize, $ptype, $size, $type, $vsize, $dsize, $id, $version) = unpack q{
 		x11 x42    # file signature and comment
 		S a2 S a2  # file size, type; data size, type
 		x8         # var name
@@ -186,6 +187,17 @@ sub read {
 	$input = substr $input, 73, -2;
 	$id eq ord 'w'
 		or die "Wormy level identifier not found\n";
+
+	if ($opt{version}) {
+		warn "Override version $version to $opt{version}\n";
+		$version = $opt{version};
+	}
+	elsif ($version == 95) {
+		# level offset instead of description byte
+		$version-- if (unpack('x2Z*x2xC', $input))[1] == 0xF4;
+		warn "Ambiguous file version 95; guessing subversion $version\n";
+	}
+
 	my @FORMAT = (
 		magic       => 'a1',
 		version     => 'C',
@@ -243,23 +255,41 @@ sub read {
 			x2   => 'C',
 			y2   => 'C',
 	);
+	my $offsetbase = 0xF080;
 
-	given ($subid) {
+	given ($version) {
 		when (97) {
 			# current @FORMAT
 		}
-		when (95) {
-			ref $_ and splice @$_, -2 for @{ $FORMAT[11] }; # only 8 moderefs
-			splice @FORMAT, 12, 2;  # no reserved byte
+			$offsetbase = 0xF400;
+		when (95) {}
+			splice @FORMAT, 6, 2;
+			ref $_ and splice(@$_, -8, 2) for @{ $FORMAT[9] }; # no multifood
+			splice @FORMAT, 10, 2;  # no reserved byte
+		when (94) {}
+		when (90) {
+			$FORMAT[5] = 'C/a';  # length-preceding name
+			splice @FORMAT, 10, 2;  # no default sprite
+			ref $_ and do {
+				$_->[5] = $_->[7];  # no tron; deathmatch instead
+				$_->[7] = $_->[9];  # foodmatch instead
+				$_->[9] = 'linkmatch';  # replaces timematch
+				$_->[11] = $_->[13];  # race
+				$_->[13] = $_->[15];  # ctf
+				$_->[15] = 'domination';
+			} for @{ $FORMAT[9] }; # no multifood
+			push @LEVELFORM, "object$_" => ['C',
+				map {$_ => 'C'} qw(x1 y1 x2 y2)
+			] for qw(lines boxes);
 		}
 		default {
-			die "Unsupported level version $subid\n";
+			die "Unsupported level version $version\n";
 		}
 	}
 
 	my $data = Shiar_Parse::Nested->unpack(\@FORMAT, $input);
 	my $offset = 0;
-	my $offsetbase = 0xF080 + @{ $data->{sprite} } + 1;
+	$offsetbase += 1 + @{ $data->{sprite} } if $data->{sprite};
 	$data->{moderef}->{offset}->{single} == $offsetbase
 		or warn "First singleplayer level is not in front\n";
 
@@ -281,15 +311,19 @@ sub read {
 	$data->{levels} = [];
 	for my $modes (@VARMODES) {
 		my $variant = shift @$modes;
-		$offset = min(grep {$_} map { $data->{moderef}->{offset}->{$_} } @$modes)
-			or next;
+		my @modeoffsets = grep {defined} #TODO: comment
+			map { $data->{moderef}->{offset}->{$_} } @$modes;
+		@modeoffsets or next;
+		$data->{levelcount}->{$variant} = 0;
+		$offset = min(grep {$_} @modeoffsets) or next;
 		$offset -= $offsetbase;
-		my $amount = $variant eq 'single' ? 100 : max(map { $data->{moderef}->{end}->{$_} } @$modes);
+		my $amount = $variant eq 'single' ? 100
+			: max(grep {defined} map { $data->{moderef}->{end}->{$_} } @$modes);
 
 		my @varform = @LEVELFORM;
 		$varform[13]->[0] = $variant eq 'single' ? 1 : 4;
-		unshift @varform, name => 'Z*' unless $variant eq 'single';
-		$varform[-1]->[0] = 1 if $variant eq 'race';
+		unshift @varform, name => 'Z*' unless $variant eq 'single' or $version <= 91;
+		$varform[-1]->[0] = 1 if $variant eq 'race' and $version > 91;
 		$varform[-1]->[0] = 2 if $variant eq 'ctf';
 
 		while ($offset < length $data->{leveldata}) {
@@ -315,12 +349,19 @@ sub read {
 
 			# add objects until terminator
 			$level->{objects} = [];
+		if ($version <= 91) {
+			push @{ $level->{objects} }, { %$_, type => 2 } for map { $level->{$_} ? @{ $level->{$_} } : () } qw(objectlines);
+			push @{ $level->{objects} }, { %$_, type => 3 } for map { $level->{$_} ? @{ $level->{$_} } : () } qw(objectboxes);
+			$size += 1 + 4 * scalar @{ $level->{objects} };
+		}
+		else {
 			while (my $object = ord substr($data->{leveldata}, $offset+$size, 1)) {
 				push @{ $level->{objects} }, Shiar_Parse::Nested->unpack(
 					[@OBJECTFORM], substr($data->{leveldata}, $offset+$size, 5)
 				);
 				$size += 5;
 			}
+		}
 
 			# add parsed level and advance
 			push @{ $data->{levels} }, $level;
@@ -331,7 +372,7 @@ sub read {
 		if ($variant eq 'single') {
 			$offset++;
 			$data->{finish}->{code} =
-			my $code = substr delete($data->{leveldata}), $offset, -5*$slots;
+			my $code = substr $data->{leveldata}, $offset, -5*$slots;
 
 			my %FINISHCODE = (
 				0 => chr 0xC9, # ret
@@ -358,7 +399,7 @@ sub read {
 			);
 			while (my ($finish, $match) = each %FINISHCODE) {
 				$match eq substr $code, 0, length $match or next;
-				$data->{finish}->{type} = $finish or last;
+				$data->{finish}->{type} = $finish and
 				$data->{finish}->{message} = unpack 'Z*', substr($code, length $match);
 				last;
 			}
@@ -480,7 +521,7 @@ else {
 	print "\n";
 	printf "File version: %s\n", "$data->{format} v$data->{version}";
 	printf "Defaults: %s\n", join('; ',
-		'sprite ' . scalar @{ $data->{sprite} },
+		$data->{sprite} ? 'sprite ' . scalar @{ $data->{sprite} } : (),
 		defined $data->{hiname} ? 'hiscore by ' . $data->{hiname} : (),
 	);
 
-- 
2.30.0