Parse::Binary::Nested: byte-terminated groups

[wormy.git] / parse-wormedit

diff --git a/parse-wormedit b/parse-wormedit
index 3811863103ea42ea4719a1310eca52e4852b89b1..77580676baee866cb3e67ad1a7fa4c6f41146143 100755 (executable)
--- a/parse-wormedit
+++ b/parse-wormedit
@@ -19,7 +19,7 @@ package Shiar_Parse::WormEdit;
 use strict;
 use warnings;
 
-use Parse::Binary::Nested;
+use Parse::Binary::Nested qw(unpackf);
 
 our %MAGICID = (
        "WormEdit053\000LVL" => 53,
@@ -31,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',
@@ -50,7 +50,8 @@ my @FORMAT = (
                        multifood  => 'C',
                        timematch  => 'C',
                        race       => 'C',
-                       ctf        => 'Cx',
+                       ctf        => 'C',
+                       reserved   => 'x',
                ],
        ],
        sprite     => ['8C',
@@ -58,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',
@@ -129,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
@@ -152,7 +153,7 @@ sub read {
 
        # convert to an easily accessible hash
        push @FORMAT, -trail => 'a*';
-       my $data = Parse::Binary::Nested->new(\@FORMAT)->unpackf($input);
+       my $data = unpackf(\@FORMAT, $input);
        warn "Trailing data left unparsed\n" if length delete $data->{-trail};
        $data->{format} = 'WormEdit';
        return $data;
@@ -166,7 +167,7 @@ use warnings;
 
 use List::Util qw(sum min max);
 use Data::Dumper;
-use Parse::Binary::Nested;
+use Parse::Binary::Nested qw(unpackf);
 
 sub read {
        my ($self, $input) = @_;
@@ -216,11 +217,15 @@ sub read {
                        ) }
                        [qw/single peaworm tron deathmatch foodmatch multifood timematch race ctf/]
                ],
-               theanswer => 'C', # 42
+               theanswer => 'x', # 42
                sprite     => ['C',
                        line => 'B8',
                ],
                leveldata => 'a*',
+               #levels
+               #finish code
+               #levels-multi
+               #hinames
        );
        my @LEVELFORM = (
                peas       => 'C',
@@ -246,17 +251,13 @@ sub read {
                        y => 'C',
                        x => 'C',
                ],
-               #levels
-               #finish code
-               #levels-multi
-               #hinames
-       );
-       my @OBJECTFORM = (
+               objects    => ['?0',
                        type => 'C',
                        x1   => 'C',
                        y1   => 'C',
                        x2   => 'C',
                        y2   => 'C',
+               ],
        );
        my $offsetbase = 0xF080;
 
@@ -282,16 +283,18 @@ sub read {
                                $_->[13] = $_->[15];  # ctf
                                $_->[15] = 'domination';
                        } for @{ $FORMAT[9] }; # no multifood
-                       push @LEVELFORM, "object$_" => ['C',
+                       splice @LEVELFORM, -2;
+                       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 = Parse::Binary::Nested->new(\@FORMAT)->unpackf($input);
+       my $data = unpackf(\@FORMAT, $input);
        my $offset = 0;
        $offsetbase += 1 + @{ $data->{sprite} } if $data->{sprite};
        $data->{moderef}->{offset}->{single} == $offsetbase
@@ -327,8 +330,9 @@ sub read {
                my @varform = @LEVELFORM;
                $varform[13]->[0] = $variant eq 'single' ? 1 : 4;
                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';
+               $varform[-3]->[0] = 1 if $variant eq 'race' and $version > 91;
+               $varform[-3]->[0] = 2 if $variant eq 'ctf';
+               push @varform, size => '=.';
                my $parselevel = Parse::Binary::Nested->new(\@varform);
 
                while ($offset < length $data->{leveldata}) {
@@ -341,34 +345,18 @@ sub read {
                        }
 
                        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->{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} };
-               }
-               else {
-                       while (my $object = ord substr($data->{leveldata}, $offset+$size, 1)) {
-                               push @{ $level->{objects} }, Parse::Binary::Nested->new([@OBJECTFORM])->unpackf(
-                                       substr $data->{leveldata}, $offset+$size, 5
-                               );
-                               $size += 5;
-                       }
+                       ref $_ eq 'ARRAY' and push @{ $level->{objects} }, @$_
+                               for map { delete $level->{"objects$_"} } 2, 3;
                }
 
                        # add parsed level and advance
                        push @{ $data->{levels} }, $level;
-                       $offset += ++$size;
+                       $offset += $level->{size};
                        last if ++$data->{levelcount}->{$variant} >= $amount;
                }