From c1c7a10ad684086c18f7db5456143212a40146e7 Mon Sep 17 00:00:00 2001 From: Mischa Poslawsky Date: Wed, 25 Feb 2009 09:45:54 +0100 Subject: [PATCH 01/16] parse-wormedit: more details in summarised mode Display various episode and level properties, giving a more complete overview (without actually drawing anything that is). --- parse-wormedit | 43 ++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 40 insertions(+), 3 deletions(-) diff --git a/parse-wormedit b/parse-wormedit index 4f92959..2eb9e27 100755 --- a/parse-wormedit +++ b/parse-wormedit @@ -5,7 +5,7 @@ use warnings; use Data::Dumper; use Getopt::Long 2.33 qw(HelpMessage :config bundling); -our $VERSION = '1.00'; +our $VERSION = '1.01'; GetOptions(\my %opt, 'raw|r', @@ -82,6 +82,20 @@ my @FORMAT = ( ], ); +my @OBJTYPE = ('none', 'line', 'fat line', 'bar', 'circle'); +my @ENDTYPE = ('none', 'message', 'small message'); + +sub objsummary { + my ($objects) = @_; + my @objtypes = map { $_->{type} } @$objects; + my %count; + $count{$_}++ for @objtypes; + return (@objtypes > 1 && keys %count == 1 && 'all ') . join(', ', + map { $OBJTYPE[$_] ? $OBJTYPE[$_] . ($count{$_} > 1 && 's') : $_ } + sort keys %count + ); +} + # read and parse all input data local $/; my @rawdata = unpack Shiar_Parse::Nested->template(\@FORMAT).'a*', readline; @@ -102,6 +116,12 @@ if ($opt{raw}) { } else { print "$data->{name} ($data->{description})\n"; + printf "File version: %s\n", "WormEdit v$data->{version}"; + printf "Defaults: %s\n", join('; ', + 'sprite ' . scalar @{ $data->{sprite} }, + 'hiscore by ' . $data->{hiname}, + ); + my $startnr = 0; for my $variant (qw/single multi race ctf/) { print "\n"; @@ -109,14 +129,31 @@ else { printf "\u$variant ($count)"; $count or next; print ":"; - printf("\n- %-22s (%3sx%3s, %d objects)", - $_->{id}, $_->{width}, $_->{height}, scalar @{ $_->{objects} }, + printf("\n- %-22s%4s:%3s+%2s%3s %3sx%-3s%s", + $_->{id} || $_->{name}, + @$_{qw/size bsize growth/}, + $variant eq 'single' && "x$_->{peas}", + @$_{qw/width height/}, + join(';', map {" $_"} grep {$_} + @{$_->{objects}} && sprintf('%2d object%s (%s)', + scalar @{$_->{objects}}, @{$_->{objects}} != 1 && 's', + objsummary($_->{objects}), + ), + @{$_->{sprite}} && sprintf('sprite %d', + scalar @{$_->{sprite}}, + ), + ), ) for map { $data->{levels}->[$_ + $startnr] } 0 .. $count - 1; $startnr += $count; } continue { print "\n"; + printf("-- %-21s%4d: %s (%s)\n", + '(ending)', + length $data->{enddata}, + $ENDTYPE[$data->{endtype}] || 'unknown', $data->{endstr}, + ) if $variant eq 'single'; } } -- 2.30.0 From 7e3af99422406dfbf962f92927e77b6907e3f757 Mon Sep 17 00:00:00 2001 From: Mischa Poslawsky Date: Wed, 25 Feb 2009 11:35:02 +0100 Subject: [PATCH 02/16] parse-wormedit: support older wormedit versions Detect earlier version 95, 94, and 93 headers (or by --version override), and parse data accordingly (each former format is mostly a subset; hide output if it's not present yet). For version 95 there was also an intermediate file in history, which has been rewritten to specify (sub)version 94 in order to be able to detect it automatically. Uses Perl v5.10 features for slightly nicer code (wasn't necessary, but compatibility is unlikely to be an issue (who else is gonna run this code anyway?)). --- parse-wormedit | 69 ++++++++++++++++++++++++++++++++++++++++---------- 1 file changed, 55 insertions(+), 14 deletions(-) diff --git a/parse-wormedit b/parse-wormedit index 2eb9e27..473f49e 100755 --- a/parse-wormedit +++ b/parse-wormedit @@ -1,17 +1,24 @@ #!/usr/bin/env perl use strict; use warnings; +use 5.010; use Data::Dumper; use Getopt::Long 2.33 qw(HelpMessage :config bundling); -our $VERSION = '1.01'; +our $VERSION = '1.02'; GetOptions(\my %opt, - 'raw|r', + 'raw|r', # full output + 'version=i', # force version ) or HelpMessage(-exitval => 2); -my $MAGICID = "WormEdit053\000LVL"; +my %MAGICID = ( + "WormEdit053\000LVL" => 53, + "WormEdit\34195\000LVL" => 95, + "WormEdit\34194\000LVL" => 94, + "WormEdit\34193\000LVL" => 93, +); my @FORMAT = ( magic => 'a15', @@ -98,11 +105,43 @@ sub objsummary { # read and parse all input data local $/; -my @rawdata = unpack Shiar_Parse::Nested->template(\@FORMAT).'a*', readline; -$rawdata[0] eq $MAGICID - or die "File does not match WormEdit level header\n"; -$rawdata[1] == 53 - or warn "Unsupported version $rawdata[1] (expecting 53)\n"; +my $rawdata = readline; +my ($id, $subid) = (substr($rawdata, 0, 15), ord substr($rawdata, 15, 1)); +my $version = $opt{version} // $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 + } + when ($_ <= 95 and $_ > 90) { + ref $_ and pop @$_ for @{ $FORMAT[11] }; # only 8 moderefs + $FORMAT[-1]->[-1]->[0] = '32C'; # less objects + continue; + } + when (95) { + $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 + } + when ($_ <= 94 and $_ > 90) { + splice @FORMAT, 6, 2; # no description + splice @{ $FORMAT[7] }, 4, 2; # no race + splice @FORMAT, 16, 2; # no enddata + splice @{ $FORMAT[-1] }, 1, 2; # no name + continue if $_ < 94; + } + when (93) { + splice @FORMAT, 16, 2; # no hiname + $FORMAT[-1]->[0] = 64; # constant amount of levels + } + default { + die "Cannot parse data for Wormedit $version\n"; + } +} +my @rawdata = unpack Shiar_Parse::Nested->template(\@FORMAT).'a*', $rawdata; # convert to an easily accessible hash my $data = Shiar_Parse::Nested->convert(\@FORMAT, \@rawdata); @@ -115,18 +154,20 @@ if ($opt{raw}) { print $output->encode($data), "\n"; } else { - print "$data->{name} ($data->{description})\n"; + print $data->{name}; + print " ($data->{description})" if defined $data->{description}; + print "\n"; printf "File version: %s\n", "WormEdit v$data->{version}"; printf "Defaults: %s\n", join('; ', 'sprite ' . scalar @{ $data->{sprite} }, - 'hiscore by ' . $data->{hiname}, + defined $data->{hiname} ? 'hiscore by ' . $data->{hiname} : (), ); my $startnr = 0; for my $variant (qw/single multi race ctf/) { - print "\n"; my $count = $data->{levelcount}->{$variant}; - printf "\u$variant ($count)"; + print "\n"; + printf '%s (%s)', ucfirst $variant, $count // 'invalid'; $count or next; print ":"; printf("\n- %-22s%4s:%3s+%2s%3s %3sx%-3s%s", @@ -149,9 +190,9 @@ else { } continue { print "\n"; - printf("-- %-21s%4d: %s (%s)\n", + printf("-- %-21s%4s: %s (%s)\n", '(ending)', - length $data->{enddata}, + defined $data->{enddata} ? length $data->{enddata} : '?', $ENDTYPE[$data->{endtype}] || 'unknown', $data->{endstr}, ) if $variant eq 'single'; } -- 2.30.0 From 23d3305d9e85430ecafc7f1c6347e822b0e60134 Mon Sep 17 00:00:00 2001 From: Mischa Poslawsky Date: Wed, 25 Feb 2009 13:38:55 +0100 Subject: [PATCH 03/16] git: recognise level files Set filetype for all (likely to be) levels to "wormylevel", so it is possible to use custom handling for them. Notably, for more detailed diffs than 'binary files differ', users can use parse-wormedit output for example: git config --global diff.wormylevel.textconv parse-wormedit --- .gitattributes | 2 ++ 1 file changed, 2 insertions(+) create mode 100644 .gitattributes diff --git a/.gitattributes b/.gitattributes new file mode 100644 index 0000000..09c0ee2 --- /dev/null +++ b/.gitattributes @@ -0,0 +1,2 @@ +*.86s diff=wormylevel +*.lvl diff=wormylevel -- 2.30.0 From d0ecc41581687c77fbb89f0b7d9b264fea2fcb31 Mon Sep 17 00:00:00 2001 From: Mischa Poslawsky Date: Wed, 25 Feb 2009 18:26:40 +0100 Subject: [PATCH 04/16] parse-wormedit: preliminary 86s parsing Read (current) compiled level strings. Restructure code a bit to keep different file formats modularised. --- parse-wormedit | 353 +++++++++++++++++++++++++++++++++++-------------- 1 file changed, 252 insertions(+), 101 deletions(-) diff --git a/parse-wormedit b/parse-wormedit index 473f49e..607231c 100755 --- a/parse-wormedit +++ b/parse-wormedit @@ -13,7 +13,13 @@ GetOptions(\my %opt, 'version=i', # force version ) or HelpMessage(-exitval => 2); -my %MAGICID = ( + +package Shiar_Parse::WormEdit; + +use strict; +use warnings; + +our %MAGICID = ( "WormEdit053\000LVL" => 53, "WormEdit\34195\000LVL" => 95, "WormEdit\34194\000LVL" => 94, @@ -89,6 +95,220 @@ 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} + 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 + } + when ($_ <= 95 and $_ > 90) { + ref $_ and pop @$_ for @{ $FORMAT[11] }; # only 8 moderefs + $FORMAT[-1]->[-1]->[0] = '32C'; # less objects + continue; + } + when (95) { + $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 + } + when ($_ <= 94 and $_ > 90) { + splice @FORMAT, 6, 2; # no description + splice @{ $FORMAT[7] }, 4, 2; # no race + splice @FORMAT, 16, 2; # no enddata + splice @{ $FORMAT[-1] }, 1, 2; # no name + continue if $_ < 94; + } + when (93) { + splice @FORMAT, 16, 2; # no hiname + $FORMAT[-1]->[0] = 64; # constant amount of levels + } + default { + die "Cannot parse data for Wormedit $version\n"; + } + } + + # convert to an easily accessible hash + my @values = unpack Shiar_Parse::Nested->template(\@FORMAT).'a*', $input; + my $data = Shiar_Parse::Nested->convert(\@FORMAT, \@values); + warn "Trailing data left unparsed\n" if grep {length} @values; + $data->{format} = 'WormEdit'; + return $data; +} + + +package Shiar_Parse::WormyLevel; + +sub read { + my ($self, $input) = @_; + my ($psize, $ptype, $size, $type, $vsize, $dsize, $id, $subid) = unpack q{ + x11 x42 # file signature and comment + S a2 S a2 # file size, type; data size, type + x8 # var name + S S # var size; content size + CC # wormy header + }, $input; + $ptype eq "\014\000" + or die "Not a calculator string, thus cannot be a Wormy level file\n"; + $size == $psize - 16 + or warn "File size ($size) does not correspond with data size ($psize)\n"; + $type eq "\014\010" + or die "Not a calculator string, thus cannot be a Wormy level file\n"; + $size == $vsize and $vsize == $dsize+2 + or warn "Mismatch in string data size declarations\n"; +# substr($input, -2) eq $CHECKSUM + + $input = substr $input, 73, -2; + $id eq ord 'w' + or die "Wormy level identifier not found\n"; + my @FORMAT = ( + magic => 'a1', + version => 'C', + name => 'Z*', + description => 'Z*', + levelcount => [1, + total => 'S', + ], + moderef => [1, + map { ( + start => [1, map {$_ => 'S'} @$_], + end => [1, map {$_ => 'C'} @$_], + ) } + [qw/single peaworm tron deathmatch foodmatch multifood timematch race ctf/] + ], + theanswer => 'C', # 42 + sprite => ['C', + line => 'B8', + ], + leveldata => 'a*', + ); + my @LEVELFORM = ( + peas => 'C', + delay => 'C', + growth => 'C', + bsize => 'C', + sprite => ['C', + line => 'B8', + ], + balls => ['C', + y => 'C', + x => 'C', + dir => 'C', + ], + worms => [1, + d => 'C', + y => 'C', + x => 'C', + ], + width => 'C', + height => 'C', + #levels + #enddata + #levels-multi + #hinames + ); + my @OBJECTFORM = ( + type => 'C', + x1 => 'C', + y1 => 'C', + x2 => 'C', + y2 => 'C', + ); + + given ($subid) { + when (97) { + } + default { + die "Unsupported level version $subid\n"; + } + } + + 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) + ); + $offset += 5; + } + $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; + $data->{format} = '86s'; + $data->{levelcount}->{single} = scalar @{ $data->{levels} }; + return $data; +} + + +package Shiar_Parse::Nested; + +sub template { + my ($self, $format) = @_; + # total (flattened) unpack template from nested format definitions + return join '', map { + my $value = $format->[-($_ << 1) - 1]; + if (ref $value eq 'ARRAY') { + my $count = $value->[0]; + $value = $self->template($value); + $value = $count =~ s/^([*\d]+)// ? "$count($value)$1" + : $count."X[$count]$count/($value)"; + } + else { + $value =~ s/^C(a)(\d+)/$1 . ($2 + 1)/e; # length prefix + } + $value; + } reverse 0 .. ($#$format - 1) >> 1; +} + +sub convert { + my ($self, $format, $data) = @_; + # map flat results into a named and nested hash + my %res; + while (my ($field, $template) = splice @$format, 0, 2) { + if (ref $template eq 'ARRAY') { + my ($count, @subformat) = @$template; + my $max = $count =~ s/^(\d+)// ? $1 : 0; + $count = !$count ? $max + : $count eq '*' ? $res{levelcount}->{total} : shift @$data; + $res{$field}->[$_] = $self->convert([@subformat], $data) for 0 .. ($max || $count)-1; + splice @{ $res{$field} }, $count if $max > $count; + $res{$field} = $res{$field}->[0] if $max == 1; + next; + } + elsif ($template =~ /^Ca/) { + $data->[0] = CORE::unpack 'C/a', $data->[0]; + } + $res{$field} = shift @$data; + } + return \%res; +} + +sub unpack { + my ($self, $format, $input) = @_; + my @data = CORE::unpack $self->template($format), $input; + return $self->convert($format, \@data); +} + + +package main; + my @OBJTYPE = ('none', 'line', 'fat line', 'bar', 'circle'); my @ENDTYPE = ('none', 'message', 'small message'); @@ -104,48 +324,20 @@ sub objsummary { } # read and parse all input data +my $data; local $/; my $rawdata = readline; -my ($id, $subid) = (substr($rawdata, 0, 15), ord substr($rawdata, 15, 1)); -my $version = $opt{version} // $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 - } - when ($_ <= 95 and $_ > 90) { - ref $_ and pop @$_ for @{ $FORMAT[11] }; # only 8 moderefs - $FORMAT[-1]->[-1]->[0] = '32C'; # less objects - continue; - } - when (95) { - $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 - } - when ($_ <= 94 and $_ > 90) { - splice @FORMAT, 6, 2; # no description - splice @{ $FORMAT[7] }, 4, 2; # no race - splice @FORMAT, 16, 2; # no enddata - splice @{ $FORMAT[-1] }, 1, 2; # no name - continue if $_ < 94; - } - when (93) { - splice @FORMAT, 16, 2; # no hiname - $FORMAT[-1]->[0] = 64; # constant amount of levels - } - default { - die "Cannot parse data for Wormedit $version\n"; - } +if (substr($rawdata, 0, 11) eq "**TI86**\032\012\000") { + # compiled calculator file + $data = Shiar_Parse::WormyLevel->read($rawdata); +} +elsif (substr($rawdata, 0, 8) eq 'WormEdit') { + # original wormedit source + $data = Shiar_Parse::WormEdit->read($rawdata); +} +else { + die "Unrecognised file type\n"; } -my @rawdata = unpack Shiar_Parse::Nested->template(\@FORMAT).'a*', $rawdata; - -# convert to an easily accessible hash -my $data = Shiar_Parse::Nested->convert(\@FORMAT, \@rawdata); -warn "Trailing data left unparsed\n" if grep {length} @rawdata; # output with user-preferred formatting if ($opt{raw}) { @@ -157,7 +349,7 @@ else { print $data->{name}; print " ($data->{description})" if defined $data->{description}; print "\n"; - printf "File version: %s\n", "WormEdit v$data->{version}"; + printf "File version: %s\n", "$data->{format} v$data->{version}"; printf "Defaults: %s\n", join('; ', 'sprite ' . scalar @{ $data->{sprite} }, defined $data->{hiname} ? 'hiscore by ' . $data->{hiname} : (), @@ -170,22 +362,24 @@ else { printf '%s (%s)', ucfirst $variant, $count // 'invalid'; $count or next; print ":"; - printf("\n- %-22s%4s:%3s+%2s%3s %3sx%-3s%s", - $_->{id} || $_->{name}, - @$_{qw/size bsize growth/}, - $variant eq 'single' && "x$_->{peas}", - @$_{qw/width height/}, - join(';', map {" $_"} grep {$_} - @{$_->{objects}} && sprintf('%2d object%s (%s)', - scalar @{$_->{objects}}, @{$_->{objects}} != 1 && 's', - objsummary($_->{objects}), - ), - @{$_->{sprite}} && sprintf('sprite %d', - scalar @{$_->{sprite}}, + for (0 .. $count - 1) { + my $level = $data->{levels}->[$_ + $startnr]; + printf("\n- %-22s%4s:%3s+%2s%3s %3sx%-3s%s", + $level->{id} || $level->{name} || '#'.($_+1), + @$level{qw/size bsize growth/}, + $variant eq 'single' && "x$level->{peas}", + @$level{qw/width height/}, + join(';', map {" $_"} grep {$_} + @{$level->{objects}} && sprintf('%2d object%s (%s)', + scalar @{$level->{objects}}, @{$level->{objects}} != 1 && 's', + objsummary($level->{objects}), + ), + $level->{sprite} && @{$level->{sprite}} && sprintf('sprite %d', + scalar @{$level->{sprite}}, + ), ), - ), - ) for map { $data->{levels}->[$_ + $startnr] } - 0 .. $count - 1; + ); + } $startnr += $count; } continue { @@ -193,55 +387,12 @@ else { printf("-- %-21s%4s: %s (%s)\n", '(ending)', defined $data->{enddata} ? length $data->{enddata} : '?', - $ENDTYPE[$data->{endtype}] || 'unknown', $data->{endstr}, + defined $data->{endtype} ? $ENDTYPE[$data->{endtype}] || 'unknown' : 'code', + $data->{endstr} // '?', ) if $variant eq 'single'; } } -package Shiar_Parse::Nested; - -sub template { - my ($self, $format) = @_; - # total (flattened) unpack template from nested format definitions - return join '', map { - my $value = $format->[-($_ << 1) - 1]; - if (ref $value eq 'ARRAY') { - my $count = $value->[0]; - $value = $self->template($value); - $value = $count =~ s/^([*\d]+)// ? "$count($value)$1" - : $count."X[$count]$count/($value)"; - } - else { - $value =~ s/^C(a)(\d+)/$1 . ($2 + 1)/e; # length prefix - } - $value; - } reverse 0 .. ($#$format - 1) >> 1; -} - -sub convert { - my ($self, $format, $data) = @_; - # map flat results into a named and nested hash - my %res; - while (my ($field, $template) = splice @$format, 0, 2) { - if (ref $template eq 'ARRAY') { - my ($count, @subformat) = @$template; - my $max = $count =~ s/^(\d+)// ? $1 : 0; - $count = !$count ? $max - : $count eq '*' ? $res{levelcount}->{total} : shift @$data; - $max ||= $count; - $res{$field}->[$_] = $self->convert([@subformat], $data) for 0 .. $max-1; - splice @{ $res{$field} }, $count if $max > $count; - $res{$field} = $res{$field}->[0] if $max == 1; - next; - } - elsif ($template =~ /^Ca/) { - $data->[0] = unpack 'C/a', $data->[0]; - } - $res{$field} = shift @$data; - } - return \%res; -} - __END__ =head1 NAME -- 2.30.0 From 33a0066c3c94642f03b16763254803f8d140604c Mon Sep 17 00:00:00 2001 From: Mischa Poslawsky Date: Wed, 25 Feb 2009 19:05:49 +0100 Subject: [PATCH 05/16] parse-wormedit: show amount of bouncing balls --- parse-wormedit | 3 +++ 1 file changed, 3 insertions(+) diff --git a/parse-wormedit b/parse-wormedit index 607231c..8c441a4 100755 --- a/parse-wormedit +++ b/parse-wormedit @@ -377,6 +377,9 @@ else { $level->{sprite} && @{$level->{sprite}} && sprintf('sprite %d', scalar @{$level->{sprite}}, ), + $level->{balls} && @{$level->{balls}} && sprintf('%d bounc%s', + scalar @{$level->{balls}}, @{$level->{balls}} == 1 ? 'y' : 'ies', + ), ), ); } -- 2.30.0 From bcdfb41a503e9135caaffa151f770f5aa522757c Mon Sep 17 00:00:00 2001 From: Mischa Poslawsky Date: Thu, 26 Feb 2009 00:58:58 +0100 Subject: [PATCH 06/16] parse-wormedit: parse multiplayer levels in 86s files --- parse-wormedit | 111 +++++++++++++++++++++++++++++++++++++------------ 1 file changed, 85 insertions(+), 26 deletions(-) diff --git a/parse-wormedit b/parse-wormedit index 8c441a4..26d6cbd 100755 --- 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 -- 2.30.0 From c0b0123313d8a4895d1c42c8f74675a2be5b6e08 Mon Sep 17 00:00:00 2001 From: Mischa Poslawsky Date: Fri, 27 Feb 2009 00:38:20 +0100 Subject: [PATCH 07/16] parse-wormedit: guess specific variant of v95 levels There were 3 different level formats all with the same version 95. Try to autodetect which by looking at some conflicting byte offsets; the only other way is manual specification, which hopefully isn't needed in any practical cases. --- parse-wormedit | 55 +++++++++++++++++++++++++++++++------------------- 1 file changed, 34 insertions(+), 21 deletions(-) diff --git a/parse-wormedit b/parse-wormedit index 26d6cbd..bc0d926 100755 --- a/parse-wormedit +++ b/parse-wormedit @@ -97,39 +97,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 end type is 2 bytes later (unlike first char of endstr) + $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[-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[-1] }, 1, 2; # no name - continue if $_ < 94; - } - when (93) { + when (94) { } splice @FORMAT, 16, 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"; } } -- 2.30.0 From e58e4983aac0a969a6476a7ae0ee6aab25771148 Mon Sep 17 00:00:00 2001 From: Mischa Poslawsky Date: Sun, 1 Mar 2009 16:11:09 +0100 Subject: [PATCH 08/16] parse-wormedit: raw output in yaml Format --raw data using YAML, which should be even more human-readable than JSON, especially using inline hashes (requires some custom replacements because no formatting module seems to support this yet). --- parse-wormedit | 23 ++++++++++++++++++++--- 1 file changed, 20 insertions(+), 3 deletions(-) diff --git a/parse-wormedit b/parse-wormedit index bc0d926..8c2f2c9 100755 --- a/parse-wormedit +++ b/parse-wormedit @@ -413,9 +413,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}; -- 2.30.0 From 6c599c66b38654aef23387cc2d4800dc10ea74f5 Mon Sep 17 00:00:00 2001 From: Mischa Poslawsky Date: Sun, 1 Mar 2009 16:25:15 +0100 Subject: [PATCH 09/16] parse-wormedit: containing row for finish data Put various data related to episode completion in a single hash container. --- parse-wormedit | 28 ++++++++++++++++------------ 1 file changed, 16 insertions(+), 12 deletions(-) diff --git a/parse-wormedit b/parse-wormedit index 8c2f2c9..6eb7915 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', @@ -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 ); @@ -323,7 +325,7 @@ sub read { $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->{finish}->{code} = substr delete($data->{leveldata}), $offset, -5 * $slots; #XXX $data->{format} = '86s'; return $data; } @@ -478,9 +480,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'; } } -- 2.30.0 From e448cc15fa7f3168db2ff13ee61d64fdea20830f Mon Sep 17 00:00:00 2001 From: Mischa Poslawsky Date: Sun, 1 Mar 2009 16:37:08 +0100 Subject: [PATCH 10/16] parse-wormedit: better support for missing multiplayer levels - Do not try to read levels if none are declared (common for singleplayer-only episodes). - Read episode finish code after parsing singleplayer levels, so that the starting offset is correct. --- parse-wormedit | 26 +++++++++++++++++--------- 1 file changed, 17 insertions(+), 9 deletions(-) diff --git a/parse-wormedit b/parse-wormedit index 6eb7915..8136c58 100755 --- a/parse-wormedit +++ b/parse-wormedit @@ -263,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'], @@ -273,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; @@ -317,16 +327,14 @@ sub read { $offset += ++$size; last if ++$data->{levelcount}->{$variant} >= $amount; } + + if ($variant eq 'single') { + $data->{finish}->{code} = substr( + delete($data->{leveldata}), $offset, -5 * $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->{finish}->{code} = substr delete($data->{leveldata}), $offset, -5 * $slots; #XXX - $data->{format} = '86s'; return $data; } -- 2.30.0 From be83045f108e6bada8bdbd32d6ed5fa00de60f7a Mon Sep 17 00:00:00 2001 From: Mischa Poslawsky Date: Sun, 1 Mar 2009 17:18:24 +0100 Subject: [PATCH 11/16] parse-wormedit: detect common finish code in 86s data --- parse-wormedit | 34 ++++++++++++++++++++++++++++++++-- 1 file changed, 32 insertions(+), 2 deletions(-) diff --git a/parse-wormedit b/parse-wormedit index 8136c58..4fd22e7 100755 --- a/parse-wormedit +++ b/parse-wormedit @@ -329,9 +329,39 @@ sub read { } if ($variant eq 'single') { - $data->{finish}->{code} = substr( - delete($data->{leveldata}), $offset, -5 * $slots + $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; + } } } -- 2.30.0 From 1bb353295426ce22afb72a18ca4899c52f9efee9 Mon Sep 17 00:00:00 2001 From: Mischa Poslawsky Date: Mon, 2 Mar 2009 04:49:19 +0100 Subject: [PATCH 12/16] parse-wormedit: support older 86s formats --- parse-wormedit | 71 +++++++++++++++++++++++++++++++++++++++----------- 1 file changed, 56 insertions(+), 15 deletions(-) diff --git a/parse-wormedit b/parse-wormedit index 4fd22e7..42d9d21 100755 --- a/parse-wormedit +++ b/parse-wormedit @@ -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} : (), ); -- 2.30.0 From 7c64957ec9a87cf71ccf5fa7c28bb8c37b27efc6 Mon Sep 17 00:00:00 2001 From: Mischa Poslawsky Date: Mon, 2 Mar 2009 16:48:01 +0100 Subject: [PATCH 13/16] parse-wormedit: distinguish newer v95 level strings Some 86s files exist with version identifier 95, which already contain newer v97 features. This is logically --version=96, but needs to be specified manually. --- parse-wormedit | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/parse-wormedit b/parse-wormedit index 42d9d21..84e4e31 100755 --- a/parse-wormedit +++ b/parse-wormedit @@ -262,10 +262,11 @@ sub read { # current @FORMAT } $offsetbase = 0xF400; + when (96) {} + ref $_ and splice(@$_, -8, 2) for @{ $FORMAT[11] }; # no multifood + splice @FORMAT, 12, 2; # no reserved byte when (95) {} - splice @FORMAT, 6, 2; - ref $_ and splice(@$_, -8, 2) for @{ $FORMAT[9] }; # no multifood - splice @FORMAT, 10, 2; # no reserved byte + splice @FORMAT, 6, 2; # no description when (94) {} when (90) { $FORMAT[5] = 'C/a'; # length-preceding name -- 2.30.0 From 3f547138025ead9303d443e1d41e5e4c884c570d Mon Sep 17 00:00:00 2001 From: Mischa Poslawsky Date: Mon, 2 Mar 2009 17:25:12 +0100 Subject: [PATCH 14/16] parse-wormedit: seperate parsing module Parse::Binary::Nested Make the package a (mostly) stand-alone include, potientially reusable by other projects, but primarily keeping it more maintainable (uncluttered code, testable, and allowing futher modularisation of file parsers). --- Parse/Binary/Nested.pm | 94 ++++++++++++++++++++++++++++++++++++++++++ parse-wormedit | 72 ++++++-------------------------- t/parser.t | 33 +++++++++++++++ 3 files changed, 139 insertions(+), 60 deletions(-) create mode 100644 Parse/Binary/Nested.pm create mode 100644 t/parser.t diff --git a/Parse/Binary/Nested.pm b/Parse/Binary/Nested.pm new file mode 100644 index 0000000..db5e208 --- /dev/null +++ b/Parse/Binary/Nested.pm @@ -0,0 +1,94 @@ +package Parse::Binary::Nested; + +use strict; +use warnings; + +use Carp; + +our $VERSION = '1.00'; + +sub new { + my ($class, $format) = @_; + ref $format eq 'ARRAY' + or croak "Invalid Parse::Binary::Nested format: should be an array ref"; + bless $format, $class; +} + +sub template { + my ($self, $format) = @_; + # total (flattened) unpack template from nested format definitions + return join '', map { + my $value = $format->[-($_ << 1) - 1]; + if (ref $value eq 'ARRAY') { + my $count = $value->[0]; + $value = $self->template($value); + $value = $count =~ s/^([*\d]+)// ? "$count($value)$1" + : $count."X[$count]$count/($value)"; + } + else { + $value =~ s/^C(a)(\d+)/$1 . ($2 + 1)/e; # length prefix + } + $value; + } reverse 0 .. ($#$format - 1) >> 1; +} + +sub convert { + my ($self, $format, $data) = @_; + # map flat results into a named and nested hash + my %res; + while (my ($field, $template) = splice @$format, 0, 2) { + if (ref $template eq 'ARRAY') { + my ($count, @subformat) = @$template; + my $max = $count =~ s/^(\d+)// ? $1 : 0; + $count = !$count ? $max + : $count eq '*' ? $res{levelcount}->{total} : shift @$data; + $res{$field}->[$_] = $self->convert([@subformat], $data) for 0 .. ($max || $count)-1; + splice @{ $res{$field} }, $count if $max > $count; + $res{$field} = $res{$field}->[0] if $max == 1; + next; + } + elsif ($template =~ /^Ca/) { + $data->[0] = unpack 'C/a', $data->[0]; + } + $res{$field} = shift @$data; + } + return \%res; +} + +sub unpackf { + my ($self, $input) = @_; + my @data = unpack $self->template($self), $input; + return $self->convert([@$self], \@data); +} + +1; + +=head1 NAME + +Parse::Binary::Nested - Structured unpack + +=head1 SYNOPSIS + + use Parse::Binary::Nested; + my $parser = Parser::Binary::Nested->new([ + foos => [ + 'C', # count + message => 'Z*', + period => 'C', + ], + trail => 'a*', + ]); + + my $data = $parser->unpackf("\1foo\0.rest"); + print $data->{foos}->[0]->{message}; + +=head1 DESCRIPTION + +=head1 AUTHOR + +Mischa POSLAWSKY + +=head1 LICENSE + +GPL version 3. + diff --git a/parse-wormedit b/parse-wormedit index 84e4e31..3811863 100755 --- 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.03'; +our $VERSION = '1.04'; GetOptions(\my %opt, 'raw|r', # full output @@ -19,6 +19,8 @@ package Shiar_Parse::WormEdit; use strict; use warnings; +use Parse::Binary::Nested; + our %MAGICID = ( "WormEdit053\000LVL" => 53, "WormEdit\34195\000LVL" => 95, @@ -149,9 +151,9 @@ sub read { } # convert to an easily accessible hash - my @values = unpack Shiar_Parse::Nested->template(\@FORMAT).'a*', $input; - my $data = Shiar_Parse::Nested->convert(\@FORMAT, \@values); - warn "Trailing data left unparsed\n" if grep {length} @values; + push @FORMAT, -trail => 'a*'; + my $data = Parse::Binary::Nested->new(\@FORMAT)->unpackf($input); + warn "Trailing data left unparsed\n" if length delete $data->{-trail}; $data->{format} = 'WormEdit'; return $data; } @@ -164,6 +166,7 @@ use warnings; use List::Util qw(sum min max); use Data::Dumper; +use Parse::Binary::Nested; sub read { my ($self, $input) = @_; @@ -288,7 +291,7 @@ sub read { } } - my $data = Shiar_Parse::Nested->unpack(\@FORMAT, $input); + my $data = Parse::Binary::Nested->new(\@FORMAT)->unpackf($input); my $offset = 0; $offsetbase += 1 + @{ $data->{sprite} } if $data->{sprite}; $data->{moderef}->{offset}->{single} == $offsetbase @@ -326,6 +329,7 @@ sub read { 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'; + my $parselevel = Parse::Binary::Nested->new(\@varform); while ($offset < length $data->{leveldata}) { last if substr($data->{leveldata}, $offset, 1) eq chr(255); @@ -336,9 +340,7 @@ sub read { $data->{moderef}->{start}->{$mode} = 1 + scalar @{ $data->{levels} }; } - my $level = Shiar_Parse::Nested->unpack( - [@varform], substr $data->{leveldata}, $offset - ); + 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) @@ -357,8 +359,8 @@ sub read { } 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) + push @{ $level->{objects} }, Parse::Binary::Nested->new([@OBJECTFORM])->unpackf( + substr $data->{leveldata}, $offset+$size, 5 ); $size += 5; } @@ -411,56 +413,6 @@ sub read { } -package Shiar_Parse::Nested; - -sub template { - my ($self, $format) = @_; - # total (flattened) unpack template from nested format definitions - return join '', map { - my $value = $format->[-($_ << 1) - 1]; - if (ref $value eq 'ARRAY') { - my $count = $value->[0]; - $value = $self->template($value); - $value = $count =~ s/^([*\d]+)// ? "$count($value)$1" - : $count."X[$count]$count/($value)"; - } - else { - $value =~ s/^C(a)(\d+)/$1 . ($2 + 1)/e; # length prefix - } - $value; - } reverse 0 .. ($#$format - 1) >> 1; -} - -sub convert { - my ($self, $format, $data) = @_; - # map flat results into a named and nested hash - my %res; - while (my ($field, $template) = splice @$format, 0, 2) { - if (ref $template eq 'ARRAY') { - my ($count, @subformat) = @$template; - my $max = $count =~ s/^(\d+)// ? $1 : 0; - $count = !$count ? $max - : $count eq '*' ? $res{levelcount}->{total} : shift @$data; - $res{$field}->[$_] = $self->convert([@subformat], $data) for 0 .. ($max || $count)-1; - splice @{ $res{$field} }, $count if $max > $count; - $res{$field} = $res{$field}->[0] if $max == 1; - next; - } - elsif ($template =~ /^Ca/) { - $data->[0] = CORE::unpack 'C/a', $data->[0]; - } - $res{$field} = shift @$data; - } - return \%res; -} - -sub unpack { - my ($self, $format, $input) = @_; - my @data = CORE::unpack $self->template($format), $input; - return $self->convert($format, \@data); -} - - package main; my @OBJTYPE = ('none', 'line', 'fat line', 'bar', 'circle'); diff --git a/t/parser.t b/t/parser.t new file mode 100644 index 0000000..cebd099 --- /dev/null +++ b/t/parser.t @@ -0,0 +1,33 @@ +#!/usr/bin/env perl + +use strict; +use warnings; + +use Test::More; +use Data::Dumper; + +plan tests => 5; + +use_ok('Parse::Binary::Nested'); + +my $example = Parse::Binary::Nested->new([ + foos => [ + 'C', + message => 'Z*', + period => 'C', + ], + trail => 'a*', +]); +ok($example, 'example parser'); +my $data = $example->unpackf("\2foo\0!\0.rest"); +is(ref $data, 'HASH', 'output structure'); +is($data->{foos}->[1]->{period}, ord '.', 'sample element'); + +is_deeply( + Parse::Binary::Nested->new( + [ lstr => 'Ca3', rest => 'a*' ] + )->unpackf("\2quux"), + { lstr => 'qu', rest => 'x' }, + 'length string' +); + -- 2.30.0 From 42fa759f7b4b8b71be1048e7da1870da7db17890 Mon Sep 17 00:00:00 2001 From: Mischa Poslawsky Date: Mon, 2 Mar 2009 20:20:56 +0100 Subject: [PATCH 15/16] parse-wormedit: bytes declarable as non-capturing Parse::Binary::Nested format values containing only x/X (ie ignored) are detected and skipped during conversion. This allows for exact specifications instead of having to append to previous (defined) elements. --- Parse/Binary/Nested.pm | 3 +++ parse-wormedit | 17 +++++++++-------- t/parser.t | 10 +++++++++- 3 files changed, 21 insertions(+), 9 deletions(-) diff --git a/Parse/Binary/Nested.pm b/Parse/Binary/Nested.pm index db5e208..e4cacc3 100644 --- a/Parse/Binary/Nested.pm +++ b/Parse/Binary/Nested.pm @@ -50,6 +50,9 @@ sub convert { elsif ($template =~ /^Ca/) { $data->[0] = unpack 'C/a', $data->[0]; } + elsif ($template =~ /^(?:[xX]\d*)*$/) { + next; # no values + } $res{$field} = shift @$data; } return \%res; diff --git a/parse-wormedit b/parse-wormedit index 3811863..81c0734 100755 --- a/parse-wormedit +++ b/parse-wormedit @@ -50,7 +50,8 @@ my @FORMAT = ( multifood => 'C', timematch => 'C', race => 'C', - ctf => 'Cx', + ctf => 'C', + reserved => 'x', ], ], sprite => ['8C', @@ -59,7 +60,8 @@ my @FORMAT = ( finish => [1, type => 's', message => 'Ca255', - code => 'Ca255x256', + code => 'Ca255', + reserved=> 'x256', ], hiname => 'a3', levels => ['*', # levelcount->total actually @@ -130,12 +132,11 @@ sub read { given ($fileversion) { when (153) { } # current @FORMAT $FORMAT[7] = 'Ca64'; # no reserved space after description - $FORMAT[15]->[-1] = 'Ca255'; # enddata + splice @{ $FORMAT[15] }, -2; # finish reserve $FORMAT[-1]->[-1]->[0] = '32C'; # less objects - when ($version == 96) { - ref $_ and $_->[-1] = 'C' for @{ $FORMAT[11] }; # 9 moderefs - } - ref $_ and pop @$_ for @{ $FORMAT[11] }; # only 8 moderefs + ref $_ and pop @$_ for @{ $FORMAT[11] }; # 9 moderefs + when ($version == 96) { } + ref $_ and pop @$_ for @{ $FORMAT[11] }; # only 8 moderefs (no ctf) splice @FORMAT, 6, 2 if $version <= 94; # earlier version without description when (95) { } splice @{ $FORMAT[7] }, 4, 2; # no race @@ -216,7 +217,7 @@ sub read { ) } [qw/single peaworm tron deathmatch foodmatch multifood timematch race ctf/] ], - theanswer => 'C', # 42 + theanswer => 'x', # 42 sprite => ['C', line => 'B8', ], diff --git a/t/parser.t b/t/parser.t index cebd099..5e53315 100644 --- a/t/parser.t +++ b/t/parser.t @@ -6,7 +6,7 @@ use warnings; use Test::More; use Data::Dumper; -plan tests => 5; +plan tests => 6; use_ok('Parse::Binary::Nested'); @@ -31,3 +31,11 @@ is_deeply( 'length string' ); +is_deeply( + Parse::Binary::Nested->new( + [ ignoreme => 'x2X', value => 'xC' ] + )->unpackf("\0\1\2"), + { value => 2 }, + 'empty values' +); + -- 2.30.0 From e3965c10b4fe2fdc18af177644237db9afe62166 Mon Sep 17 00:00:00 2001 From: Eric Samuel Date: Sat, 19 Jan 2002 20:18:30 -0500 Subject: [PATCH 16/16] initial 15 levels for 'worms for dinner' series > I created a set of levels there are 15 although the last one seems to > not be working. So i attached the .lvl file as well so you can figure > out what is wrong. [...] [Yumworms.lvl] --- dinner.lvl | Bin 0 -> 5703 bytes 1 file changed, 0 insertions(+), 0 deletions(-) create mode 100644 dinner.lvl diff --git a/dinner.lvl b/dinner.lvl new file mode 100644 index 0000000000000000000000000000000000000000..f89e31110ddea067826b413a97be5ec1d2498c2a GIT binary patch literal 5703 zcmd5bE&I#ASYxAnGN>s~f$-MZWAXQM&66Wd*Y_J<^LFahCWMGK%8BKwFBB z_`J#bzmGl5Ab-wLern0HBxv`}?)jFv5|q9A@j302J@=B;bG@`oukDJAN`nkuk1Z6EU;;iEmBl zVT)+NU*TznizxC$y1I^_O!-f|obY=B-)rUq(l@>Rz9mM2jKBdkFhAk-Q}hf|t8R|> z`;j#XVz|QLKSMaj%Z63b2-mFJ{WaNh#;HPsV zeaqwXk!V6jfZ%~SKkfV+@0mgUyp5MXk4pG;p20GQ*Gy$+zB4apKGGlE%x8e$F`u%? ze3;t%&EWZd8*D{YKvmQNs0F(Kj^ZldDsBPXf>Q`Hn144n(ru4VZ#RuUK}KL;U@Ecv zoGG7oKvt|2$Wcp$p0b~UUUXjtId2h=Eo&8e`F#RCYkzh8E7O%Cx@qu!-ZX@DQ9vIW z*JsUV6you29O9a-funUbP_ryk)7do3&n!z)nx(T%QpTt0@hNuh$Q1P}u)?9t;qW1Y3ob2v&7jDk!hv!~ zykM}xq0Hfs!v%+>Lk2|-6%Lfa-#&~_%j0ug`MEC=x+nkZ^mOx6`lMfq%zMAY_$+#S ziuWO8iu#aI)-TPre#-c60!z60fWci3O|Gsia>y|_;?fb5z+SX-;4C^*zUMPOOCF!% zeF&MNKID`4OH(|Le$D*kZ;esEq$#XR((W@j=h8WoAe*VNen~0c_q}H(d{&{}`EH8$ gA!Ke);