parse-wormedit: parse multiplayer levels in 86s files

diff --git a/parse-wormedit b/parse-wormedit
index 8c441a4bdb2fe459f468e0a209614d98b3cdb1d8..26d6cbde3671b3c751a48bd69881f64d6e572d42 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.02';
+our $VERSION = '1.03';
 
 GetOptions(\my %opt,
        'raw|r',  # full output
@@ -144,6 +144,11 @@ sub read {
 
 package Shiar_Parse::WormyLevel;
 
+use strict;
+use warnings;
+
+use List::Util qw(sum min max);
+
 sub read {
        my ($self, $input) = @_;
        my ($psize, $ptype, $size, $type, $vsize, $dsize, $id, $subid) = unpack q{
@@ -176,8 +181,8 @@ sub read {
                ],
                moderef     => [1,
                        map { (
-                               start => [1, map {$_ => 'S'} @$_],
-                               end   => [1, map {$_ => 'C'} @$_],
+                               offset => [1, map {$_ => 'S'} @$_], # byte location of start
+                               end    => [1, map {$_ => 'C'} @$_],
                        ) }
                        [qw/single peaworm tron deathmatch foodmatch multifood timematch race ctf/]
                ],
@@ -207,6 +212,10 @@ sub read {
                ],
                width      => 'C',
                height     => 'C',
+               flags      => [0,
+                       y => 'C',
+                       x => 'C',
+               ],
                #levels
                #enddata
                #levels-multi
@@ -222,6 +231,11 @@ sub read {
 
        given ($subid) {
                when (97) {
+                       # current @FORMAT
+               }
+               when (95) {
+                       ref $_ and splice @$_, -2 for @{ $FORMAT[11] }; # only 8 moderefs
+                       splice @FORMAT, 12, 2;  # no reserved byte
                }
                default {
                        die "Unsupported level version $subid\n";
@@ -229,30 +243,75 @@ sub read {
        }
 
        my $data = Shiar_Parse::Nested->unpack(\@FORMAT, $input);
-       while (length $data->{leveldata}) {
-               my $level = Shiar_Parse::Nested->unpack([@LEVELFORM], $data->{leveldata});
-               my $offset = 13
-                       + 3 * (ref $level->{worms} eq 'ARRAY' ? scalar @{$level->{worms}} : 1)
-                       + ($level->{sprite} ? scalar @{$level->{sprite}} : 0)
-                       + ($level->{balls} ? 3 * scalar @{$level->{balls}} : 0);
-               $level->{objects} = [];
-               while (my $object = ord substr($data->{leveldata}, $offset, 1)) {
-                       push @{ $level->{objects} }, Shiar_Parse::Nested->unpack(
-                               [@OBJECTFORM], substr($data->{leveldata}, $offset, 5)
+       my $offset = 0;
+       my $offsetbase = 0xF080 + @{ $data->{sprite} } + 1;
+       $data->{moderef}->{offset}->{single} == $offsetbase
+               or warn "First singleplayer level is not in front\n";
+
+       my @VARMODES = (
+               [qw'single  single'],
+               [qw'multi   peaworm tron deathmatch foodmatch multifood timematch'],
+               [qw'race    race'],
+               [qw'ctf     ctf'],
+       );
+
+       $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 @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';
+               $varform[-1]->[0] = 2 if $variant eq 'ctf';
+
+               while ($offset < length $data->{leveldata}) {
+                       last if substr($data->{leveldata}, $offset, 1) eq chr(255);
+
+                       # find references to this level offset, and set start number to matching modes
+                       while (my ($mode, $location) = each %{ $data->{moderef}->{offset} }) {
+                               $location == $offset + $offsetbase or next;
+                               $data->{moderef}->{start}->{$mode} = 1 + scalar @{ $data->{levels} };
+                       }
+
+                       my $level = Shiar_Parse::Nested->unpack(
+                               [@varform], substr $data->{leveldata}, $offset
                        );
-                       $offset += 5;
+                       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} = [];
+                       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;
                }
-               $level->{size} = $offset;
-               $offset++;
-               push @{ $data->{levels} }, $level;
-               substr($data->{leveldata}, 0, $offset) = '';
-               last if substr($data->{leveldata}, 0, 1) eq chr(255);
        }
-       my $slots = 1; #TODO
-       $data->{hinames} = [ unpack '(a3)*', substr($data->{leveldata}, -3 * $slots) ];
-       $data->{enddata} = substr delete($data->{leveldata}), 0, -3 * $slots;
+
+       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';
-       $data->{levelcount}->{single} = scalar @{ $data->{levels} };
        return $data;
 }
 
@@ -400,7 +459,7 @@ __END__
 
 =head1 NAME
 
-parse-wormedit - WormEdit level data parser
+parse-wormedit - Wormy level data parser
 
 =head1 SYNOPSIS
 
@@ -408,8 +467,8 @@ parse-wormedit - WormEdit level data parser
 
 =head1 DESCRIPTION
 
-Reads WormEdit v0.53 levels from STDIN or given file,
-and outputs contents, summarised or in full.
+Reads Wormy levels (either original WormEdit source or compiled TI-86 string)
+from STDIN or given file, and outputs contents, summarised or in full.
 
 =head1 AUTHOR