X-Git-Url: http://git.shiar.nl/wormy.git/blobdiff_plain/bcdfb41a503e9135caaffa151f770f5aa522757c..7c64957ec9a87cf71ccf5fa7c28bb8c37b27efc6:/parse-wormedit

diff --git a/parse-wormedit b/parse-wormedit
index 26d6cbd..84e4e31 100755
--- a/parse-wormedit
+++ b/parse-wormedit
@@ -54,9 +54,11 @@ my @FORMAT = (
 	sprite     => ['8C',
 		line => 'B8',
 	],
-	endtype     => 's',
-	endstr      => 'Ca255',
-	enddata     => 'Ca255x256',
+	finish      => [1,
+		type    => 's',
+		message => 'Ca255',
+		code    => 'Ca255x256',
+	],
 	hiname      => 'a3',
 	levels      => ['*', # levelcount->total actually
 		id         => 'Ca22',
@@ -97,39 +99,52 @@ my @FORMAT = (
 
 sub read {
 	my ($self, $input) = @_;
-	my ($id, $subid) = (substr($input, 0, 15), ord substr($input, 15, 1));
-	my $version = $opt{version} // $MAGICID{$id}
+	my ($id, $version) = (substr($input, 0, 15), ord substr($input, 15, 1));
+	my $fileversion = $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
+
+	if ($opt{version}) {
+		warn "Override version $version to $opt{version}\n";
+		$version = $opt{version};
+	}
+	elsif ($version != $fileversion) {
+		warn "Unexpected version $version (expecting $fileversion)\n";
+	}
+	elsif ($version == 95) {
+		# auto-detect exact variant
+		if (ord substr($input, 70, 1) ~~ [1 .. 8]) {
+			# valid sprite length instead of description byte
+			# (which is usually a letter or nul)
+			$version = 94;
 		}
-		when ($_ <= 95 and $_ > 90) {
-			ref $_ and pop @$_ for @{ $FORMAT[11] }; # only 8 moderefs
-			$FORMAT[-1]->[-1]->[0] = '32C'; # less objects
-			continue;
+		elsif (ord substr($input, 147, 1) == 0) {
+			# nul of finish type is 2 bytes later (unlike first char of message)
+			$version = 96;
 		}
-		when (95) {
+		warn "Ambiguous file version 95; guessing subversion $version\n";
+	};
+
+	$fileversion += 100 if $fileversion < 90;  # 93..95 came before 50..53
+	given ($fileversion) {
+		when (153) { } # current @FORMAT
 			$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
+			$FORMAT[15]->[-1] = 'Ca255'; # enddata
+			$FORMAT[-1]->[-1]->[0] = '32C'; # less objects
+		when ($version == 96) {
+			ref $_ and $_->[-1] = 'C' for @{ $FORMAT[11] }; # 9 moderefs
 		}
-		when ($_ <= 94 and $_ > 90) {
-			splice @FORMAT, 6, 2;  # no description
+			ref $_ and pop @$_ for @{ $FORMAT[11] }; # only 8 moderefs
+			splice @FORMAT, 6, 2 if $version <= 94;  # earlier version without description
+		when (95) { }
 			splice @{ $FORMAT[7] }, 4, 2;  # no race
-			splice @FORMAT, 16, 2; # no enddata
+			splice @{ $FORMAT[13] }, 4, 2; # no enddata
 			splice @{ $FORMAT[-1] }, 1, 2; # no name
-			continue if $_ < 94;
-		}
-		when (93) {
-			splice @FORMAT, 16, 2; # no hiname
+		when (94) { }
+			splice @FORMAT, 14, 2; # no hiname
 			$FORMAT[-1]->[0] = 64; # constant amount of levels
-		}
+		when (93) { }
 		default {
-			die "Cannot parse data for Wormedit $version\n";
+			die "Cannot parse data for Wormedit $fileversion/$version\n";
 		}
 	}
 
@@ -148,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
@@ -171,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',
@@ -217,7 +244,7 @@ sub read {
 			x => 'C',
 		],
 		#levels
-		#enddata
+		#finish code
 		#levels-multi
 		#hinames
 	);
@@ -228,26 +255,53 @@ 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
+			$offsetbase = 0xF400;
+		when (96) {}
+			ref $_ and splice(@$_, -8, 2) for @{ $FORMAT[11] }; # no multifood
 			splice @FORMAT, 12, 2;  # no reserved byte
+		when (95) {}
+			splice @FORMAT, 6, 2;  # no description
+		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";
 
+	my $slots = sum(
+		$data->{moderef}->{end}->{single} > 0,  # singleplayer slot if any levels
+		$data->{moderef}->{end}->{peaworm},     # one for each peaworm arena
+		$data->{moderef}->{end}->{tron},        # idem for tron
+	);
+	$data->{hinames} = [ unpack '(x2a3)*', substr($data->{leveldata}, -5 * $slots) ];
+	$data->{format} = '86s';
+
 	my @VARMODES = (
 		[qw'single  single'],
 		[qw'multi   peaworm tron deathmatch foodmatch multifood timematch'],
@@ -258,13 +312,19 @@ sub read {
 	$data->{levels} = [];
 	for my $modes (@VARMODES) {
 		my $variant = shift @$modes;
-		$offset = min(map { $data->{moderef}->{offset}->{$_} } @$modes) - $offsetbase;
-		my $amount = $variant eq 'single' ? 100 : max(map { $data->{moderef}->{end}->{$_} } @$modes);
+		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(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}) {
@@ -290,28 +350,63 @@ 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;
 			$offset += ++$size;
 			last if ++$data->{levelcount}->{$variant} >= $amount;
 		}
+
+		if ($variant eq 'single') {
+			$offset++;
+			$data->{finish}->{code} =
+			my $code = substr $data->{leveldata}, $offset, -5*$slots;
+
+			my %FINISHCODE = (
+				0 => chr 0xC9, # ret
+				1 => join('',
+					chr 0x21,  # ld hl, MESSAGE
+					pack('v', $offsetbase + $offset + 9),
+					(map {chr}
+						0xCD, 0x37, 0x4A,  # call _puts
+						0xC3, 0xAA, 0x55,  # jp _getkey
+					),
+				),
+				2 => join('',
+					(map {chr}
+						0x21, 0, 0x1C,  # ld hl, $POS
+						0x22, 0x7C, 0xC3, # ld (_penCol), hl
+						0x21,  # ld hl, MESSAGE
+					),
+					pack('v', $offsetbase + $offset + 15),
+					(map {chr}
+						0xCD, 0xA5, 0x4A, # call _vputs
+						0xC3, 0xAA, 0x55, # jp _getkey
+					),
+				),
+			);
+			while (my ($finish, $match) = each %FINISHCODE) {
+				$match eq substr $code, 0, length $match or next;
+				$data->{finish}->{type} = $finish and
+				$data->{finish}->{message} = unpack 'Z*', substr($code, length $match);
+				last;
+			}
+		}
 	}
 
-	my $slots = sum(
-		$data->{moderef}->{end}->{single} > 0,  # singleplayer slot if any levels
-		$data->{moderef}->{end}->{peaworm},     # one for each peaworm arena
-		$data->{moderef}->{end}->{tron},        # idem for tron
-	);
-	$data->{hinames} = [ unpack '(x2a3)*', substr($data->{leveldata}, -5 * $slots) ];
-	$data->{enddata} = substr delete($data->{leveldata}), $offset, -5 * $slots; #XXX
-	$data->{format} = '86s';
 	return $data;
 }
 
@@ -400,9 +495,26 @@ else {
 
 # 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";
+	# full data in yaml (human-readable) formatting
+	require YAML;
+	local $YAML::CompressSeries;
+	      $YAML::CompressSeries = 0;
+	my $yml = "# Wormy levelset\n" . YAML::Dump($data);
+
+	# inline format of short hashes
+	$yml =~ s{
+		^(\ *) - \n                          # array indicator
+		((?:\1\ \ [a-z0-9]{1,5}:\ *\d+\n)+)  # simple hash declaration
+		(?!\1\ )                             # no further children
+	}[
+		my ($indent, $value) = ($1, $2);
+		chop $value;
+		$value =~ s/^ +//gm;
+		$value =~ s/\n/, /g;
+		"$indent- {$value}\n";
+	]egmx;
+
+	print $yml;
 }
 else {
 	print $data->{name};
@@ -410,7 +522,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} : (),
 	);
 
@@ -448,9 +560,11 @@ else {
 		print "\n";
 		printf("-- %-21s%4s: %s (%s)\n",
 			'(ending)',
-			defined $data->{enddata} ? length $data->{enddata} : '?',
-			defined $data->{endtype} ? $ENDTYPE[$data->{endtype}] || 'unknown' : 'code',
-			$data->{endstr} // '?',
+			defined $data->{finish}->{code}
+				? length $data->{finish}->{code} : '?',
+			defined $data->{finish}->{type}
+				? $ENDTYPE[$data->{finish}->{type}] || 'unknown' : 'code',
+			$data->{finish}->{message} // '?',
 		) if $variant eq 'single';
 	}
 }