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         @request or die "no levels found or specified\n";
  81
  82         my $img = Games::Wormy::Render->composite(
  83                 map { $data->{levels}->[$_] } @request
  84         ) or die "empty result for levels\n";
  85         $img->write(
  86                 $opt{output} ? (file => $opt{output}) : (fh => \*STDOUT, type => 'pnm')
  87         ) or die $img->errstr;
  88 }
  89 elsif ($opt{raw}) {
  90         # full data in yaml (human-readable) formatting
  91         require YAML;
  92         local $YAML::CompressSeries;
  93               $YAML::CompressSeries = 0;
  94         my $yml = "# Wormy levelset\n" . YAML::Dump($data);
  95
  96         # inline format of short hashes
  97         $yml =~ s{
  98                 ^(\ *) - \n                          # array indicator
  99                 ((?:\1\ \ [a-z0-9]{1,5}:\ *\d+\n)+)  # simple hash declaration
 100                 (?!\1\ )                             # no further children
 101         }[
 102                 my ($indent, $value) = ($1, $2);
 103                 chop $value;
 104                 $value =~ s/^ +//gm;
 105                 $value =~ s/\n/, /g;
 106                 "$indent- {$value}\n";
 107         ]egmx;
 108
 109         print $yml;
 110 }
 111 else {
 112         print $data->{name};
 113         print " ($data->{description})" if defined $data->{description};
 114         print "\n";
 115         printf "File version: %s\n", "$data->{format} v$data->{version}";
 116         printf "Defaults: %s\n", join('; ',
 117                 $data->{sprite} ? 'sprite ' . scalar @{ $data->{sprite} } : (),
 118                 defined $data->{hiname} ? 'hiscore by ' . $data->{hiname} : (),
 119         );
 120
 121         my $startnr = 0;
 122         for my $variant (qw/single peaworm multi race ctf/) {
 123                 my $count = $data->{levelcount}->{$variant};
 124                 defined $count or next;
 125                 print "\n";
 126                 printf '%s (%s)', ucfirst $variant, $count;
 127                 $count or next;
 128                 print ":";
 129                 for (0 .. $count - 1) {
 130                         my $level = $data->{levels}->[$_ + $startnr];
 131                         printf("\n- %-22s%4s:%3s+%2s%3s %3sx%-3s%s",
 132                                 $level->{id} || $level->{name} || '#'.($_+1),
 133                                 @$level{qw/size bsize growth/},
 134                                 $variant eq 'single' && "x$level->{peas}",
 135                                 @$level{qw/width height/},
 136                                 join(';', map {" $_"} grep {$_}
 137                                         @{$level->{objects}} && sprintf('%2d object%s (%s)',
 138                                                 scalar @{$level->{objects}}, @{$level->{objects}} != 1 && 's',
 139                                                 objsummary($level->{objects}),
 140                                         ),
 141                                         $level->{sprite} && @{$level->{sprite}} && sprintf('sprite %d',
 142                                                 scalar @{$level->{sprite}},
 143                                         ),
 144                                         $level->{balls} && @{$level->{balls}} && sprintf('%d bounc%s',
 145                                                 scalar @{$level->{balls}}, @{$level->{balls}} == 1 ? 'y' : 'ies',
 146                                         ),
 147                                 ),
 148                         );
 149                 }
 150                 $startnr += $count;
 151
 152                 print "\n";
 153                 printf("-- %-21s%4s: %s (%s)\n",
 154                         '(ending)',
 155                         defined $data->{finish}->{code}
 156                                 ? length $data->{finish}->{code} : '?',
 157                         defined $data->{finish}->{type}
 158                                 ? $ENDTYPE[$data->{finish}->{type}] || 'unknown' : 'code',
 159                         $data->{finish}->{message} // '?',
 160                 ) if $variant eq 'single';
 161         }
 162         print "\n";
 163 }
 164
 165 __END__
 166
 167 =head1 NAME
 168
 169 parse-wormedit - Wormy level data parser
 170
 171 =head1 SYNOPSIS
 172
 173  parse-wormedit [--raw|--render] [--output <file.ext>] <input.lvl>
 174
 175 =head1 DESCRIPTION
 176
 177 Reads Wormy levels (either original WormEdit source or compiled TI-86 string)
 178 from STDIN or given file, and prints summarised contents to STDOUT.
 179
 180 If an I<output> file name is given, its extension determines the format.
 181
 182 =head1 AUTHOR
 183
 184 Mischa POSLAWSKY <wormy@shiar.org>
 185
 186 =head1 LICENSE
 187
 188 GPL version 3.
 189