Perl6: a simple implementation of the game "Connect 4!"

This is my first non-trivial program in Perl6. I had been experimenting with the Microsoft Winter Scripting Games to get a feel for the language using Rakudo (version 34768 : Dec 31, 2008), but wanted something a little less trivial. At about the same time, I was playing with my new Tivo, and found a game there that it calls "Skulls and Bones" -- but which I have always known as "Connect 4"

The goal of that game is to create a line of 4 of your tokens before you opponent does. The board is 7x7 on a vertical plane: you play in one of the seven columns, and the counter comes to rest in the lowest available row of that column.

I started by writing a simple computer player. Nothing hi-tech: it simply selects a random move from a set that it winnow down by looking ahead one or two moves to see if it can win or if it can prevent its opponent from winning. It started out as a procedural script, but then I refactored it to use P6 classes -- and enable different "Player" subclasses that have different strategies: one such subclass uses the strategy: ask the user.

The conversion of the code to html was done using vim with Luke Palmer's perl-6 syntax highlighting module


class Player {
    method token { ... }
    method highlighter_token { ... }

    method get_move( Game $game ) { ... }
}

class HumanPlayer is Player {
    has Str $.token;
    has Str $.highlighter_token;

    method get_move( Game $game ) {

        my @legal_moves = $game.legal_moves( self );

        loop {
            say "Enter column number for {$.token} to play:";
            my $user_input = =$*IN;
            if @legal_moves.first: { .column == $user_input-1 } -> $move {
                return $move;
            }
            else {
                say "move must be a legal (not full) column number"
            }
        }

    }
}

class ComputerPlayer is Player {

    has Str $.token;
    has Str $.highlighter_token;

    has Int $.look_ahead;

    method get_move_choices ( Game $game, $debug = 1 ) {
        my @legal_moves = $game.legal_moves( self );

        if $.look_ahead > 0 && @legal_moves.grep: { .is_winning_move } -> @winning_moves {
            say "'$.token' has winning moves: {@winning_moves.map({.column + 1})}" if $debug > 0;
            return @winning_moves;
        }
        elsif $.look_ahead > 1 && @legal_moves.grep: { ! .gives_opponent_a_winning_move } -> @ok_moves {
            if $.look_ahead > 2 && @ok_moves.grep: { .gives_opponent_only_losing_moves } -> @better_moves {
                say "'$.token' likes to play one of {@better_moves.map({.column + 1})}" if $debug > 0;
                return @better_moves;
            }
            else {
                say "'$.token' should play one of {@ok_moves.map({.column + 1})}" if $debug > 0;
                return @ok_moves;
            }
        }
        else {
            say "'$.token' has no move preference" if $debug > 0;
            return @legal_moves;
        }
    }

    method get_move( Game $game ) {
        my Move $where = | self.get_move_choices($game).pick();
    }
}

class Game {
    has Str @board;
    has Int @current_levels;

    has @.player_types;

    has Player @players;

    method clear_board() {
        if @.player_types.elems != 2 {
            die "invalid game spec: {@.player_types} -- expencted list of two elems, each is either strength or 'H' for human";
        }
        @players = ();

        if @.player_types[0] eq "H" {
            @players.push: HumanPlayer.new( token => "X", highlighter_token => "*" )
        }
        else {
            @players.push: ComputerPlayer.new( token => "X", highlighter_token => "*", look_ahead => @.player_types[0] )
        }

        if @.player_types[1] eq "H" {
            @players.push: HumanPlayer.new( token => "O", highlighter_token => "@" )
        }
        else {
            @players.push: ComputerPlayer.new( token => "O", highlighter_token => "@", look_ahead => @.player_types[1] )
        }

        @board = (^7).map({[ "" xx 7 ]});
        @current_levels = 0 xx 7;
    }

    method other_player( Player $who ) {
        @players.first: { $_ !=== $who };
    }

    method next_available_row_of_column( Int $column ) {
        if (@board[6][$column]) {
            die "illegal move: $column";
        }
        return @current_levels[$column];
    }

    multi method set_board_state( Move $move ;; $value = $move.who.token ) {
        @board[$move.row][$move.column] = $value;
    }

    multi method set_board_state( Int $row, Int $column ;; $value ) {
        @board[$row][$column] = $value
    }

    method play_move( Move $move ) {
        self.set_board_state: $move;
        ++@current_levels[$move.column];
    }

    method undo_move( Move $move ) {
        self.set_board_state: $move, "";
        --@current_levels[$move.column];
    }

    method scan_for_win( Move $move, $fn ) {

        my $token = $move.who.token;
        my $column = $move.column;
        my $row = $move.row;

        for -1, 0, +1 -> $diag {
            my @winning_points;
            for -1, +1 -> $left_right {
                for 1 .. 3 -> $delta_x {
                    my $x = $column + ( $delta_x * $left_right );
                    my $y = $row + ( $delta_x * $left_right * $diag );
                    last unless 0 <= $x <= 6;
                    last unless 0 <= $y <= 6;
                    last unless @board[$y][$x] eq $token;
                    push @winning_points, [$y, $x];
                }
            }
            $fn( @winning_points ) if @winning_points >= 3;
        }

        if $row > 2 {
            my @winning_points = (1..3).map: -> $delta_y { [$row - $delta_y, $column] };
            for @winning_points -> @p {
                # TODO: @board[ [;] @p ] eq $token
                my ($y, $x);
                ($y, $x) = @p;
                return unless @board[$y][$x] eq $token;
            }
            $fn( @winning_points );
        }
    }

    method highlight_position( Move $move, *@points ) {
        self.set_board_state: $move, "#";
        my $token = $move.who.highlighter_token;
        for @points -> @p { self.set_board_state: |@p, $token }
    }

