parse-wormedit: level rendering

If --render is given, outputs an approximate drawing of all singleplayer
levels.  The result is not an exact representation: slopes may be drawn
slightly differently because Imager::Draw is used for simplicity.

To write directly to a file, --output can be given.  Its file name
extension determines the format (.txt and .yaml for default and raw
output, anything else will be parsed by Imager::Files, which supports
most common image types).

diff --git a/lib/Games/Wormy/Render.pm b/lib/Games/Wormy/Render.pm
new file mode 100644 (file)
index 0000000..a1f29f5
--- /dev/null
+++ b/lib/Games/Wormy/Render.pm
@@ -0,0 +1,152 @@
+package Games::Wormy::Render;
+
+use 5.010;
+use strict;
+use warnings;
+
+use Imager;
+use List::Util qw(sum max);
+
+our $VERSION = '1.00';
+
+our %COL = (
+       bg     => Imager::Color->new(255, 255, 255),
+       wall   => Imager::Color->new(  0,   0,   0),
+       player => [
+               {
+                       main  => Imager::Color->new(hue => 120, v => 1, s => .67),
+                       outer => Imager::Color->new(hue => 120, v => 1, s => .33),
+               },
+       ],
+       bouncy => Imager::Color->new(hue => 180, v => 1, s => 1),
+);
+
+sub level {
+       my ($self, $level) = @_;
+
+       my $field = Imager->new(xsize => $level->{width}, ysize => $level->{height});
+       $field->box(filled => 1, color => $COL{bg});
+
+       # initial player paths
+       require Math::Trig;
+       my $DIRMULT = Math::Trig::pi() / 128;
+       for my $num (0 .. $#{ $level->{worms} }) {
+               my $player = $level->{worms}->[$num];
+               $field->line(
+                       x1 => $player->{x},
+                       y1 => $player->{y},
+                       x2 => $player->{x} + sin($_ * $DIRMULT) * 15,
+                       y2 => $player->{y} + cos($_ * $DIRMULT) * 15,
+                       color => $COL{player}->[$num]->{outer},
+               ) for $player->{d} + 13, $player->{d} - 13;
+               $field->line(
+                       x1 => $player->{x},
+                       y1 => $player->{y},
+                       x2 => $player->{x} + sin($player->{d} * $DIRMULT) * 20,
+                       y2 => $player->{y} + cos($player->{d} * $DIRMULT) * 20,
+                       color => $COL{player}->[$num]->{main},
+               );
+               $field->circle(
+                       x => $player->{x},
+                       y => $player->{y},
+                       r => 2,
+                       color => $COL{player}->[$num]->{main},
+               );
+               last;
+       }
+
+       # outer field borders
+       $field->box(
+               xmin => $_,   ymin => 0,
+               xmax => $_+1, ymax => $level->{height} - 1,
+               filled => 1,
+               color => $COL{wall},
+       ) for 0, $level->{width} - 2;
+       $field->box(
+               ymin => $_,   xmin => 2,
+               ymax => $_+1, xmax => $level->{width} - 1,
+               filled => 1,
+               color => $COL{wall},
+       ) for 0, $level->{height} - 2;
+
+       # draw objects
+       for my $object (@{ $level->{objects} }) {
+               my @x = @$object{'x1', 'x2'};
+               my @y = @$object{'y1', 'y2'};
+               given ($object->{type}) {
+                       when (1) {
+                               $field->line(
+                                       x1 => $x[0],
+                                       y1 => $y[0],
+                                       x2 => $x[1],
+                                       y2 => $y[1],
+                                       color => $COL{wall},
+                               );
+                       }
+                       when (2) {
+                               $field->polyline(
+                                       points => [
+                                               [  $x[0], $y[0]], [  $x[1], $y[1]],
+                                               [++$x[1], $y[1]], [++$x[0], $y[0]],
+                                               [$x[0], ++$y[0]], [$x[1], ++$y[1]],
+                                               [--$x[1], $y[1]], [--$x[0], $y[0]],
+                                       ],
+                                       color => $COL{wall},
+                               );
+                       }
+                       when (3) {
+                               $field->box(
+                                       xmin => $x[0],
+                                       ymin => $y[0],
+                                       xmax => $x[1],
+                                       ymax => $y[0] + $y[1],
+                                       filled => 1,
+                                       color => $COL{wall},
+                               );
+                       }
+                       when (4) {
+                               $field->circle(
+                                       x => $x[0],
+                                       y => $y[0],
+                                       r => $x[1],
+                                       filled => 1,
+                                       color => $COL{wall},
+                               );
+                       }
+               }
+       }
+
+       for my $bouncy (@{ $level->{balls} }) {
+               $field->box(
+                       xmin => $bouncy->{x},
+                       ymin => $bouncy->{y},
+                       xmax => $bouncy->{x} + 1,
+                       ymax => $bouncy->{y} + 1,
+                       color => $COL{bouncy},
+               );
+       }
+
+       return $field;
+}
+
+sub composite {
+       my $self = shift;
+
+       # single level can be returned directly
+       return $self->level($_[0]) if @_ == 1;
+
+       # concatenate images of multiple levels
+       my $width  = max map { $_->{width} } @_;
+       my $height = sum(map { $_->{height} + 1 } @_) - 1;
+       my $output = Imager->new(xsize => $width, ysize => $height);
+       $output->box(filled => 1, color => [64, 0, 0]);
+       $height = 0;
+       for (@_) {
+               $output->paste(src => $self->level($_), top => $height);
+               $height += $_->{height} + 1;
+       }
+       return $output;
+}
+
+1;
+

