The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!perl

use Test::More tests => 6;

use Games::Maze::SVG;
use FindBin;
use lib "$FindBin::Bin/lib";
use MazeTestUtils;
use Data::Dumper;

use strict;
use warnings;

my $maze = Games::Maze::SVG->new( "RectHex" );
can_ok( $maze, "transform_grid", "make_board_array" );

my $simplegrid = <<'EOM';
 __ 
/  \
\__/
EOM

my $simpleout = [
   [ qw/ 0 tl hz tr  0 0/ ],
   [ qw/sr  $  0 sl  $ 0/ ],
   [ qw/cl  0  0  0 cr 0/ ],
   [ qw/sl  $  0 sr  $ 0/ ],
   [ qw/ 0 bl hz br  0 0/ ],
];

my $simpleboard = [
   [ qw/ 0  1  1  1  0 0/ ],
   [ qw/ 1  1  0  1  1 0/ ],
   [ qw/ 1  0  0  0  1 0/ ],
   [ qw/ 1  1  0  1  1 0/ ],
   [ qw/ 0  1  1  1  0 0/ ],
];

grid_ok( $simplegrid, $simpleout, 'Simple Hex grid' );
board_ok( $simplegrid, $simpleboard, 'Simple Hex board' );

my $hexgrid = normalize_maze( <<'EOM' );
 __    __ 
/  \__/  \
\  /   __   \
/  \  /   __/
\  /  \__   \
/  \__   \  /
\  /   __/  \
/  \  /  \  /
\__   \__   \
   \__/  \  /

EOM

my $hexout = [
   [ qw/ 0 tl hz tr  0  0   0  tl hz tr  0  0  0   0  0/ ],
   [ qw/sr $  0  sl  $  0   sr $  0  sl  $  0  0   0  0/ ],
   [ qw/cl 0  0  0   yr hz  br 0  0  0  slb 0 slt  0  0/ ],
   [ qw/sl $  0  sr  $  0   0  0  0  0   0  0  sl  $  0/ ],
   [ qw/ 0 cr 0  cl  0  0   0  tl hz hzl 0  0  0   cr 0/ ],
   [ qw/sr $  0  sl  $  0   sr $  0  0   0  0  sr  $  0/ ],
   [ qw/cl 0  0  0   cr 0   cl 0  0  0  hzr hz yl  0  0/ ],
   [ qw/sl $  0  sr  $  0   sl $  0  0   0  0  sl  $  0/ ],
   [ qw/ 0 cr 0  cl  0  0   0  bl hz tr  0  0  0   cr 0/ ],
   [ qw/sr $  0  sl  $  0   0  0  0  sl  $  0  sr  $  0/ ],
   [ qw/cl 0  0  0   yr hz hzl 0  0  0   cr 0  cl  0  0/ ],
   [ qw/sl $  0  sr  $  0   0  0  0  sr  $  0  sl  $  0/ ],
   [ qw/ 0 cr 0  cl  0  0   0  tl hz yl  0  0  0   cr 0/ ],
   [ qw/sr $  0  sl  $  0   sr $  0  sl  $  0  sr  $  0/ ],
   [ qw/cl 0  0  0  slb 0   cl 0  0  0  slb 0  cl  0  0/ ],
   [ qw/sl $  0  0   0  0   sl $  0  0   0  0  sl  $  0/ ],
   [ qw/ 0 bl hz tr  0  0   0  yr hz tr  0  0  0   cr 0/ ],
   [ qw/ 0 0  0  sl  $  0   sr $  0  sl  $  0  sr  $  0/ ],
   [ qw/ 0 0  0  0   bl hz  br 0  0  0  slb 0 srb  0  0/ ],
];

my $hexboard = [
   [ qw/ 0 1  1  1   0  0   0  1  1  1   0  0  0   0 0/ ],
   [ qw/1  1  0  1   1  0   1  1  0  1   1  0  0   0 0/ ],
   [ qw/1  0  0  0   1  1   1  0  0  0   1  0  1   0 0/ ],
   [ qw/1  1  0  1   1  0   0  0  0  0   0  0  1   1 0/ ],
   [ qw/ 0 1  0  1   0  0   0  1  1   1  0  0  0   1 0/ ],
   [ qw/1  1  0  1   1  0   1  1  0  0   0  0  1   1 0/ ],
   [ qw/1  0  0  0   1  0   1  0  0  0   1  1  1   0 0/ ],
   [ qw/1  1  0  1   1  0   1  1  0  0   0  0  1   1 0/ ],
   [ qw/ 0 1  0  1   0  0   0  1  1  1   0  0  0   1 0/ ],
   [ qw/1  1  0  1   1  0   0  0  0  1   1  0  1   1 0/ ],
   [ qw/1  0  0  0   1  1   1  0  0  0   1  0  1   0 0/ ],
   [ qw/1  1  0  1   1  0   0  0  0  1   1  0  1   1 0/ ],
   [ qw/ 0 1  0  1   0  0   0  1  1  1   0  0  0   1 0/ ],
   [ qw/1  1  0  1   1  0   1  1  0  1   1  0  1   1 0/ ],
   [ qw/1  0  0  0   1  0   1  0  0  0   1  0  1   0 0/ ],
   [ qw/1  1  0  0   0  0   1  1  0  0   0  0  1   1 0/ ],
   [ qw/ 0 1  1  1   0  0   0  1  1  1   0  0  0   1 0/ ],
   [ qw/ 0 0  0  1   1  0   1  1  0  1   1  0  1   1 0/ ],
   [ qw/ 0 0  0  0   1  1   1  0  0  0   1  0  1   0 0/ ],
];

grid_ok( $hexgrid, $hexout, 'hexagon grid' );
board_ok( $hexgrid, $hexboard, 'hexagon board' );

eval { $maze->transform_grid( [ [ qw/| | | |/ ] ], 'straight' ) };
like( $@, qr/Missing block for '/, "Test non-xform of invalid grid." );

# Need more examples to be certain that I've covered all transforms.

# -----------------
# Subroutines

sub grid_ok
{
    my $grid = split_maze( shift );
    my $out = shift;
    my $msg = shift;

    is_deeply( [$maze->transform_grid( $grid, 'straight' )], $out, $msg );
}

sub board_ok
{
    my $grid = split_maze( shift );
    my $board = shift;
    my $msg = shift;

    my $rows = [$maze->transform_grid( $grid, 'straight' )];

    is_deeply( $maze->make_board_array( $rows), $board, $msg );
}