parse-wormedit: json format option
[wormy.git] / parse-wormedit
index 2eb9e277e417596d6d9a72204e5caba48a2815dd..aa220513657bfdaf49507b9311e97ea627334025 100755 (executable)
@@ -1,86 +1,26 @@
 #!/usr/bin/env perl
+use 5.010;
 use strict;
 use warnings;
+use experimental 'switch';
+use lib 'lib';  # make runnable for simple cases
 
 use Data::Dumper;
 use Getopt::Long 2.33 qw(HelpMessage :config bundling);
+use Games::Wormy::TICalcLevels;
+use Games::Wormy::WormEdit;
 
-our $VERSION = '1.01';
+our $VERSION = '1.07';
 
 GetOptions(\my %opt,
-       'raw|r',
+       'format|f=s', # output type
+       'raw|r!',  # compatibility for yaml format
+       'version=i',  # force version
+       'levels|render:i',  # image of level(s)
+       'output|o=s',  # output file
 ) or HelpMessage(-exitval => 2);
-
-my $MAGICID = "WormEdit053\000LVL";
-
-my @FORMAT = (
-       magic       => 'a15',
-       version     => 'C',
-       name        => 'Ca32',
-       description => 'Ca64x256',
-       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        => 'Cx',
-               ],
-       ],
-       sprite     => ['8C',
-               line => 'B8',
-       ],
-       endtype     => 's',
-       endstr      => 'Ca255',
-       enddata     => 'Ca255x256',
-       hiname      => 'a3',
-       levels      => ['*', # levelcount->total actually
-               id         => 'Ca22',
-               name       => 'Ca22',
-               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',
-               ],
-       ],
-);
+$opt{format} //= 'yaml' if $opt{raw};
+$opt{format} //= 'pnm'  if defined $opt{levels};
 
 my @OBJTYPE = ('none', 'line', 'fat line', 'bar', 'circle');
 my @ENDTYPE = ('none', 'message', 'small message');
@@ -97,124 +37,184 @@ sub objsummary {
 }
 
 # read and parse all input data
+my $data;
 local $/;
-my @rawdata = unpack Shiar_Parse::Nested->template(\@FORMAT).'a*', readline;
-$rawdata[0] eq $MAGICID
-       or die "File does not match WormEdit level header\n";
-$rawdata[1] == 53
-       or warn "Unsupported version $rawdata[1] (expecting 53)\n";
+my $rawdata = readline;
+if (substr($rawdata, 0, 11) eq "**TI86**\032\012\000") {
+       # compiled calculator file
+       $data = Games::Wormy::TICalcLevels->read($rawdata, $opt{version});
+}
+elsif (substr($rawdata, 0, 8) eq 'WormEdit') {
+       # original wormedit source
+       $data = Games::Wormy::WormEdit->read($rawdata, $opt{version});
+}
+else {
+       die "Unrecognised file type\n";
+}
 
-# convert to an easily accessible hash
-my $data = Shiar_Parse::Nested->convert(\@FORMAT, \@rawdata);
-warn "Trailing data left unparsed\n" if grep {length} @rawdata;
+if ($opt{output}) {{
+       # derive format from file extension
+       if ($opt{output} =~ /\.(yaml|json|txt)$/) {
+               $opt{format} //= $1
+       }
+       else {
+               # images are written directly to file
+               last;
+       }
+
+       # redirect standard output to given file
+       open my $output, '>', $opt{output}
+               or die "Cannot output to '$opt{output}': $!";
+       select $output;
+}}
 
 # output with user-preferred formatting
