completed first 2 'worms for dinner' levelsets

[wormy.git] / parse-wormedit

diff --git a/parse-wormedit b/parse-wormedit
index 84e4e31c0140810983205359b0b05df2d3a54283..81c073418c9d1c11f86e956867ec1bba20e9ed9e 100755 (executable)
--- 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;
+
 our %MAGICID = (
        "WormEdit053\000LVL" => 53,
        "WormEdit\34195\000LVL" => 95,
@@ -48,7 +50,8 @@ my @FORMAT = (
                        multifood  => 'C',
                        timematch  => 'C',
                        race       => 'C',
-                       ctf        => 'Cx',
+                       ctf        => 'C',
+                       reserved   => 'x',
                ],
        ],
        sprite     => ['8C',
@@ -57,7 +60,8 @@ my @FORMAT = (
        finish      => [1,
                type    => 's',
                message => 'Ca255',
-               code    => 'Ca255x256',
+               code    => 'Ca255',
+               reserved=> 'x256',
        ],
        hiname      => 'a3',
        levels      => ['*', # levelcount->total actually
@@ -128,12 +132,11 @@ sub read {
        given ($fileversion) {
                when (153) { } # current @FORMAT
                        $FORMAT[7] = 'Ca64'; # no reserved space after description
-                       $FORMAT[15]->[-1] = 'Ca255'; # enddata
+                       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 = Parse::Binary::Nested->new(\@FORMAT)->unpackf($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;
 
 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',
                ],
@@ -288,7 +292,7 @@ sub read {
                }
        }
 
-       my $data = Shiar_Parse::Nested->unpack(\@FORMAT, $input);
+       my $data = Parse::Binary::Nested->new(\@FORMAT)->unpackf($input);
        my $offset = 0;
        $offsetbase += 1 + @{ $data->{sprite} } if $data->{sprite};
        $data->{moderef}->{offset}->{single} == $offsetbase
@@ -326,6 +330,7 @@ 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';
+               my $parselevel = Parse::Binary::Nested->new(\@varform);
 
                while ($offset < length $data->{leveldata}) {
                        last if substr($data->{leveldata}, $offset, 1) eq chr(255);
@@ -336,9 +341,7 @@ 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)
@@ -357,8 +360,8 @@ sub read {
                }
                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;
                        }
@@ -411,56 +414,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');