parse-wormedit: support older 86s formats
authorMischa Poslawsky <wormy@shiar.org>
Mon, 2 Mar 2009 03:49:19 +0000 (04:49 +0100)
committerMischa Poslawsky <wormy@shiar.org>
Mon, 2 Mar 2009 21:42:36 +0000 (22:42 +0100)
parse-wormedit

index 4fd22e7..42d9d21 100755 (executable)
@@ -163,10 +163,11 @@ use strict;
 use warnings;
 
 use List::Util qw(sum min max);
+use Data::Dumper;
 
 sub read {
        my ($self, $input) = @_;
-       my ($psize, $ptype, $size, $type, $vsize, $dsize, $id, $subid) = unpack q{
+       my ($psize, $ptype, $size, $type, $vsize, $dsize, $id, $version) = unpack q{
                x11 x42    # file signature and comment
                S a2 S a2  # file size, type; data size, type
                x8         # var name
@@ -186,6 +187,17 @@ sub read {
        $input = substr $input, 73, -2;
        $id eq ord 'w'
                or die "Wormy level identifier not found\n";
+
+       if ($opt{version}) {
+               warn "Override version $version to $opt{version}\n";
+               $version = $opt{version};
+       }
+       elsif ($version == 95) {
+               # level offset instead of description byte
+               $version-- if (unpack('x2Z*x2xC', $input))[1] == 0xF4;
+               warn "Ambiguous file version 95; guessing subversion $version\n";
+       }
+
        my @FORMAT = (
                magic       => 'a1',
                version     => 'C',
@@ -243,23 +255,41 @@ sub read {
                        x2   => 'C',
                        y2   => 'C',
        );
+       my $offsetbase = 0xF080;
 
-       given ($subid) {
+       given ($version) {
                when (97) {
                        # current @FORMAT
                }
-               when (95) {
-                       ref $_ and splice @$_, -2 for @{ $FORMAT[11] }; # only 8 moderefs
-                       splice @FORMAT, 12, 2;  # no reserved byte
+                       $offsetbase = 0xF400;
+               when (95) {}
+                       splice @FORMAT, 6, 2;
+                       ref $_ and splice(@$_, -8, 2) for @{ $FORMAT[9] }; # no multifood
+                       splice @FORMAT, 10, 2;  # no reserved byte
+               when (94) {}
+               when (90) {
+                       $FORMAT[5] = 'C/a';  # length-preceding name
+                       splice @FORMAT, 10, 2;  # no default sprite
+                       ref $_ and do {
+                               $_->[5] = $_->[7];  # no tron; deathmatch instead
+                               $_->[7] = $_->[9];  # foodmatch instead
+                               $_->[9] = 'linkmatch';  # replaces timematch
+                               $_->[11] = $_->[13];  # race
+                               $_->[13] = $_->[15];  # ctf
+                               $_->[15] = 'domination';
+                       } for @{ $FORMAT[9] }; # no multifood
+                       push @LEVELFORM, "object$_" => ['C',
+                               map {$_ => 'C'} qw(x1 y1 x2 y2)
+                       ] for qw(lines boxes);
                }
                default {
-                       die "Unsupported level version $subid\n";
+                       die "Unsupported level version $version\n";
                }
        }
 
        my $data = Shiar_Parse::Nested->unpack(\@FORMAT, $input);
        my $offset = 0;
-       my $offsetbase = 0xF080 + @{ $data->{sprite} } + 1;
+       $offsetbase += 1 + @{ $data->{sprite} } if $data->{sprite};
        $data->{moderef}->{offset}->{single} == $offsetbase
                or warn "First singleplayer level is not in front\n";
 
@@ -281,15 +311,19 @@ sub read {
        $data->{levels} = [];
        for my $modes (@VARMODES) {
                my $variant = shift @$modes;
-               $offset = min(grep {$_} map { $data->{moderef}->{offset}->{$_} } @$modes)
-                       or next;
+               my @modeoffsets = grep {defined} #TODO: comment
+                       map { $data->{moderef}->{offset}->{$_} } @$modes;
+               @modeoffsets or next;
+               $data->{levelcount}->{$variant} = 0;
+               $offset = min(grep {$_} @modeoffsets) or next;
                $offset -= $offsetbase;
-               my $amount = $variant eq 'single' ? 100 : max(map { $data->{moderef}->{end}->{$_} } @$modes);
+               my $amount = $variant eq 'single' ? 100
+                       : max(grep {defined} 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';
+               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';
 
                while ($offset < length $data->{leveldata}) {
@@ -315,12 +349,19 @@ sub read {
 
                        # 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} }, Shiar_Parse::Nested->unpack(
                                        [@OBJECTFORM], substr($data->{leveldata}, $offset+$size, 5)
                                );
                                $size += 5;
                        }
+               }
 
                        # add parsed level and advance
                        push @{ $data->{levels} }, $level;
@@ -331,7 +372,7 @@ sub read {
                if ($variant eq 'single') {
                        $offset++;
                        $data->{finish}->{code} =
-                       my $code = substr delete($data->{leveldata}), $offset, -5*$slots;
+                       my $code = substr $data->{leveldata}, $offset, -5*$slots;
 
                        my %FINISHCODE = (
                                0 => chr 0xC9, # ret
@@ -358,7 +399,7 @@ sub read {
                        );
                        while (my ($finish, $match) = each %FINISHCODE) {
                                $match eq substr $code, 0, length $match or next;
-                               $data->{finish}->{type} = $finish or last;
+                               $data->{finish}->{type} = $finish and
                                $data->{finish}->{message} = unpack 'Z*', substr($code, length $match);
                                last;
                        }
@@ -480,7 +521,7 @@ else {
        print "\n";
        printf "File version: %s\n", "$data->{format} v$data->{version}";
        printf "Defaults: %s\n", join('; ',
-               'sprite ' . scalar @{ $data->{sprite} },
+               $data->{sprite} ? 'sprite ' . scalar @{ $data->{sprite} } : (),
                defined $data->{hiname} ? 'hiscore by ' . $data->{hiname} : (),
        );