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.06';
  13
  14 GetOptions(\my %opt,
  15         'raw|r',  # full output
  16         'version=i',  # force version
  17         'render:i',  # image of level(s)
  18         'output|o=s',  # output file
  19 ) or HelpMessage(-exitval => 2);
  20
  21 my @OBJTYPE = ('none', 'line', 'fat line', 'bar', 'circle');
  22 my @ENDTYPE = ('none', 'message', 'small message');
  23
  24 sub objsummary {
  25         my ($objects) = @_;
  26         my @objtypes = map { $_->{type} } @$objects;
  27         my %count;
  28         $count{$_}++ for @objtypes;
  29         return (@objtypes > 1 && keys %count == 1 && 'all ') . join(', ',
  30                 map { $OBJTYPE[$_] ? $OBJTYPE[$_] . ($count{$_} > 1 && 's') : $_ }
  31                 sort keys %count
  32         );
  33 }
  34
  35 # read and parse all input data
  36 my $data;
  37 local $/;
  38 my $rawdata = readline;
  39 if (substr($rawdata, 0, 11) eq "**TI86**\032\012\000") {
  40         # compiled calculator file
  41         $data = Games::Wormy::TICalcLevels->read($rawdata, $opt{version});
  42 }
  43 elsif (substr($rawdata, 0, 8) eq 'WormEdit') {
  44         # original wormedit source
  45         $data = Games::Wormy::WormEdit->read($rawdata, $opt{version});
  46 }
  47 else {
  48         die "Unrecognised file type\n";
  49 }
  50
  51 if ($opt{output}) {{
  52         # derive format from file extension
  53         if ($opt{output} =~ /\.yaml$/) {
  54                 $opt{raw} = 1;
  55         }
  56         elsif ($opt{output} !~ /\.txt$/) {
  57                 $opt{render} ||= 0;
  58                 last;  # images are written directly to file
  59         }
  60
  61         # redirect standard output to given file
  62         open my $output, '>', $opt{output}
  63                 or die "Cannot output to '$opt{output}': $!";
  64         select $output;
  65 }}
  66
  67 # output with user-preferred formatting
  68 if (defined $opt{render}) {
  69         require Games::Wormy::Render;
  70
  71         my @request;
  72         if ($opt{render}) {
  73                 # find all numeric values in argument
  74                 @request = $opt{render} =~ /(\d+)/g;
  75         }
  76         else {
  77                 # default to all singleplayer levels
  78                 @request = 0 .. $data->{levelcount}->{single} - 1;
  79         }
  80
  81         my $img = Games::Wormy::Render->composite(
  82                 map { $data->{levels}->[$_] } @request
  83         );
  84         $img->write(
  85                 $opt{output} ? (file => $opt{output}) : (fh => \*STDOUT, type => 'pnm')
  86         ) or die $img->errstr;
  87 }
  88 elsif ($opt{raw}) {
  89         # full data in yaml (human-readable) formatting
  90         require YAML;
  91         local $YAML::CompressSeries;
  92               $YAML::CompressSeries = 0;
  93         my $yml = "# Wormy levelset\n" . YAML::Dump($data);
  94
  95         # inline format of short hashes
  96         $yml =~ s{
  97                 ^(\ *) - \n                          # array indicator
  98                 ((?:\1\ \ [a-z0-9]{1,5}:\ *\d+\n)+)  # simple hash declaration
  99                 (?!\1\ )                             # no further children
 100         }[
 101                 my ($indent, $value) = ($1, $2);
 102                 chop $value;
 103                 $value =~ s/^ +//gm;
 104                 $value =~ s/\n/, /g;
 105                 "$indent- {$value}\n";
 106         ]egmx;
 107
 108         print $yml;
 109 }
 110 else {
 111         print $data->{name};
 112         print " ($data->{description})" if defined $data->{description};
 113         print "\n";
 114         printf "File version: %s\n", "$data->{format} v$data->{version}";
 115         printf "Defaults: %s\n", join('; ',
 116                 $data->{sprite} ? 'sprite ' . scalar @{ $data->{sprite} } : (),
 117                 defined $data->{hiname} ? 'hiscore by ' . $data->{hiname} : (),
 118         );
 119
 120         my $startnr = 0;
 121         for my $variant (qw/single peaworm multi race ctf/) {
 122                 my $count = $data->{levelcount}->{$variant};
 123                 defined $count or next;
 124                 print "\n";
 125                 printf '%s (%s)', ucfirst $variant, $count;
 126                 $count or next;
 127                 print ":";
 128                 for (0 .. $count - 1) {
 129                         my $level = $data->{levels}->[$_ + $startnr];
 130                         printf("\n- %-22s%4s:%3s+%2s%3s %3sx%-3s%s",
 131                                 $level->{id} || $level->{name} || '#'.($_+1),
 132                                 @$level{qw/size bsize growth/},
 133                                 $variant eq 'single' && "x$level->{peas}",
 134                                 @$level{qw/width height/},
 135                                 join(';', map {" $_"} grep {$_}
 136                                         @{$level->{objects}} && sprintf('%2d object%s (%s)',
 137                                                 scalar @{$level->{objects}}, @{$level->{objects}} != 1 && 's',
 138                                                 objsummary($level->{objects}),
 139                                         ),
 140                                         $level->{sprite} && @{$level->{sprite}} && sprintf('sprite %d',
 141                                                 scalar @{$level->{sprite}},
 142                                         ),
 143                                         $level->{balls} && @{$level->{balls}} && sprintf('%d bounc%s',
 144                                                 scalar @{$level->{balls}}, @{$level->{balls}} == 1 ? 'y' : 'ies',
 145                                         ),
 146                                 ),
 147                         );
 148                 }
 149                 $startnr += $count;
 150
 151                 print "\n";
 152                 printf("-- %-21s%4s: %s (%s)\n",
 153                         '(ending)',
 154                         defined $data->{finish}->{code}
 155                                 ? length $data->{finish}->{code} : '?',
 156                         defined $data->{finish}->{type}
 157                                 ? $ENDTYPE[$data->{finish}->{type}] || 'unknown' : 'code',
 158                         $data->{finish}->{message} // '?',
 159                 ) if $variant eq 'single';
 160         }
 161         print "\n";
 162 }
 163
 164 __END__
 165
 166 =head1 NAME
 167
 168 parse-wormedit - Wormy level data parser
 169
 170 =head1 SYNOPSIS
 171
 172  parse-wormedit [--raw|--render] [--output <file.ext>] <input.lvl>
 173
 174 =head1 DESCRIPTION
 175
 176 Reads Wormy levels (either original WormEdit source or compiled TI-86 string)
 177 from STDIN or given file, and prints summarised contents to STDOUT.
 178
 179 If an I<output> file name is given, its extension determines the format.
 180
 181 =head1 AUTHOR
 182
 183 Mischa POSLAWSKY <wormy@shiar.org>
 184
 185 =head1 LICENSE
 186
 187 GPL version 3.
 188