X-Git-Url: http://git.shiar.net/wormy.git/blobdiff_plain/bcdfb41a503e9135caaffa151f770f5aa522757c..be83045f108e6bada8bdbd32d6ed5fa00de60f7a:/parse-wormedit diff --git a/parse-wormedit b/parse-wormedit index 26d6cbd..4fd22e7 100755 --- 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', @@ -97,39 +99,52 @@ my @FORMAT = ( sub read { my ($self, $input) = @_; - my ($id, $subid) = (substr($input, 0, 15), ord substr($input, 15, 1)); - my $version = $opt{version} // $MAGICID{$id} + my ($id, $version) = (substr($input, 0, 15), ord substr($input, 15, 1)); + my $fileversion = $MAGICID{$id} or die "File does not match any known WormEdit level header\n"; - $subid == $version - or warn "Unsupported version $subid (expecting $version)\n"; - given ($version) { - when (53) { - # current @FORMAT + + if ($opt{version}) { + warn "Override version $version to $opt{version}\n"; + $version = $opt{version}; + } + elsif ($version != $fileversion) { + warn "Unexpected version $version (expecting $fileversion)\n"; + } + elsif ($version == 95) { + # auto-detect exact variant + if (ord substr($input, 70, 1) ~~ [1 .. 8]) { + # valid sprite length instead of description byte + # (which is usually a letter or nul) + $version = 94; } - when ($_ <= 95 and $_ > 90) { - ref $_ and pop @$_ for @{ $FORMAT[11] }; # only 8 moderefs - $FORMAT[-1]->[-1]->[0] = '32C'; # less objects - continue; + elsif (ord substr($input, 147, 1) == 0) { + # nul of finish type is 2 bytes later (unlike first char of message) + $version = 96; } - when (95) { + warn "Ambiguous file version 95; guessing subversion $version\n"; + }; + + $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 - #ref $_ and $_->[-1] = 'C' for @{ $FORMAT[11] }; # only 9 moderefs - $FORMAT[19] = 'Ca255'; # enddata - splice @FORMAT, 6, 2 if $subid < 95; # early (sub)version without description + $FORMAT[15]->[-1] = 'Ca255'; # enddata + $FORMAT[-1]->[-1]->[0] = '32C'; # less objects + when ($version == 96) { + ref $_ and $_->[-1] = 'C' for @{ $FORMAT[11] }; # 9 moderefs } - when ($_ <= 94 and $_ > 90) { - splice @FORMAT, 6, 2; # no description + ref $_ and pop @$_ for @{ $FORMAT[11] }; # only 8 moderefs + 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 - continue if $_ < 94; - } - when (93) { - splice @FORMAT, 16, 2; # no hiname + when (94) { } + splice @FORMAT, 14, 2; # no hiname $FORMAT[-1]->[0] = 64; # constant amount of levels - } + when (93) { } default { - die "Cannot parse data for Wormedit $version\n"; + die "Cannot parse data for Wormedit $fileversion/$version\n"; } } @@ -217,7 +232,7 @@ sub read { x => 'C', ], #levels - #enddata + #finish code #levels-multi #hinames ); @@ -248,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'], @@ -258,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; @@ -302,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; } @@ -400,9 +453,26 @@ else { # output with user-preferred formatting if ($opt{raw}) { - require JSON::XS; - my $output = JSON::XS->new->ascii->canonical->pretty->allow_nonref; - print $output->encode($data), "\n"; + # full data in yaml (human-readable) formatting + require YAML; + local $YAML::CompressSeries; + $YAML::CompressSeries = 0; + my $yml = "# Wormy levelset\n" . YAML::Dump($data); + + # inline format of short hashes + $yml =~ s{ + ^(\ *) - \n # array indicator + ((?:\1\ \ [a-z0-9]{1,5}:\ *\d+\n)+) # simple hash declaration + (?!\1\ ) # no further children + }[ + my ($indent, $value) = ($1, $2); + chop $value; + $value =~ s/^ +//gm; + $value =~ s/\n/, /g; + "$indent- {$value}\n"; + ]egmx; + + print $yml; } else { print $data->{name}; @@ -448,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'; } }