X-Git-Url: http://git.shiar.nl/wormy.git/blobdiff_plain/5f543f9395f3a885ee9b751e98d069b9ed54f885..580332877fa744e0653d74d92dc29346b9245093:/parse-wormedit diff --git a/parse-wormedit b/parse-wormedit index 5761a30..43593a8 100755 --- 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', @@ -59,14 +59,14 @@ my @FORMAT = ( ], finish => [1, type => 's', - message => 'Ca255', - code => 'Ca255', + 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', @@ -131,7 +131,7 @@ 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[7] = 'C/a64'; # no reserved space after description splice @{ $FORMAT[15] }, -2; # finish reserve $FORMAT[-1]->[-1]->[0] = '32C'; # less objects ref $_ and pop @$_ for @{ $FORMAT[11] }; # 9 moderefs @@ -153,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; @@ -167,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) = @_; @@ -222,6 +222,10 @@ sub read { line => 'B8', ], leveldata => 'a*', + #levels + #finish code + #levels-multi + #hinames ); my @LEVELFORM = ( peas => 'C', @@ -247,20 +251,23 @@ 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; + my @VARMODES = ( + [qw'single single'], + [qw'multi peaworm tron deathmatch foodmatch multifood timematch'], + [qw'race race'], + [qw'ctf ctf'], + ); + given ($version) { when (97) { # current @FORMAT @@ -283,23 +290,26 @@ sub read { $_->[13] = $_->[15]; # ctf $_->[15] = 'domination'; } for @{ $FORMAT[9] }; # no multifood + splice @LEVELFORM, -2; push @LEVELFORM, "objects$_" => ['C', type => "=$_", map {$_ => 'C'} qw(x1 y1 x2 y2) ] for 2, 3; + # peaworm/tron mode do not take multiplayer levels + splice @VARMODES, 1, 0, ['peaworm', splice @{ $VARMODES[1] }, 1, 2]; } 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 or warn "First singleplayer level is not in front\n"; - my $slots = sum( + my $slots = sum(grep {defined} $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 @@ -307,13 +317,6 @@ sub read { $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'], - [qw'race race'], - [qw'ctf ctf'], - ); - $data->{levels} = []; for my $modes (@VARMODES) { my $variant = shift @$modes; @@ -327,10 +330,11 @@ sub read { : max(grep {defined} map { $data->{moderef}->{end}->{$_} } @$modes); my @varform = @LEVELFORM; - $varform[13]->[0] = $variant eq 'single' ? 1 : 4; + $varform[13]->[0] = $variant ~~ ['single', 'peaworm'] ? 1 : 4; # worms 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}) { @@ -343,13 +347,6 @@ 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 @@ -357,20 +354,11 @@ sub read { if ($version <= 91) { ref $_ eq 'ARRAY' and push @{ $level->{objects} }, @$_ for map { delete $level->{"objects$_"} } 2, 3; - $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; - } } # add parsed level and advance push @{ $data->{levels} }, $level; - $offset += ++$size; + $offset += $level->{size}; last if ++$data->{levelcount}->{$variant} >= $amount; } @@ -481,10 +469,11 @@ else { ); my $startnr = 0; - for my $variant (qw/single multi race ctf/) { + for my $variant (qw/single peaworm multi race ctf/) { my $count = $data->{levelcount}->{$variant}; + defined $count or next; print "\n"; - printf '%s (%s)', ucfirst $variant, $count // 'invalid'; + printf '%s (%s)', ucfirst $variant, $count; $count or next; print ":"; for (0 .. $count - 1) { @@ -509,8 +498,7 @@ else { ); } $startnr += $count; - } - continue { + print "\n"; printf("-- %-21s%4s: %s (%s)\n", '(ending)', @@ -521,6 +509,7 @@ else { $data->{finish}->{message} // '?', ) if $variant eq 'single'; } + print "\n"; } __END__