use strict;
use warnings;

my $board = [
  'A', 'B', 'B', 'C',
  'A', 'B', 'B', 'C',
   '', 'D', 'D',  '',
  'E', 'G', 'I', 'F',
  'E', 'H', 'J', 'F',
];

display_board( $board );
while (1)
{
    my ($piece, $move) = get_move();
    make_move( $board, $piece, $move );
    display_board( $board );
}

######################################################################
+##########

sub get_move
{
    my ($piece, $move);
    GET_MOVE: {
        print "Move: ";
        chomp( my $temp = <> );
        $temp = uc $temp;
        exit if $temp =~ /Q/;

        ($piece, $move) = $temp =~ /^([A-J])(\d+)$/;

        redo GET_MOVE unless defined $piece && defined $move;
    }

     return( $piece, $move );
}

use constant NORTH => -4;
use constant EAST  => +1;
use constant SOUTH => +4;
use constant WEST  => -1;

sub make_move
{
    my ($board, $piece, $move) = @_;

    # Is the spot we're moving to empty?
    return if $board->[$move];

    # Find the spots occupied by the piece
    my @piece = grep { $piece eq $board->[$_] } 0 .. $#$board;

    # Is the spot we're moving to next to the piece?
    my $next_to;
    my $check;
    foreach my $x (@piece)
    {
        $next_to = EAST  if $move == $x + EAST;
        $next_to = WEST  if $move == $x + WEST;
        $next_to = NORTH if $move == $x + NORTH;
        $next_to = SOUTH if $move == $x + SOUTH;

        $check = $x;
        last if $next_to;
    }
    return unless $next_to;

    if ( $next_to == NORTH || $next_to == SOUTH )
    {
        if ($board->[$check+1] eq $board->[$check])
        {
            return if $board->[$check+1+$next_to];
        }
        elsif ($board->[$check-1] eq $board->[$check])
        {
            return if $board->[$check-1+$next_to];
        }
    }
    else
    {
        if ($board->[$check + 4] eq $board->[$check])
        {
            return if $board->[$check+4+$next_to];
        }
        elsif ($board->[$check - 4] eq $board->[$check])
        {
            return if $board->[$check-4+$next_to];
        }
    }

    # Make the move!
    if ( $next_to == SOUTH || $next_to == EAST )
    {
        foreach my $i (sort { $b <=> $a } @piece)
        {
            @{$board}[$i, $i+$next_to] = @{$board}[$i+$next_to, $i];
        }
    }
    else
    {
        foreach my $i (sort { $a <=> $b } @piece)
        {
            @{$board}[$i, $i+$next_to] = @{$board}[$i+$next_to, $i];
        }
    }

    return 1;
}

sub display_board
{
    my ($board) = @_;

    print "    0 1 2 3\n";
    my $x = '0';

    my @x = @$board;
    while (@x)
    {
        my @row = splice @x, 0, 4;
        $_ ||= ' ' for @row;
        $x = sprintf("%02d", $x);
        print "$x| @row |$x\n";
        $x+=4;
    }

    print "    0 1 2 3\n";
}
[download]