parse-wormedit: parsing modules in seperate files
[wormy.git] / lib / Games / Wormy / WormEdit.pm
diff --git a/lib/Games/Wormy/WormEdit.pm b/lib/Games/Wormy/WormEdit.pm
new file mode 100644 (file)
index 0000000..3a729ed
--- /dev/null
@@ -0,0 +1,170 @@
+package Games::Wormy::WormEdit;
+
+use 5.010;
+use strict;
+use warnings;
+
+use Parse::Binary::Nested qw(unpackf);
+
+our $VERSION = '1.00';
+
+our %MAGICID = (
+       "WormEdit053\000LVL" => 53,
+       "WormEdit\34195\000LVL" => 95,
+       "WormEdit\34194\000LVL" => 94,
+       "WormEdit\34193\000LVL" => 93,
+);
+
+sub read {
+       my ($self, $input, $override) = @_;
+       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";
+
+       if ($override) {
+               warn "Override version $version to $override\n";
+               $version = $override;
+       }
+       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;
+               }
+               elsif (ord substr($input, 147, 1) == 0) {
+                       # nul of finish type is 2 bytes later (unlike first char of message)
+                       $version = 96;
+               }
+               warn "Ambiguous file version 95; guessing subversion $version\n";
+       };
+
+       $fileversion += 100 if $fileversion < 90;  # 93..95 came before 50..53
+
+       my @FORMAT = (
+               magic       => 'a15',
+               version     => 'C',
+               name        => 'C/a32',
+               description => 'C/a64x256',
+               levelcount  => [1,
+                       single => 'C',
+                       multi  => 'C',
+                       race   => 'C',
+                       ctf    => 'C',
+                       total  => 'C',
+               ],
+               moderef     => [1,
+                       map { (start => $_, end => $_) } [1,
+                               single     => 'C',
+                               peaworm    => 'C',
+                               tron       => 'C',
+                               deathmatch => 'C',
+                               foodmatch  => 'C',
+                               multifood  => 'C',
+                               timematch  => 'C',
+                               race       => 'C',
+                               ctf        => 'C',
+                               reserved   => 'x',
+                       ],
+               ],
+               sprite     => ['8C',
+                       line => 'B8',
+               ],
+               finish      => [1,
+                       type    => 's',
+                       message => 'C/a255',
+                       code    => 'C/a255',
+                       reserved=> 'x256',
+               ],
+               hiname      => 'a3',
+               levels      => ['*', # levelcount->total actually
+                       id         => 'C/a22',
+                       name       => 'C/a22',
+                       size       => 'C',
+                       peas       => 'C',
+                       delay      => 'C',
+                       growth     => 'C',
+                       bsize      => 'C',
+                       sprite     => ['8C',
+                               line => 'B8',
+                       ],
+                       balls      => ['32C',
+                               y   => 'C',
+                               x   => 'C',
+                               dir => 'C',
+                       ],
+                       worms      => [4,
+                               d => 'C',
+                               y => 'C',
+                               x => 'C',
+                       ],
+                       width      => 'C',
+                       height     => 'C',
+                       flags      => [2,
+                               y => 'C',
+                               x => 'C',
+                       ],
+                       objects    => ['128C',
+                               type => 'C',
+                               x1   => 'C',
+                               y1   => 'C',
+                               x2   => 'C',
+                               y2   => 'C',
+                       ],
+               ],
+       );
+
+       given ($fileversion) {
+               when (153) { } # current @FORMAT
+                       $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
+               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
+                       splice @{ $FORMAT[13] }, 4, 2; # no enddata
+                       splice @{ $FORMAT[-1] }, 1, 2; # no name
+               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 $fileversion/$version\n";
+               }
+       }
+
+       # convert to an easily accessible hash
+       push @FORMAT, -trail => 'a*';
+       my $data = unpackf(\@FORMAT, $input);
+       warn "Trailing data left unparsed\n" if length delete $data->{-trail};
+       $data->{format} = 'WormEdit';
+       return $data;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Games::Wormy::WormEdit - Read Wormy levelset from a wormedit file
+
+=head1 SYNOPSIS
+
+       my $levelset = Games::Wormy::WormEdit->read($filecontents);
+       print $levelset->{name};
+
+=head1 AUTHOR
+
+Mischa POSLAWSKY <perl@shiar.org>
+
+=head1 LICENSE
+
+LGPL version 3.
+