use strict;
use warnings;
use List::Util 'shuffle';
use Term::TransKeys;

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

$\=$/;

# INTRO

print for(
  '',
  'Welcome to the 15 puzzle!',
  '',
  'Use an arrow key to move a block into the empty position.',
  "You're trying to reach the position:",
  '   01 02 03',
  '04 05 06 07',
  '08 09 10 11',
  '12 13 14 15',
  '',
  '^C to kill.',
  ''
);

# GENERATE THE BOARD

my @board;
my $inversions;
GEN:
@board = (0, shuffle(1..15));
# @board = (1,0,2..15); # for testing
$inversions = 0;
for my $a(1..15) {
  for my $b(1..15) {
    ++$inversions if($a<$b and $board[$a]>$board[$b])
  }
}
goto GEN if $inversions % 2;

# PLAY THE GAME

sub printboard {
  print join ' ', map {s/^00$/  /r} map {sprintf '%02d', $_} @board[0.
+.3];
  print join ' ', map {s/^00$/  /r} map {sprintf '%02d', $_} @board[4.
+.7];
  print join ' ', map {s/^00$/  /r} map {sprintf '%02d', $_} @board[8.
+.11];
  print join ' ', map {s/^00$/  /r} map {sprintf '%02d', $_} @board[12
+..15];
  print '';
}

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

my %keys;
$keys{$_} = 1 for qw/<UP> <DOWN> <RIGHT> <LEFT> <CONTROL+C>/;

my $solved;
while(!$solved){
  my $key;
  while(not defined($key = $listener->TransKey())){sleep 1}
  next unless $keys{$key};
  die "Have a great day!$/" if $key eq '<CONTROL+C>';
  if ($key eq '<UP>'    and grep {$_==0} @board[12..15]   ) {print "Yo
+u can't move up. The empty space is at the bottom."; next}
  if ($key eq '<DOWN>'  and grep {$_==0} @board[0..3]     ) {print "Yo
+u can't move down. The empty space is at the top."; next}
  if ($key eq '<RIGHT>' and grep {$_==0} @board[0,4,8,12] ) {print "Yo
+u can't move right. The empty space is at the left."; next}
  if ($key eq '<LEFT>'  and grep {$_==0} @board[3,7,11,15]) {print "Yo
+u can't move left. The empty space is at the right."; next}
  my ($zero) = (grep {$board[$_]==0} 0..15);
  if ($key eq '<UP>'    ){ @board = (@board[0..$zero-1, $zero+4, $zero
++1..$zero+3, $zero, $zero+5..15]) };
  if ($key eq '<DOWN>'  ){ @board = (@board[0..$zero-5, $zero, $zero-3
+..$zero-1, $zero-4, $zero+1..15]) };
  if ($key eq '<RIGHT>' ){ @board = (@board[0..$zero-2, $zero, $zero-1
+, $zero+1..15]) };
  if ($key eq '<LEFT>'  ){ @board = (@board[0..$zero-1, $zero+1, $zero
+, $zero+2..15]) };
  $solved = 1 if 16 == grep {$board[$_]==$_} 0..15;
  printboard();
}

print "You've solved it!"
[download]