parse-wormedit

   1 #!/usr/bin/env perl
   2 use strict;
   3 use warnings;
   4 use 5.010;
   5
   6 use Data::Dumper;
   7 use Getopt::Long 2.33 qw(HelpMessage :config bundling);
   8
   9 our $VERSION = '1.02';
  10
  11 GetOptions(\my %opt,
  12         'raw|r',  # full output
  13         'version=i',  # force version
  14 ) or HelpMessage(-exitval => 2);
  15
  16 my %MAGICID = (
  17         "WormEdit053\000LVL" => 53,
  18         "WormEdit\34195\000LVL" => 95,
  19         "WormEdit\34194\000LVL" => 94,
  20         "WormEdit\34193\000LVL" => 93,
  21 );
  22
  23 my @FORMAT = (
  24         magic       => 'a15',
  25         version     => 'C',
  26         name        => 'Ca32',
  27         description => 'Ca64x256',
  28         levelcount  => [1,
  29                 single => 'C',
  30                 multi  => 'C',
  31                 race   => 'C',
  32                 ctf    => 'C',
  33                 total  => 'C',
  34         ],
  35         moderef     => [1,
  36                 map { (start => $_, end => $_) } [1,
  37                         single     => 'C',
  38                         peaworm    => 'C',
  39                         tron       => 'C',
  40                         deathmatch => 'C',
  41                         foodmatch  => 'C',
  42                         multifood  => 'C',
  43                         timematch  => 'C',
  44                         race       => 'C',
  45                         ctf        => 'Cx',
  46                 ],
  47         ],
  48         sprite     => ['8C',
  49                 line => 'B8',
  50         ],
  51         endtype     => 's',
  52         endstr      => 'Ca255',
  53         enddata     => 'Ca255x256',
  54         hiname      => 'a3',
  55         levels      => ['*', # levelcount->total actually
  56                 id         => 'Ca22',
  57                 name       => 'Ca22',
  58                 size       => 'C',
  59                 peas       => 'C',
  60                 delay      => 'C',
  61                 growth     => 'C',
  62                 bsize      => 'C',
  63                 sprite     => ['8C',
  64                         line => 'B8',
  65                 ],
  66                 balls      => ['32C',
  67                         y   => 'C',
  68                         x   => 'C',
  69                         dir => 'C',
  70                 ],
  71                 worms      => [4,
  72                         d => 'C',
  73                         y => 'C',
  74                         x => 'C',
  75                 ],
  76                 width      => 'C',
  77                 height     => 'C',
  78                 flags      => [2,
  79                         y => 'C',
  80                         x => 'C',
  81                 ],
  82                 objects    => ['128C',
  83                         type => 'C',
  84                         x1   => 'C',
  85                         y1   => 'C',
  86                         x2   => 'C',
  87                         y2   => 'C',
  88                 ],
  89         ],
  90 );
  91
  92 my @OBJTYPE = ('none', 'line', 'fat line', 'bar', 'circle');
  93 my @ENDTYPE = ('none', 'message', 'small message');
  94
  95 sub objsummary {
  96         my ($objects) = @_;
  97         my @objtypes = map { $_->{type} } @$objects;
  98         my %count;
  99         $count{$_}++ for @objtypes;
 100         return (@objtypes > 1 && keys %count == 1 && 'all ') . join(', ',
 101                 map { $OBJTYPE[$_] ? $OBJTYPE[$_] . ($count{$_} > 1 && 's') : $_ }
 102                 sort keys %count
 103         );
 104 }
 105
 106 # read and parse all input data
 107 local $/;
 108 my $rawdata = readline;
 109 my ($id, $subid) = (substr($rawdata, 0, 15), ord substr($rawdata, 15, 1));
 110 my $version = $opt{version} // $MAGICID{$id}
 111         or die "File does not match any known WormEdit level header\n";
 112 $subid == $version
 113         or warn "Unsupported version $subid (expecting $version)\n";
 114 given ($version) {
 115         when (53) {
 116                 # current @FORMAT
 117         }
 118         when ($_ <= 95 and $_ > 90) {
 119                 ref $_ and pop @$_ for @{ $FORMAT[11] }; # only 8 moderefs
 120                 $FORMAT[-1]->[-1]->[0] = '32C'; # less objects
 121                 continue;
 122         }
 123         when (95) {
 124                 $FORMAT[7] = 'Ca64'; # no reserved space after description
 125                 #ref $_ and $_->[-1] = 'C' for @{ $FORMAT[11] }; # only 9 moderefs
 126                 $FORMAT[19] = 'Ca255'; # enddata
 127                 splice @FORMAT, 6, 2 if $subid < 95;  # early (sub)version without description
 128         }
 129         when ($_ <= 94 and $_ > 90) {
 130                 splice @FORMAT, 6, 2;  # no description
 131                 splice @{ $FORMAT[7] }, 4, 2;  # no race
 132                 splice @FORMAT, 16, 2; # no enddata
 133                 splice @{ $FORMAT[-1] }, 1, 2; # no name
 134                 continue if $_ < 94;
 135         }
 136         when (93) {
 137                 splice @FORMAT, 16, 2; # no hiname
 138                 $FORMAT[-1]->[0] = 64; # constant amount of levels
 139         }
 140         default {
 141                 die "Cannot parse data for Wormedit $version\n";
 142         }
 143 }
 144 my @rawdata = unpack Shiar_Parse::Nested->template(\@FORMAT).'a*', $rawdata;
 145
 146 # convert to an easily accessible hash
 147 my $data = Shiar_Parse::Nested->convert(\@FORMAT, \@rawdata);
 148 warn "Trailing data left unparsed\n" if grep {length} @rawdata;
 149
 150 # output with user-preferred formatting
 151 if ($opt{raw}) {
 152         require JSON::XS;
 153         my $output = JSON::XS->new->ascii->canonical->pretty->allow_nonref;
 154         print $output->encode($data), "\n";
 155 }
 156 else {
 157         print $data->{name};
 158         print " ($data->{description})" if defined $data->{description};
 159         print "\n";
 160         printf "File version: %s\n", "WormEdit v$data->{version}";
 161         printf "Defaults: %s\n", join('; ',
 162                 'sprite ' . scalar @{ $data->{sprite} },
 163                 defined $data->{hiname} ? 'hiscore by ' . $data->{hiname} : (),
 164         );
 165
 166         my $startnr = 0;
 167         for my $variant (qw/single multi race ctf/) {
 168                 my $count = $data->{levelcount}->{$variant};
 169                 print "\n";
 170                 printf '%s (%s)', ucfirst $variant, $count // 'invalid';
 171                 $count or next;
 172                 print ":";
 173                 printf("\n- %-22s%4s:%3s+%2s%3s %3sx%-3s%s",
 174                         $_->{id} || $_->{name},
 175                         @$_{qw/size bsize growth/},
 176                         $variant eq 'single' && "x$_->{peas}",
 177                         @$_{qw/width height/},
 178                         join(';', map {" $_"} grep {$_}
 179                                 @{$_->{objects}} && sprintf('%2d object%s (%s)',
 180                                         scalar @{$_->{objects}}, @{$_->{objects}} != 1 && 's',
 181                                         objsummary($_->{objects}),
 182                                 ),
 183                                 @{$_->{sprite}} && sprintf('sprite %d',
 184                                         scalar @{$_->{sprite}},
 185                                 ),
 186                         ),
 187                 ) for map { $data->{levels}->[$_ + $startnr] }
 188                         0 .. $count - 1;
 189                 $startnr += $count;
 190         }
 191         continue {
 192                 print "\n";
 193                 printf("-- %-21s%4s: %s (%s)\n",
 194                         '(ending)',
 195                         defined $data->{enddata} ? length $data->{enddata} : '?',
 196                         $ENDTYPE[$data->{endtype}] || 'unknown', $data->{endstr},
 197                 ) if $variant eq 'single';
 198         }
 199 }
 200
 201 package Shiar_Parse::Nested;
 202
 203 sub template {
 204         my ($self, $format) = @_;
 205         # total (flattened) unpack template from nested format definitions
 206         return join '', map {
 207                 my $value = $format->[-($_ << 1) - 1];
 208                 if (ref $value eq 'ARRAY') {
 209                         my $count = $value->[0];
 210                         $value = $self->template($value);
 211                         $value = $count =~ s/^([*\d]+)// ? "$count($value)$1"
 212                                 : $count."X[$count]$count/($value)";
 213                 }
 214                 else {
 215                         $value =~ s/^C(a)(\d+)/$1 . ($2 + 1)/e;  # length prefix
 216                 }
 217                 $value;
 218         } reverse 0 .. ($#$format - 1) >> 1;
 219 }
 220
 221 sub convert {
 222         my ($self, $format, $data) = @_;
 223         # map flat results into a named and nested hash
 224         my %res;
 225         while (my ($field, $template) = splice @$format, 0, 2) {
 226                 if (ref $template eq 'ARRAY') {
 227                         my ($count, @subformat) = @$template;
 228                         my $max = $count =~ s/^(\d+)// ? $1 : 0;
 229                         $count = !$count ? $max
 230                                 : $count eq '*' ? $res{levelcount}->{total} : shift @$data;
 231                         $max ||= $count;
 232                         $res{$field}->[$_] = $self->convert([@subformat], $data) for 0 .. $max-1;
 233                         splice @{ $res{$field} }, $count if $max > $count;
 234                         $res{$field} = $res{$field}->[0] if $max == 1;
 235                         next;
 236                 }
 237                 elsif ($template =~ /^Ca/) {
 238                         $data->[0] = unpack 'C/a', $data->[0];
 239                 }
 240                 $res{$field} = shift @$data;
 241         }
 242         return \%res;
 243 }
 244
 245 __END__
 246
 247 =head1 NAME
 248
 249 parse-wormedit - WormEdit level data parser
 250
 251 =head1 SYNOPSIS
 252
 253  parse-wormedit [--raw] <input.lvl>
 254
 255 =head1 DESCRIPTION
 256
 257 Reads WormEdit v0.53 levels from STDIN or given file,
 258 and outputs contents, summarised or in full.
 259
 260 =head1 AUTHOR
 261
 262 Mischa POSLAWSKY <wormy@shiar.org>
 263
 264 =head1 LICENSE
 265
 266 GPL version 3.
 267