    method display {
        say (1..7).join("   ");
        .map({ $_ || "-" }).join(" | ").say for reverse @board;
    }


    method legal_moves (Player $who) {
        my @moves;
        for ^7 -> $column {
            push @moves, Move.new( game => self, who => $who, column => int $column) unless @board[6][int $column];
        }
        return @moves;
    }

    method play_game {
        self.clear_board;
        self.display;

        for ^49 -> $move_num {
            my $who = @players[ int( $move_num % 2 ) ];
            my Move $where = $who.get_move( self );
            my $win = $where.is_winning_move;
            say "";
            $where.play;
            self.display;
            if $win {
                say "{$who.token} WINS on move { int($move_num/2) + 1 }!";
                return;
            }
        }
        say "DRAW"
    }
}

class Move {
    has Game $.game;

    has Player $.who;
    has Int $.column;
    has Int $!row;
    has Player $!other;

    method row () {
        $!row = $.game.next_available_row_of_column( $.column ) unless defined $!row;
        return $!row
    };

    method perl () { "Move( :who<{$.who.token}> :col<$.column> :row<$.row> )" };

    method opponent() {
        unless defined $!other {
            $!other = $.game.other_player( $.who );
        }
        return $!other;
    }

    method mark_winning_move( ) {
        $.game.scan_for_win: self, -> @points {
            $.game.highlight_position( self, @points );
        }
    }

    method play() {
        say "play '{$.who.token}' -> {$.column+1}";
        self.game.play_move( self );
        self.mark_winning_move;
    }

    method play_hypothetical() {
        self.game.play_move( self )
    }

    method undo() {
        self.game.undo_move( self )
    }

    method is_winning_move() {
        my $win = False;
        $.game.scan_for_win: self, { $win = True };
        return $win;
    }

    method gives_opponent_a_winning_move() {
        self.play_hypothetical;

        my @legal_moves = self.game.legal_moves( $.opponent );
        my $other_wins = ? @legal_moves.grep: { .is_winning_move };

        self.undo;

        return $other_wins;
    }

    method gives_opponent_only_losing_moves() {

        self.play_hypothetical;

        my @legal_moves = self.game.legal_moves( $.opponent );
        my @other_losing_moves = @legal_moves.grep: { .gives_opponent_a_winning_move };

        self.undo;

        return @other_losing_moves == @legal_moves;
    }
}

my Game $game.=new( player_types => ( "H", 2 ) );
$game.play_game;

Example Game

1   2   3   4   5   6   7
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | - | - | - | - | -
Enter column number for X to play:
3

play 'X' -> 3
1   2   3   4   5   6   7
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | X | - | - | - | -
'O' should play one of 1 2 3 4 5 6 7

play 'O' -> 5
1   2   3   4   5   6   7
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | X | - | O | - | -
Enter column number for X to play:
5

play 'X' -> 5
1   2   3   4   5   6   7
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | - | - | X | - | -
- | - | X | - | O | - | -
'O' should play one of 1 2 3 4 5 6 7

play 'O' -> 6
1   2   3   4   5   6   7
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | - | - | X | - | -
- | - | X | - | O | O | -
Enter column number for X to play:
3

play 'X' -> 3
1   2   3   4   5   6   7
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | X | - | X | - | -
- | - | X | - | O | O | -
'O' should play one of 1 2 3 4 5 6 7

play 'O' -> 4
1   2   3   4   5   6   7
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | X | - | X | - | -
- | - | X | O | O | O | -
Enter column number for X to play:
7

play 'X' -> 7
1   2   3   4   5   6   7
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | X | - | X | - | -
- | - | X | O | O | O | X
'O' should play one of 1 2 3 4 5 6 7

play 'O' -> 1
1   2   3   4   5   6   7
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | X | - | X | - | -
O | - | X | O | O | O | X
Enter column number for X to play:
6

play 'X' -> 6
1   2   3   4   5   6   7
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | X | - | X | X | -
O | - | X | O | O | O | X
'O' should play one of 4

play 'O' -> 4
1   2   3   4   5   6   7
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | X | O | X | X | -
O | - | X | O | O | O | X
Enter column number for X to play:
5

play 'X' -> 5
1   2   3   4   5   6   7
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | - | - | X | - | -
- | - | X | O | X | X | -
O | - | X | O | O | O | X
'O' should play one of 1 2 3 5 6 7

play 'O' -> 7
1   2   3   4   5   6   7
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | - | - | X | - | -
- | - | X | O | X | X | O
O | - | X | O | O | O | X
Enter column number for X to play:
3

play 'X' -> 3
1   2   3   4   5   6   7
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | X | - | X | - | -
- | - | X | O | X | X | O
O | - | X | O | O | O | X
'O' should play one of 3

play 'O' -> 3
1   2   3   4   5   6   7
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | O | - | - | - | -
- | - | X | - | X | - | -
- | - | X | O | X | X | O
O | - | X | O | O | O | X
Enter column number for X to play:
4

play 'X' -> 4
1   2   3   4   5   6   7
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | O | - | - | - | -
- | - | X | X | X | - | -
- | - | X | O | X | X | O
O | - | X | O | O | O | X
'O' has no move preference

play 'O' -> 7
1   2   3   4   5   6   7
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | O | - | - | - | -
- | - | X | X | X | - | O
- | - | X | O | X | X | O
O | - | X | O | O | O | X
Enter column number for X to play:
4

play 'X' -> 4
1   2   3   4   5   6   7
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | - | - | - | - | -
- | - | O | # | - | - | -
- | - | X | X | * | - | O
- | - | X | O | X | * | O
O | - | X | O | O | O | *
X WINS on move 9!



home