lib/Games/Wormy/Render.pm

   1 package Games::Wormy::Render;
   2
   3 use 5.010;
   4 use strict;
   5 use warnings;
   6
   7 use Imager;
   8 use List::Util qw(sum max);
   9
  10 our $VERSION = '1.00';
  11
  12 our %COL = (
  13         bg     => Imager::Color->new(255, 255, 255),
  14         wall   => Imager::Color->new(  0,   0,   0),
  15         player => [
  16                 {
  17                         main  => Imager::Color->new(hue => 120, v => 1, s => .67),
  18                         outer => Imager::Color->new(hue => 120, v => 1, s => .33),
  19                 },
  20         ],
  21         bouncy => Imager::Color->new(hue => 180, v => 1, s => 1),
  22 );
  23
  24 sub level {
  25         my ($self, $level) = @_;
  26
  27         my $field = Imager->new(xsize => $level->{width}, ysize => $level->{height});
  28         $field->box(filled => 1, color => $COL{bg});
  29
  30         # initial player paths
  31         require Math::Trig;
  32         my $DIRMULT = Math::Trig::pi() / 128;
  33         for my $num (0 .. $#{ $level->{worms} }) {
  34                 my $player = $level->{worms}->[$num];
  35                 $field->line(
  36                         x1 => $player->{x},
  37                         y1 => $player->{y},
  38                         x2 => $player->{x} + sin($_ * $DIRMULT) * 15,
  39                         y2 => $player->{y} + cos($_ * $DIRMULT) * 15,
  40                         color => $COL{player}->[$num]->{outer},
  41                 ) for $player->{d} + 13, $player->{d} - 13;
  42                 $field->line(
  43                         x1 => $player->{x},
  44                         y1 => $player->{y},
  45                         x2 => $player->{x} + sin($player->{d} * $DIRMULT) * 20,
  46                         y2 => $player->{y} + cos($player->{d} * $DIRMULT) * 20,
  47                         color => $COL{player}->[$num]->{main},
  48                 );
  49                 $field->circle(
  50                         x => $player->{x},
  51                         y => $player->{y},
  52                         r => 2,
  53                         color => $COL{player}->[$num]->{main},
  54                 );
  55                 last;
  56         }
  57
  58         # outer field borders
  59         $field->box(
  60                 xmin => $_,   ymin => 0,
  61                 xmax => $_+1, ymax => $level->{height} - 1,
  62                 filled => 1,
  63                 color => $COL{wall},
  64         ) for 0, $level->{width} - 2;
  65         $field->box(
  66                 ymin => $_,   xmin => 2,
  67                 ymax => $_+1, xmax => $level->{width} - 1,
  68                 filled => 1,
  69                 color => $COL{wall},
  70         ) for 0, $level->{height} - 2;
  71
  72         # draw objects
  73         for my $object (@{ $level->{objects} }) {
  74                 my @x = @$object{'x1', 'x2'};
  75                 my @y = @$object{'y1', 'y2'};
  76                 given ($object->{type}) {
  77                         when (1) {
  78                                 $field->line(
  79                                         x1 => $x[0],
  80                                         y1 => $y[0],
  81                                         x2 => $x[1],
  82                                         y2 => $y[1],
  83                                         color => $COL{wall},
  84                                 );
  85                         }
  86                         when (2) {
  87                                 $field->polyline(
  88                                         points => [
  89                                                 [  $x[0], $y[0]], [  $x[1], $y[1]],
  90                                                 [++$x[1], $y[1]], [++$x[0], $y[0]],
  91                                                 [$x[0], ++$y[0]], [$x[1], ++$y[1]],
  92                                                 [--$x[1], $y[1]], [--$x[0], $y[0]],
  93                                         ],
  94                                         color => $COL{wall},
  95                                 );
  96                         }
  97                         when (3) {
  98                                 $field->box(
  99                                         xmin => $x[0],
 100                                         ymin => $y[0],
 101                                         xmax => $x[1],
 102                                         ymax => $y[0] + $y[1],
 103                                         filled => 1,
 104                                         color => $COL{wall},
 105                                 );
 106                         }
 107                         when (4) {
 108                                 $field->circle(
 109                                         x => $x[0],
 110                                         y => $y[0],
 111                                         r => $x[1],
 112                                         filled => 1,
 113                                         color => $COL{wall},
 114                                 );
 115                         }
 116                 }
 117         }
 118
 119         for my $bouncy (@{ $level->{balls} }) {
 120                 $field->box(
 121                         xmin => $bouncy->{x},
 122                         ymin => $bouncy->{y},
 123                         xmax => $bouncy->{x} + 1,
 124                         ymax => $bouncy->{y} + 1,
 125                         color => $COL{bouncy},
 126                 );
 127         }
 128
 129         return $field;
 130 }
 131
 132 sub composite {
 133         my $self = shift;
 134
 135         # single level can be returned directly
 136         return $self->level($_[0]) if @_ == 1;
 137
 138         # concatenate images of multiple levels
 139         my $width  = max map { $_->{width} } @_;
 140         my $height = sum(map { $_->{height} + 1 } @_) - 1;
 141         my $output = Imager->new(xsize => $width, ysize => $height);
 142         $output->box(filled => 1, color => [64, 0, 0]);
 143         $height = 0;
 144         for (@_) {
 145                 $output->paste(src => $self->level($_), top => $height);
 146                 $height += $_->{height} + 1;
 147         }
 148         return $output;
 149 }
 150
 151 1;
 152