#!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 ); }