parse-wormedit

   1 #!/usr/bin/env perl
   2 use 5.010;
   3 use strict;
   4 use warnings;
   5 use experimental 'switch';
   6 use lib 'lib';  # make runnable for simple cases
   7
   8 use Data::Dumper;
   9 use Getopt::Long 2.33 qw(HelpMessage :config bundling);
  10 use Games::Wormy::TICalcLevels;
  11 use Games::Wormy::WormEdit;
  12
  13 our $VERSION = '1.07';
  14
  15 GetOptions(\my %opt,
  16         'format|f=s', # output type
  17         'raw|r!',  # compatibility for yaml format
  18         'version=i',  # force version
  19         'levels|render:i',  # image of level(s)
  20         'output|o=s',  # output file
  21 ) or HelpMessage(-exitval => 2);
  22 $opt{format} //= 'yaml' if $opt{raw};
  23 $opt{format} //= 'pnm'  if defined $opt{levels};
  24
  25 my @OBJTYPE = ('none', 'line', 'fat line', 'bar', 'circle');
  26 my @ENDTYPE = ('none', 'message', 'small message');
  27
  28 sub objsummary {
  29         my ($objects) = @_;
  30         my @objtypes = map { $_->{type} } @$objects;
  31         my %count;
  32         $count{$_}++ for @objtypes;
  33         return (@objtypes > 1 && keys %count == 1 && 'all ') . join(', ',
  34                 map { $OBJTYPE[$_] ? $OBJTYPE[$_] . ($count{$_} > 1 && 's') : $_ }
  35                 sort keys %count
  36         );
  37 }
  38
  39 # read and parse all input data
  40 my $data;
  41 local $/;
  42 my $rawdata = readline;
  43 if (substr($rawdata, 0, 11) eq "**TI86**\032\012\000") {
  44         # compiled calculator file
  45         $data = Games::Wormy::TICalcLevels->read($rawdata, $opt{version});
  46 }
  47 elsif (substr($rawdata, 0, 8) eq 'WormEdit') {
  48         # original wormedit source
  49         $data = Games::Wormy::WormEdit->read($rawdata, $opt{version});
  50 }
  51 else {
  52         die "Unrecognised file type\n";
  53 }
  54
  55 my $format = $opt{format};  # override distinct from image fallback
  56 if ($opt{output}) {{
  57         # derive format from file extension
  58         $format //= $1 if $opt{output} =~ /\.([^.]+)$/;
  59
  60         if ($format ~~ [qw{ yaml json txt }]) {
  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         else {
  67                 # images are written directly to file
  68         }
  69 }}
  70 else {
  71         $format //= 'txt';
  72 }
  73
  74 # output with user-preferred formatting
  75 given ($format) {
  76 when ('json') {
  77         require JSON;
  78         say JSON->new->encode($data);
  79 }
  80 when ('yaml') {
  81         # full data in yaml (human-readable) formatting
  82         require YAML;
  83         local $YAML::CompressSeries;
  84               $YAML::CompressSeries = 0;
  85         my $yml = "# Wormy levelset\n" . YAML::Dump($data);
  86
  87         # inline format of short hashes
  88         $yml =~ s{
  89                 ^(\ *) - \n                          # array indicator
  90                 ((?:\1\ \ [a-z0-9]{1,5}:\ *\d+\n)+)  # simple hash declaration
  91                 (?!\1\ )                             # no further children
  92         }[
  93                 my ($indent, $value) = ($1, $2);
  94                 chop $value;
  95                 $value =~ s/^ +//gm;
  96                 $value =~ s/\n/, /g;
  97                 "$indent- {$value}\n";
  98         ]egmx;
  99
 100         print $yml;
 101 }
 102 when ('txt') {
 103         print $data->{name};
 104         print " ($data->{description})" if defined $data->{description};
 105         print "\n";
 106         printf "File version: %s\n", "$data->{format} v$data->{version}";
 107         printf "Defaults: %s\n", join('; ',
 108                 $data->{sprite} ? 'sprite ' . scalar @{ $data->{sprite} } : (),
 109                 defined $data->{hiname} ? 'hiscore by ' . $data->{hiname} : (),
 110         );
 111
 112         my $startnr = 0;
 113         for my $variant (qw/single peaworm multi race ctf/) {
 114                 my $count = $data->{levelcount}->{$variant};
 115                 defined $count or next;
 116                 print "\n";
 117                 printf '%s (%s)', ucfirst $variant, $count;
 118                 $count or next;
 119                 print ":";
 120                 for (0 .. $count - 1) {
 121                         my $level = $data->{levels}->[$_ + $startnr];
 122                         printf("\n- %-22s%4s:%3s+%2s%3s %3sx%-3s%s",
 123                                 $level->{id} || $level->{name} || '#'.($_+1),
 124                                 @$level{qw/size bsize growth/},
 125                                 $variant eq 'single' && "x$level->{peas}",
 126                                 @$level{qw/width height/},
 127                                 join(';', map {" $_"} grep {$_}
 128                                         @{$level->{objects}} && sprintf('%2d object%s (%s)',
 129                                                 scalar @{$level->{objects}}, @{$level->{objects}} != 1 && 's',
 130                                                 objsummary($level->{objects}),
 131                                         ),
 132                                         $level->{sprite} && @{$level->{sprite}} && sprintf('sprite %d',
 133                                                 scalar @{$level->{sprite}},
 134                                         ),
 135                                         $level->{balls} && @{$level->{balls}} && sprintf('%d bounc%s',
 136                                                 scalar @{$level->{balls}}, @{$level->{balls}} == 1 ? 'y' : 'ies',
 137                                         ),
 138                                 ),
 139                         );
 140                 }
 141                 $startnr += $count;
 142
 143                 print "\n";
 144                 printf("-- %-21s%4s: %s (%s)\n",
 145                         '(ending)',
 146                         defined $data->{finish}->{code}
 147                                 ? length $data->{finish}->{code} : '?',
 148                         defined $data->{finish}->{type}
 149                                 ? $ENDTYPE[$data->{finish}->{type}] || 'unknown' : 'code',
 150                         $data->{finish}->{message} // '?',
 151                 ) if $variant eq 'single';
 152         }
 153         print "\n";
 154 }
 155 default {
 156         require Games::Wormy::Render;
 157
 158         my @request;
 159         if ($opt{levels}) {
 160                 # find all numeric values in argument
 161                 @request = $opt{levels} =~ /(\d+)/g;
 162         }
 163         else {
 164                 # default to all singleplayer levels
 165                 @request = 0 .. $data->{levelcount}->{single} - 1;
 166         }
 167         @request or die "no levels found or specified\n";
 168
 169         my $img = Games::Wormy::Render->composite(
 170                 map { $data->{levels}->[$_] } @request
 171         ) or die "empty result for levels\n";
 172         if ($format ~~ 'pbm') {
 173                 $img = $img->to_paletted({make_colors => 'mono'});
 174                 $opt{format} = 'pnm';
 175         }
 176         $img->write(
 177                 $opt{output} ? (file => $opt{output}) : (fh => \*STDOUT),
 178                 type => $opt{format},
 179         ) or die $img->errstr;
 180 }
 181 }
 182
 183 __END__
 184
 185 =head1 NAME
 186
 187 parse-wormedit - Wormy level data parser
 188
 189 =head1 SYNOPSIS
 190
 191  parse-wormedit [--format=<type>] [--levels=<number>] [--output=<file.ext>] <input.lvl>
 192
 193 =head1 DESCRIPTION
 194
 195 Reads Wormy levels (either original WormEdit source or compiled TI-86 string)
 196 from STDIN or given file, and prints parsed data to STDOUT.
 197
 198 If an I<output> file name is given, its extension determines the format,
 199 otherwise explicitly given by the I<format> option:
 200
 201 =over 6
 202
 203 =item txt
 204
 205 Plain text summary of levelpack contents.
 206
 207 =item yaml
 208
 209 All parsed data in YAML syntax.
 210
 211 =item json
 212
 213 Parsed data in JSON syntax.
 214
 215 =item pnm, png, bmp, ...
 216
 217 Image drawing of rendered levels.
 218 Unrecognised values are interpreted as file type and converted by Imager.
 219
 220 =back
 221
 222 =head1 AUTHOR
 223
 224 Mischa POSLAWSKY <wormy@shiar.org>
 225
 226 =head1 LICENSE
 227
 228 GPL version 3.
 229