diff --git a/parse-wormedit b/parse-wormedit
index 4c4358f875a7a37bcf3e678badac5973582a06a3..0c94994a5ae79a122d603d924af658354a898a56 100755 (executable)
--- a/parse-wormedit
+++ b/parse-wormedit
@@ -9,11 +9,13 @@ use Getopt::Long 2.33 qw(HelpMessage :config bundling);
 use Games::Wormy::TICalcLevels;
 use Games::Wormy::WormEdit;
 
-our $VERSION = '1.05';
+our $VERSION = '1.06';
 
 GetOptions(\my %opt,
        'raw|r',  # full output
        'version=i',  # force version
+       'render:i',  # image of level(s)
+       'output|o=s',  # output file
 ) or HelpMessage(-exitval => 2);
 
 my @OBJTYPE = ('none', 'line', 'fat line', 'bar', 'circle');
@@ -46,8 +48,44 @@ else {
        die "Unrecognised file type\n";
 }
 
+if ($opt{output}) {{
+       # derive format from file extension
+       if ($opt{output} =~ /\.yaml$/) {
+               $opt{raw} = 1;
+       }
+       elsif ($opt{output} !~ /\.txt$/) {
+               $opt{render} ||= 0;
+               last;  # images are written directly to file
+       }
+
+       # 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}) {
+if (defined $opt{render}) {
+       require Games::Wormy::Render;
+
+       my @request;
+       if ($opt{render}) {
+               # find all numeric values in argument
+               @request = $opt{render} =~ /(\d+)/g;
+       }
+       else {
+               # default to all singleplayer levels
+               @request = 0 .. $data->{levelcount}->{single} - 1;
+       }
+
+       my $img = Games::Wormy::Render->composite(
+               map { $data->{levels}->[$_] } @request
+       );
+       $img->write(
+               $opt{output} ? (file => $opt{output}) : (fh => \*STDOUT, type => 'pnm')
+       ) or die $img->errstr;
+}
+elsif ($opt{raw}) {
        # full data in yaml (human-readable) formatting
        require YAML;
        local $YAML::CompressSeries;
@@ -131,12 +169,14 @@ parse-wormedit - Wormy level data parser
 
 =head1 SYNOPSIS
 
- parse-wormedit [--raw] <input.lvl>
+ parse-wormedit [--raw|--render] [--output <file.ext>] <input.lvl>
 
 =head1 DESCRIPTION
 
 Reads Wormy levels (either original WormEdit source or compiled TI-86 string)
-from STDIN or given file, and outputs contents, summarised or in full.
+from STDIN or given file, and prints summarised contents to STDOUT.
+
+If an I<output> file name is given, its extension determines the format.
 
 =head1 AUTHOR