# GENERATE THE BOARD
my @board = shuffle 1 .. 15;
splice @board, int rand 16, 0, 0;

##</code><code>##

use 5.18.3;
use warnings;
#se Data::Peek;
use List::Util qw( shuffle first );
use Term::TransKeys;

say <<"INTRO";

Welcome to the 15 puzzle!

Use an arrow key to move a block into the empty position.
You're trying to reach either of these two positions:

   01 02 03     01 02 03 04
04 05 06 07     05 06 07 08
08 09 10 11     09 10 11 12
12 13 14 15     13 14 15

^C to stop.
INTRO

# GENERATE THE BOARD
my @board = shuffle 1 .. 15;
splice @board, int rand 16, 0, 0;

# PLAY THE GAME
sub printboard {
    for (my $start = 0; $start < 16; $start += 4) {
        say join " " => map { sprintf ("%02d", $_) =~ s/00/  /r }
            @board[$start .. ($start + 3)];
        }
    say "";
    } # printboard

say "The starting position is:";
printboard ();

my $listener = Term::TransKeys->new;

my %ok = map {( "@$_" => 1 )} [0 .. 15], [1 .. 15, 0];

my %keys = map { $_ => 1 } qw( <UP> <DOWN> <RIGHT> <LEFT> <CONTROL+C> );
while (1) {
    defined (my $key = $listener->TransKey) or redo;
    #DPeek $key;
    $keys{$key} or redo;
    $key eq "<CONTROL+C>" and do { warn "Have a great day!\n"; exit 0; };

    if ($key eq "<UP>"    and grep { !$_ } @board[12 .. 15]) {
        print "You can't move up. The empty space is at the bottom.";
        next;
        }
    if ($key eq "<DOWN>"  and grep { !$_ } @board[ 0 ..  3]) {
        print "You can't move down. The empty space is at the top.";
        next;
        }
    if ($key eq "<RIGHT>" and grep { !$_ } @board[0, 4,  8, 12]) {
        print "You can't move right. The empty space is at the left.";
        next;
        }
    if ($key eq "<LEFT>"  and grep { !$_ } @board[3, 7, 11, 15]) {
        print "You can't move left. The empty space is at the right.";
        next;
        }

    my $zero = first { !$board[$_] } 0..15;
    $key eq "<UP>"    and @board =
        @board[0 .. ($zero - 1), $zero + 4, ($zero + 1) .. ($zero + 3), $zero, ($zero + 5) .. 15 ];
    $key eq "<DOWN>"  and @board =
        @board[0 .. ($zero - 5), $zero, ($zero - 3) .. ($zero - 1), $zero - 4, ($zero + 1) .. 15 ];
    $key eq "<RIGHT>" and @board =
        @board[0 .. ($zero - 2), $zero, $zero - 1, ($zero + 1) .. 15];
    $key eq "<LEFT>"  and @board =
        @board[0 .. ($zero - 1), $zero + 1, $zero, ($zero + 2) .. 15];

    printboard ();
    $ok{"@board"} and last;
    }

say "You've solved it!"