-if ($opt{raw}) {
-       require JSON::XS;
-       my $output = JSON::XS->new->ascii->canonical->pretty->allow_nonref;
-       print $output->encode($data), "\n";
+given ($opt{format}) {
+when ('json') {
+       require JSON;
+       say JSON->new->encode($data);
 }
-else {
-       print "$data->{name} ($data->{description})\n";
-       printf "File version: %s\n", "WormEdit v$data->{version}";
+when ('yaml') {
+       # full data in yaml (human-readable) formatting
+       require YAML;
+       local $YAML::CompressSeries;
+             $YAML::CompressSeries = 0;
+       my $yml = "# Wormy levelset\n" . YAML::Dump($data);
+
+       # inline format of short hashes
+       $yml =~ s{
+               ^(\ *) - \n                          # array indicator
+               ((?:\1\ \ [a-z0-9]{1,5}:\ *\d+\n)+)  # simple hash declaration
+               (?!\1\ )                             # no further children
+       }[
+               my ($indent, $value) = ($1, $2);
+               chop $value;
+               $value =~ s/^ +//gm;
+               $value =~ s/\n/, /g;
+               "$indent- {$value}\n";
+       ]egmx;
+
+       print $yml;
+}
+when ('txt') {
+       print $data->{name};
+       print " ($data->{description})" if defined $data->{description};
+       print "\n";
+       printf "File version: %s\n", "$data->{format} v$data->{version}";
        printf "Defaults: %s\n", join('; ',
-               'sprite ' . scalar @{ $data->{sprite} },
-               'hiscore by ' . $data->{hiname},
+               $data->{sprite} ? 'sprite ' . scalar @{ $data->{sprite} } : (),
+               defined $data->{hiname} ? 'hiscore by ' . $data->{hiname} : (),
        );
 
        my $startnr = 0;
-       for my $variant (qw/single multi race ctf/) {
-               print "\n";
+       for my $variant (qw/single peaworm multi race ctf/) {
                my $count = $data->{levelcount}->{$variant};
-               printf "\u$variant ($count)";
+               defined $count or next;
+               print "\n";
+               printf '%s (%s)', ucfirst $variant, $count;
                $count or next;
                print ":";
-               printf("\n- %-22s%4s:%3s+%2s%3s %3sx%-3s%s",
-                       $_->{id} || $_->{name},
-                       @$_{qw/size bsize growth/},
-                       $variant eq 'single' && "x$_->{peas}",
-                       @$_{qw/width height/},
-                       join(';', map {" $_"} grep {$_}
-                               @{$_->{objects}} && sprintf('%2d object%s (%s)',
-                                       scalar @{$_->{objects}}, @{$_->{objects}} != 1 && 's',
-                                       objsummary($_->{objects}),
+               for (0 .. $count - 1) {
+                       my $level = $data->{levels}->[$_ + $startnr];
+                       printf("\n- %-22s%4s:%3s+%2s%3s %3sx%-3s%s",
+                               $level->{id} || $level->{name} || '#'.($_+1),
+                               @$level{qw/size bsize growth/},
+                               $variant eq 'single' && "x$level->{peas}",
+                               @$level{qw/width height/},
+                               join(';', map {" $_"} grep {$_}
+                                       @{$level->{objects}} && sprintf('%2d object%s (%s)',
+                                               scalar @{$level->{objects}}, @{$level->{objects}} != 1 && 's',
+                                               objsummary($level->{objects}),
+                                       ),
+                                       $level->{sprite} && @{$level->{sprite}} && sprintf('sprite %d',
+                                               scalar @{$level->{sprite}},
+                                       ),
+                                       $level->{balls} && @{$level->{balls}} && sprintf('%d bounc%s',
+                                               scalar @{$level->{balls}}, @{$level->{balls}} == 1 ? 'y' : 'ies',
+                                       ),
                                ),
-                               @{$_->{sprite}} && sprintf('sprite %d',
-                                       scalar @{$_->{sprite}},
-                               ),
-                       ),
-               ) for map { $data->{levels}->[$_ + $startnr] }
-                       0 .. $count - 1;
+                       );
+               }
                $startnr += $count;
-       }
-       continue {
+
                print "\n";
-               printf("-- %-21s%4d: %s (%s)\n",
+               printf("-- %-21s%4s: %s (%s)\n",
                        '(ending)',
-                       length $data->{enddata},
-                       $ENDTYPE[$data->{endtype}] || 'unknown', $data->{endstr},
+                       defined $data->{finish}->{code}
+                               ? length $data->{finish}->{code} : '?',
+                       defined $data->{finish}->{type}
+                               ? $ENDTYPE[$data->{finish}->{type}] || 'unknown' : 'code',
+                       $data->{finish}->{message} // '?',
                ) if $variant eq 'single';
        }
+       print "\n";
 }
+default {
+       require Games::Wormy::Render;
 
-package Shiar_Parse::Nested;
-
-sub template {
-       my ($self, $format) = @_;
-       # total (flattened) unpack template from nested format definitions
-       return join '', map {
-               my $value = $format->[-($_ << 1) - 1];
-               if (ref $value eq 'ARRAY') {
-                       my $count = $value->[0];
-                       $value = $self->template($value);
-                       $value = $count =~ s/^([*\d]+)// ? "$count($value)$1"
-                               : $count."X[$count]$count/($value)";
-               }
-               else {
-                       $value =~ s/^C(a)(\d+)/$1 . ($2 + 1)/e;  # length prefix
-               }
-               $value;
-       } reverse 0 .. ($#$format - 1) >> 1;
-}
-
-sub convert {
-       my ($self, $format, $data) = @_;
-       # map flat results into a named and nested hash
-       my %res;
-       while (my ($field, $template) = splice @$format, 0, 2) {
-               if (ref $template eq 'ARRAY') {
-                       my ($count, @subformat) = @$template;
-                       my $max = $count =~ s/^(\d+)// ? $1 : 0;
-                       $count = !$count ? $max
-                               : $count eq '*' ? $res{levelcount}->{total} : shift @$data;
-                       $max ||= $count;
-                       $res{$field}->[$_] = $self->convert([@subformat], $data) for 0 .. $max-1;
-                       splice @{ $res{$field} }, $count if $max > $count;
-                       $res{$field} = $res{$field}->[0] if $max == 1;
-                       next;
-               }
-               elsif ($template =~ /^Ca/) {
-                       $data->[0] = unpack 'C/a', $data->[0];
-               }
-               $res{$field} = shift @$data;
+       my @request;
+       if ($opt{levels}) {
+               # find all numeric values in argument
+               @request = $opt{levels} =~ /(\d+)/g;
+       }
+       else {
+               # default to all singleplayer levels
+               @request = 0 .. $data->{levelcount}->{single} - 1;
        }
-       return \%res;
+       @request or die "no levels found or specified\n";
+
+       my $img = Games::Wormy::Render->composite(
+               map { $data->{levels}->[$_] } @request
+       ) or die "empty result for levels\n";
+       if ($opt{format} ~~ 'pbm') {
+               $img = $img->to_paletted({make_colors => 'mono'});
+               $opt{format} = 'pnm';
+       }
+       $img->write(
+               $opt{output} ? (file => $opt{output}) : (fh => \*STDOUT),
+               type => $opt{format} // 'pnm',
+       ) or die $img->errstr;
+}
 }
 
 __END__
 
 =head1 NAME
 
-parse-wormedit - WormEdit level data parser
+parse-wormedit - Wormy level data parser
 
 =head1 SYNOPSIS
 
- parse-wormedit [--raw] <input.lvl>
+ parse-wormedit [--format=<type>] [--levels=<number>] [--output=<file.ext>] <input.lvl>
 
 =head1 DESCRIPTION
 
-Reads WormEdit v0.53 levels from STDIN or given file,
-and outputs contents, summarised or in full.
+Reads Wormy levels (either original WormEdit source or compiled TI-86 string)
+from STDIN or given file, and prints parsed data to STDOUT.
+
+If an I<output> file name is given, its extension determines the format,
+otherwise explicitly given by the I<format> option:
+
+=over 6
+
+=item txt
+
+Plain text summary of levelpack contents.
+
+=item yaml
+
+All parsed data in YAML syntax.
+
+=item json
+
+Parsed data in JSON syntax.
+
+=item pnm, png, bmp, ...
+
+Image drawing of rendered levels.
+Unrecognised values are interpreted as file type and converted by Imager.
+
+=back
 
 =head1 AUTHOR