lib/Games/Wormy/WormEdit.pm

   1 package Games::Wormy::WormEdit;
   2
   3 use 5.010;
   4 use strict;
   5 use warnings;
   6 use experimental 'switch';
   7
   8 use Parse::Binary::Nested qw(unpackf);
   9
  10 our $VERSION = '1.00';
  11
  12 our %MAGICID = (
  13         "WormEdit053\000LVL" => 53,
  14         "WormEdit\34195\000LVL" => 95,
  15         "WormEdit\34194\000LVL" => 94,
  16         "WormEdit\34193\000LVL" => 93,
  17 );
  18
  19 sub read {
  20         my ($self, $input, $override) = @_;
  21         my ($id, $version) = (substr($input, 0, 15), ord substr($input, 15, 1));
  22         my $fileversion = $MAGICID{$id}
  23                 or die "File does not match any known WormEdit level header\n";
  24
  25         if ($override) {
  26                 warn "Override version $version to $override\n";
  27                 $version = $override;
  28         }
  29         elsif ($version != $fileversion) {
  30                 warn "Unexpected version $version (expecting $fileversion)\n";
  31         }
  32         elsif ($version == 95) {
  33                 # auto-detect exact variant
  34                 if (ord substr($input, 70, 1) ~~ [1 .. 8]) {
  35                         # valid sprite length instead of description byte
  36                         # (which is usually a letter or nul)
  37                         $version = 94;
  38                 }
  39                 elsif (ord substr($input, 147, 1) == 0) {
  40                         # nul of finish type is 2 bytes later (unlike first char of message)
  41                         $version = 96;
  42                 }
  43                 warn "Ambiguous file version 95; guessing subversion $version\n";
  44         };
  45
  46         $fileversion += 100 if $fileversion < 90;  # 93..95 came before 50..53
  47
  48         my @FORMAT = (
  49                 magic       => 'a15',
  50                 version     => 'C',
  51                 name        => 'C/a32',
  52                 description => 'C/a64x256',
  53                 levelcount  => [1,
  54                         single => 'C',
  55                         multi  => 'C',
  56                         race   => 'C',
  57                         ctf    => 'C',
  58                         total  => 'C',
  59                 ],
  60                 moderef     => [1,
  61                         map { (start => $_, end => $_) } [1,
  62                                 single     => 'C',
  63                                 peaworm    => 'C',
  64                                 tron       => 'C',
  65                                 deathmatch => 'C',
  66                                 foodmatch  => 'C',
  67                                 multifood  => 'C',
  68                                 timematch  => 'C',
  69                                 race       => 'C',
  70                                 ctf        => 'C',
  71                                 reserved   => 'x',
  72                         ],
  73                 ],
  74                 sprite     => ['8C',
  75                         line => 'B8',
  76                 ],
  77                 finish      => [1,
  78                         type    => 's',
  79                         message => 'C/a255',
  80                         code    => 'C/a255',
  81                         reserved=> 'x256',
  82                 ],
  83                 hiname      => 'a3',
  84                 levels      => ['*', # levelcount->total actually
  85                         id         => 'C/a22',
  86                         name       => 'C/a22',
  87                         size       => 'C',
  88                         peas       => 'C',
  89                         delay      => 'C',
  90                         growth     => 'C',
  91                         bsize      => 'C',
  92                         sprite     => ['8C',
  93                                 line => 'B8',
  94                         ],
  95                         balls      => ['32C',
  96                                 y   => 'C',
  97                                 x   => 'C',
  98                                 dir => 'C',
  99                         ],
 100                         worms      => [4,
 101                                 d => 'C',
 102                                 y => 'C',
 103                                 x => 'C',
 104                         ],
 105                         width      => 'C',
 106                         height     => 'C',
 107                         flags      => [2,
 108                                 y => 'C',
 109                                 x => 'C',
 110                         ],
 111                         objects    => ['128C',
 112                                 type => 'C',
 113                                 x1   => 'C',
 114                                 y1   => 'C',
 115                                 x2   => 'C',
 116                                 y2   => 'C',
 117                         ],
 118                 ],
 119         );
 120
 121         given ($fileversion) {
 122                 when (153) { } # current @FORMAT
 123                         $FORMAT[7] = 'C/a64'; # no reserved space after description
 124                         splice @{ $FORMAT[15] }, -2; # finish reserve
 125                         $FORMAT[-1]->[-1]->[0] = '32C'; # less objects
 126                         ref $_ and pop @$_ for @{ $FORMAT[11] }; # 9 moderefs
 127                 when ($version == 96) { }
 128                         ref $_ and pop @$_ for @{ $FORMAT[11] }; # only 8 moderefs (no ctf)
 129                         splice @FORMAT, 6, 2 if $version <= 94;  # earlier version without description
 130                 when (95) { }
 131                         splice @{ $FORMAT[7] }, 4, 2;  # no race
 132                         splice @{ $FORMAT[13] }, 4, 2; # no enddata
 133                         splice @{ $FORMAT[-1] }, 1, 2; # no name
 134                 when (94) { }
 135                         splice @FORMAT, 14, 2; # no hiname
 136                         $FORMAT[-1]->[0] = 64; # constant amount of levels
 137                 when (93) { }
 138                 default {
 139                         die "Cannot parse data for Wormedit $fileversion/$version\n";
 140                 }
 141         }
 142
 143         # convert to an easily accessible hash
 144         push @FORMAT, -trail => 'a*';
 145         my $data = unpackf(\@FORMAT, $input);
 146         warn "Trailing data left unparsed\n" if length delete $data->{-trail};
 147         $data->{format} = 'WormEdit';
 148         return $data;
 149 }
 150
 151 1;
 152
 153 __END__
 154
 155 =head1 NAME
 156
 157 Games::Wormy::WormEdit - Read Wormy levelset from a wormedit file
 158
 159 =head1 SYNOPSIS
 160
 161         my $levelset = Games::Wormy::WormEdit->read($filecontents);
 162         print $levelset->{name};
 163
 164 =head1 AUTHOR
 165
 166 Mischa POSLAWSKY <perl@shiar.org>
 167
 168 =head1 LICENSE
 169
 170 LGPL version 3.
 171