X-Git-Url: http://git.shiar.nl/wormy.git/blobdiff_plain/1bb353295426ce22afb72a18ca4899c52f9efee9..f4886cc6c2159afd00025585fcc6ea7aac820391:/parse-wormedit

diff --git a/parse-wormedit b/parse-wormedit
index 42d9d21..ed64118 100755
--- a/parse-wormedit
+++ b/parse-wormedit
@@ -6,7 +6,7 @@ use 5.010;
 use Data::Dumper;
 use Getopt::Long 2.33 qw(HelpMessage :config bundling);
 
-our $VERSION = '1.03';
+our $VERSION = '1.04';
 
 GetOptions(\my %opt,
 	'raw|r',  # full output
@@ -19,6 +19,8 @@ package Shiar_Parse::WormEdit;
 use strict;
 use warnings;
 
+use Parse::Binary::Nested qw(unpackf);
+
 our %MAGICID = (
 	"WormEdit053\000LVL" => 53,
 	"WormEdit\34195\000LVL" => 95,
@@ -29,8 +31,8 @@ our %MAGICID = (
 my @FORMAT = (
 	magic       => 'a15',
 	version     => 'C',
-	name        => 'Ca32',
-	description => 'Ca64x256',
+	name        => 'C/a32',
+	description => 'C/a64x256',
 	levelcount  => [1,
 		single => 'C',
 		multi  => 'C',
@@ -48,7 +50,8 @@ my @FORMAT = (
 			multifood  => 'C',
 			timematch  => 'C',
 			race       => 'C',
-			ctf        => 'Cx',
+			ctf        => 'C',
+			reserved   => 'x',
 		],
 	],
 	sprite     => ['8C',
@@ -56,13 +59,14 @@ my @FORMAT = (
 	],
 	finish      => [1,
 		type    => 's',
-		message => 'Ca255',
-		code    => 'Ca255x256',
+		message => 'C/a255',
+		code    => 'C/a255',
+		reserved=> 'x256',
 	],
 	hiname      => 'a3',
 	levels      => ['*', # levelcount->total actually
-		id         => 'Ca22',
-		name       => 'Ca22',
+		id         => 'C/a22',
+		name       => 'C/a22',
 		size       => 'C',
 		peas       => 'C',
 		delay      => 'C',
@@ -127,13 +131,12 @@ sub read {
 	$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
-			$FORMAT[15]->[-1] = 'Ca255'; # enddata
+			$FORMAT[7] = 'C/a64'; # no reserved space after description
+			splice @{ $FORMAT[15] }, -2; # finish reserve
 			$FORMAT[-1]->[-1]->[0] = '32C'; # less objects
-		when ($version == 96) {
-			ref $_ and $_->[-1] = 'C' for @{ $FORMAT[11] }; # 9 moderefs
-		}
-			ref $_ and pop @$_ for @{ $FORMAT[11] }; # only 8 moderefs
+			ref $_ and pop @$_ for @{ $FORMAT[11] }; # 9 moderefs
+		when ($version == 96) { }
+			ref $_ and pop @$_ for @{ $FORMAT[11] }; # only 8 moderefs (no ctf)
 			splice @FORMAT, 6, 2 if $version <= 94;  # earlier version without description
 		when (95) { }
 			splice @{ $FORMAT[7] }, 4, 2;  # no race
@@ -149,9 +152,9 @@ sub read {
 	}
 
 	# convert to an easily accessible hash
-	my @values = unpack Shiar_Parse::Nested->template(\@FORMAT).'a*', $input;
-	my $data = Shiar_Parse::Nested->convert(\@FORMAT, \@values);
-	warn "Trailing data left unparsed\n" if grep {length} @values;
+	push @FORMAT, -trail => 'a*';
+	my $data = unpackf(\@FORMAT, $input);
+	warn "Trailing data left unparsed\n" if length delete $data->{-trail};
 	$data->{format} = 'WormEdit';
 	return $data;
 }
@@ -164,6 +167,7 @@ use warnings;
 
 use List::Util qw(sum min max);
 use Data::Dumper;
+use Parse::Binary::Nested qw(unpackf);
 
 sub read {
 	my ($self, $input) = @_;
@@ -213,7 +217,7 @@ sub read {
 			) }
 			[qw/single peaworm tron deathmatch foodmatch multifood timematch race ctf/]
 		],
-		theanswer => 'C', # 42
+		theanswer => 'x', # 42
 		sprite     => ['C',
 			line => 'B8',
 		],
@@ -262,10 +266,11 @@ sub read {
 			# current @FORMAT
 		}
 			$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;
-			ref $_ and splice(@$_, -8, 2) for @{ $FORMAT[9] }; # no multifood
-			splice @FORMAT, 10, 2;  # no reserved byte
+			splice @FORMAT, 6, 2;  # no description
 		when (94) {}
 		when (90) {
 			$FORMAT[5] = 'C/a';  # length-preceding name
@@ -278,16 +283,17 @@ sub read {
 				$_->[13] = $_->[15];  # ctf
 				$_->[15] = 'domination';
 			} for @{ $FORMAT[9] }; # no multifood
-			push @LEVELFORM, "object$_" => ['C',
+			push @LEVELFORM, "objects$_" => ['C',
+				type => "=$_",
 				map {$_ => 'C'} qw(x1 y1 x2 y2)
-			] for qw(lines boxes);
+			] for 2, 3;
 		}
 		default {
 			die "Unsupported level version $version\n";
 		}
 	}
 
-	my $data = Shiar_Parse::Nested->unpack(\@FORMAT, $input);
+	my $data = unpackf(\@FORMAT, $input);
 	my $offset = 0;
 	$offsetbase += 1 + @{ $data->{sprite} } if $data->{sprite};
 	$data->{moderef}->{offset}->{single} == $offsetbase
@@ -325,6 +331,8 @@ sub read {
 		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';
+		push @varform, size => '=.';
+		my $parselevel = Parse::Binary::Nested->new(\@varform);
 
 		while ($offset < length $data->{leveldata}) {
 			last if substr($data->{leveldata}, $offset, 1) eq chr(255);
@@ -335,29 +343,26 @@ sub read {
 				$data->{moderef}->{start}->{$mode} = 1 + scalar @{ $data->{levels} };
 			}
 
-			my $level = Shiar_Parse::Nested->unpack(
-				[@varform], substr $data->{leveldata}, $offset
-			);
+			my $level = $parselevel->unpackf(substr $data->{leveldata}, $offset);
 			my $size = 8  # unpack length (ugh, ugly recalculation)
 				+ (defined $level->{name} ? 1 + length $level->{name} : 0)
 				+ 3 * (ref $level->{worms} eq 'ARRAY' ? scalar @{$level->{worms}} : 1)
 				+ 2 * ($level->{flags} ? ref $level->{flags} eq 'ARRAY' ? scalar @{$level->{flags}} : 1 : 0)
 				+ ($level->{sprite} ? scalar @{$level->{sprite}} : 0)
 				+ ($level->{balls} ? 3 * scalar @{$level->{balls}} : 0);
-			$level->{size} = $size;
+			$level->{sizecalc} = $size;
 			$level->{offset} = $offset + $offsetbase;
 
 			# 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} };
+			ref $_ eq 'ARRAY' and push @{ $level->{objects} }, @$_
+				for map { delete $level->{"objects$_"} } 2, 3;
 		}
 		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)
+				push @{ $level->{objects} }, Parse::Binary::Nested->new([@OBJECTFORM])->unpackf(
+					substr $data->{leveldata}, $offset+$size, 5
 				);
 				$size += 5;
 			}
@@ -365,7 +370,7 @@ sub read {
 
 			# add parsed level and advance
 			push @{ $data->{levels} }, $level;
-			$offset += ++$size;
+			$offset += $level->{size};
 			last if ++$data->{levelcount}->{$variant} >= $amount;
 		}
 
@@ -410,56 +415,6 @@ sub read {
 }
 
 
-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;
-			$res{$field}->[$_] = $self->convert([@subformat], $data) for 0 .. ($max || $count)-1;
-			splice @{ $res{$field} }, $count if $max > $count;
-			$res{$field} = $res{$field}->[0] if $max == 1;
-			next;
-		}
-		elsif ($template =~ /^Ca/) {
-			$data->[0] = CORE::unpack 'C/a', $data->[0];
-		}
-		$res{$field} = shift @$data;
-	}
-	return \%res;
-}
-
-sub unpack {
-	my ($self, $format, $input) = @_;
-	my @data = CORE::unpack $self->template($format), $input;
-	return $self->convert($format, \@data);
-}
-
-
 package main;
 
 my @OBJTYPE = ('none', 'line', 'fat line', 'bar', 'circle');