parse-wormedit

   1 #!/usr/bin/env perl
   2 use strict;
   3 use warnings;
   4 use 5.010;
   5 use lib 'lib';  # make runnable for simple cases
   6
   7 use Data::Dumper;
   8 use Getopt::Long 2.33 qw(HelpMessage :config bundling);
   9 use Games::Wormy::TICalcLevels;
  10 use Games::Wormy::WormEdit;
  11
  12 our $VERSION = '1.05';
  13
  14 GetOptions(\my %opt,
  15         'raw|r',  # full output
  16         'version=i',  # force version
  17 ) or HelpMessage(-exitval => 2);
  18
  19 my @OBJTYPE = ('none', 'line', 'fat line', 'bar', 'circle');
  20 my @ENDTYPE = ('none', 'message', 'small message');
  21
  22 sub objsummary {
  23         my ($objects) = @_;
  24         my @objtypes = map { $_->{type} } @$objects;
  25         my %count;
  26         $count{$_}++ for @objtypes;
  27         return (@objtypes > 1 && keys %count == 1 && 'all ') . join(', ',
  28                 map { $OBJTYPE[$_] ? $OBJTYPE[$_] . ($count{$_} > 1 && 's') : $_ }
  29                 sort keys %count
  30         );
  31 }
  32
  33 # read and parse all input data
  34 my $data;
  35 local $/;
  36 my $rawdata = readline;
  37 if (substr($rawdata, 0, 11) eq "**TI86**\032\012\000") {
  38         # compiled calculator file
  39         $data = Games::Wormy::TICalcLevels->read($rawdata, $opt{version});
  40 }
  41 elsif (substr($rawdata, 0, 8) eq 'WormEdit') {
  42         # original wormedit source
  43         $data = Games::Wormy::WormEdit->read($rawdata, $opt{version});
  44 }
  45 else {
  46         die "Unrecognised file type\n";
  47 }
  48
  49 # output with user-preferred formatting
  50 if ($opt{raw}) {
  51         # full data in yaml (human-readable) formatting
  52         require YAML;
  53         local $YAML::CompressSeries;
  54               $YAML::CompressSeries = 0;
  55         my $yml = "# Wormy levelset\n" . YAML::Dump($data);
  56
  57         # inline format of short hashes
  58         $yml =~ s{
  59                 ^(\ *) - \n                          # array indicator
  60                 ((?:\1\ \ [a-z0-9]{1,5}:\ *\d+\n)+)  # simple hash declaration
  61                 (?!\1\ )                             # no further children
  62         }[
  63                 my ($indent, $value) = ($1, $2);
  64                 chop $value;
  65                 $value =~ s/^ +//gm;
  66                 $value =~ s/\n/, /g;
  67                 "$indent- {$value}\n";
  68         ]egmx;
  69
  70         print $yml;
  71 }
  72 else {
  73         print $data->{name};
  74         print " ($data->{description})" if defined $data->{description};
  75         print "\n";
  76         printf "File version: %s\n", "$data->{format} v$data->{version}";
  77         printf "Defaults: %s\n", join('; ',
  78                 $data->{sprite} ? 'sprite ' . scalar @{ $data->{sprite} } : (),
  79                 defined $data->{hiname} ? 'hiscore by ' . $data->{hiname} : (),
  80         );
  81
  82         my $startnr = 0;
  83         for my $variant (qw/single peaworm multi race ctf/) {
  84                 my $count = $data->{levelcount}->{$variant};
  85                 defined $count or next;
  86                 print "\n";
  87                 printf '%s (%s)', ucfirst $variant, $count;
  88                 $count or next;
  89                 print ":";
  90                 for (0 .. $count - 1) {
  91                         my $level = $data->{levels}->[$_ + $startnr];
  92                         printf("\n- %-22s%4s:%3s+%2s%3s %3sx%-3s%s",
  93                                 $level->{id} || $level->{name} || '#'.($_+1),
  94                                 @$level{qw/size bsize growth/},
  95                                 $variant eq 'single' && "x$level->{peas}",
  96                                 @$level{qw/width height/},
  97                                 join(';', map {" $_"} grep {$_}
  98                                         @{$level->{objects}} && sprintf('%2d object%s (%s)',
  99                                                 scalar @{$level->{objects}}, @{$level->{objects}} != 1 && 's',
 100                                                 objsummary($level->{objects}),
 101                                         ),
 102                                         $level->{sprite} && @{$level->{sprite}} && sprintf('sprite %d',
 103                                                 scalar @{$level->{sprite}},
 104                                         ),
 105                                         $level->{balls} && @{$level->{balls}} && sprintf('%d bounc%s',
 106                                                 scalar @{$level->{balls}}, @{$level->{balls}} == 1 ? 'y' : 'ies',
 107                                         ),
 108                                 ),
 109                         );
 110                 }
 111                 $startnr += $count;
 112
 113                 print "\n";
 114                 printf("-- %-21s%4s: %s (%s)\n",
 115                         '(ending)',
 116                         defined $data->{finish}->{code}
 117                                 ? length $data->{finish}->{code} : '?',
 118                         defined $data->{finish}->{type}
 119                                 ? $ENDTYPE[$data->{finish}->{type}] || 'unknown' : 'code',
 120                         $data->{finish}->{message} // '?',
 121                 ) if $variant eq 'single';
 122         }
 123         print "\n";
 124 }
 125
 126 __END__
 127
 128 =head1 NAME
 129
 130 parse-wormedit - Wormy level data parser
 131
 132 =head1 SYNOPSIS
 133
 134  parse-wormedit [--raw] <input.lvl>
 135
 136 =head1 DESCRIPTION
 137
 138 Reads Wormy levels (either original WormEdit source or compiled TI-86 string)
 139 from STDIN or given file, and outputs contents, summarised or in full.
 140
 141 =head1 AUTHOR
 142
 143 Mischa POSLAWSKY <wormy@shiar.org>
 144
 145 =head1 LICENSE
 146
 147 GPL version 3.
 148