parse-wormedit: detect common finish code in 86s data

[wormy.git] / parse-wormedit

diff --git a/parse-wormedit b/parse-wormedit
index 8c2f2c9b56db6fc2ffdd4f220749a448a704394e..4fd22e701e2cf9c7628522f88eb7387d61ffff10 100755 (executable)
--- 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',
@@ -116,7 +118,7 @@ sub read {
                        $version = 94;
                }
                elsif (ord substr($input, 147, 1) == 0) {
-                       # nul of end type is 2 bytes later (unlike first char of endstr)
+                       # nul of finish type is 2 bytes later (unlike first char of message)
                        $version = 96;
                }
                warn "Ambiguous file version 95; guessing subversion $version\n";
@@ -126,7 +128,7 @@ sub read {
        given ($fileversion) {
                when (153) { } # current @FORMAT
                        $FORMAT[7] = 'Ca64'; # no reserved space after description
-                       $FORMAT[19] = 'Ca255'; # enddata
+                       $FORMAT[15]->[-1] = 'Ca255'; # enddata
                        $FORMAT[-1]->[-1]->[0] = '32C'; # less objects
                when ($version == 96) {
                        ref $_ and $_->[-1] = 'C' for @{ $FORMAT[11] }; # 9 moderefs
@@ -135,10 +137,10 @@ sub read {
                        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
                when (94) { }
-                       splice @FORMAT, 16, 2; # no hiname
+                       splice @FORMAT, 14, 2; # no hiname
                        $FORMAT[-1]->[0] = 64; # constant amount of levels
                when (93) { }
                default {
@@ -230,7 +232,7 @@ sub read {
                        x => 'C',
                ],
                #levels
-               #enddata
+               #finish code
                #levels-multi
                #hinames
        );
@@ -261,6 +263,14 @@ sub read {
        $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'],
@@ -271,7 +281,9 @@ sub read {
        $data->{levels} = [];
        for my $modes (@VARMODES) {
                my $variant = shift @$modes;
-               $offset = min(map { $data->{moderef}->{offset}->{$_} } @$modes) - $offsetbase;
+               $offset = min(grep {$_} map { $data->{moderef}->{offset}->{$_} } @$modes)
+                       or next;
+               $offset -= $offsetbase;
                my $amount = $variant eq 'single' ? 100 : max(map { $data->{moderef}->{end}->{$_} } @$modes);
 
                my @varform = @LEVELFORM;
@@ -315,16 +327,44 @@ sub read {
                        $offset += ++$size;
                        last if ++$data->{levelcount}->{$variant} >= $amount;
                }
+
+               if ($variant eq 'single') {
+                       $offset++;
+                       $data->{finish}->{code} =
+                       my $code = substr delete($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 or last;
+                               $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;
 }
 
@@ -478,9 +518,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';
        }
 }