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"; }