#! /usr/bin/perl

# noughts-and-crosses
# A silly little noughts and crosses game.
# (In USA, you might call it tic tac toe or something like that)

# Copyright (C) 2005  Nick Urbanik <nicku@nicku.org>

# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.

# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.

# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.

use warnings;
use strict;

use Term::ReadKey;
use Term::ANSIColor;
use Getopt::Long;

# Aim to make it possible to easily make it to a 4x4 grid:

use constant NOUGHT => 'o';
use constant CROSS  => 'x';
use constant EMPTY  => ' ';
use constant ROW_LENGTH => 3;
use constant CENTRE => 4;
use constant GRIDLEN => 9;
use constant DEBUG => 0;
use constant X_COLOUR => "green";
use constant O_COLOUR => "red";
use constant MAX_CLEVER => 100;

# Indexes into @grid correspond to these locations:
# 0 |1| 2
# --+-+--
# 3 |4| 5
# --+-+--
# 6 |7| 8

my @rows = (
            [ 0, 1, 2 ],
            [ 3, 4, 5 ],
            [ 6, 7, 8 ],
            [ 0, 3, 6 ],
            [ 1, 4, 7 ],
            [ 2, 5, 8 ],
            [ 0, 4, 8 ],
            [ 2, 4, 6 ]
           );
my @corners = ( 0, 2, 6, 8 );

sub print_o_or_x($) {
    my ( $o_or_x ) = @_;
    if ( $o_or_x eq CROSS ) {
        return color(X_COLOUR) . CROSS . color("reset");
    } elsif ( $o_or_x eq NOUGHT ) {
        return color(O_COLOUR) . NOUGHT . color("reset");
    } else {
        return $o_or_x;
    }
}

sub print_grid(\@) {
    my ( $grid ) = @_;
    print << "END";
1 |2| 3\t\t    @{[print_o_or_x $grid->[0]]} |@{[print_o_or_x $grid->[1]]}| @{[print_o_or_x $grid->[2]]}
--+-+--\t\t    --+-+--
4 |5| 6\t\t    @{[print_o_or_x $grid->[3]]} |@{[print_o_or_x $grid->[4]]}| @{[print_o_or_x $grid->[5]]}
--+-+--\t\t    --+-+--
7 |8| 9\t\t    @{[print_o_or_x $grid->[6]]} |@{[print_o_or_x $grid->[7]]}| @{[print_o_or_x $grid->[8]]}

END
}

sub choose_o_or_x() {
    print "Are you ", print_o_or_x NOUGHT, " or ", print_o_or_x CROSS, "?\n";
    my $human_is;
    do {
        ReadMode 'cbreak';
        $human_is = ReadKey 0;
        ReadMode 'normal';
    } while ( not $human_is or $human_is ne 'x' and $human_is ne 'o' );
    print "Okay you are ", $human_is eq 'x' ? color(X_COLOUR) . "crosses" : color(O_COLOUR) . "naughts", color("reset"), "\n";
    return $human_is;
}

sub choose_human_or_computer() {
    print "Should you or the computer play? ",
        color('red'), "y", color('reset'), " or ",
        color('red'), "c", color('reset'), ":\n";
    my $human_or_computer;
    do {
        ReadMode 'cbreak';
        $human_or_computer = ReadKey( 0 );
        ReadMode 'normal';
    } while ( not $human_or_computer
              or $human_or_computer ne 'y' and $human_or_computer ne 'c' );
    if ( $human_or_computer eq 'c' ) {
        print "I'm just playing myself! \n" if $human_or_computer eq 'c';
        return;
    } else {
        print "Okay, I'm playing against you.\n";
    }
    return choose_o_or_x;
}

sub get_humans_choice(\@) {
    my ( $grid ) = @_;
    print "Press number key for where you want to go [1-9]:\n";
    my $pos;
    do {
        ReadMode 'cbreak';
        $pos = ReadKey 0;
        ReadMode 'normal';
    } while ( $pos !~ /^[0-9]$/ or $grid->[ $pos - 1 ] ne EMPTY );
    return $pos - 1;
}

sub Continue() {
    print color('red'), "q", color('reset'),
        " to quit, any other key to play again:\n";
    my $quit;
    ReadMode 'cbreak';
    $quit = ReadKey 0;
    ReadMode 'normal';
    if ( lc $quit eq 'q' ) {
        print "You want me to quit, okay.\n";
        sleep 2;
        exit;
    }
}


# parameter $row is an array of length ROW_LENGTH, each element of which
# is either NOUGHT, CROSS or EMPTY
# Returns an array giving a count of the number of:
# NOUGHTs, CROSSes and EMPTYs in that row.
sub count_in_row(@) {
    my ( @row ) = @_;
    my $noughts = grep { $_ eq NOUGHT } @row;
    my $crosses = grep { $_ eq CROSS  } @row;
    my $empty   = grep { $_ eq EMPTY  } @row;
    return ( $noughts, $crosses, $empty );
}

# parameter @row is an array of length ROW_LENGTH, each element of which
# is either NOUGHT, CROSS or EMPTY
# Returns CROSS if crosses have won in this particular row,
# NOUGHT if noughts have won in this particular row,
# false otherwise.
sub won(@) {
    my ( @row ) = @_;
    my ( $noughts, $crosses, $empty ) = count_in_row @row;
    return NOUGHT if $noughts == ROW_LENGTH;
    return CROSS  if $crosses == ROW_LENGTH;
}

# parameter @row is an array of length ROW_LENGTH, each element of which
# is either NOUGHT, CROSS or EMPTY
# Returns: CROSS if crosses have nearly won in this particular row,
#         NOUGHT if noughts have nearly won in this particular row,
#         false otherwise.

sub nearly_won(@) {
    my ( @row ) = @_;
    my ( $noughts, $crosses, $empty ) = count_in_row @row;
    return "" unless $empty == 1;
    return NOUGHT if $noughts == ROW_LENGTH - 1;
    return CROSS  if $crosses == ROW_LENGTH - 1;
    return "";
}

# parameter $rows is an array of indexes into all the rows in the game board.
# See the definition above.  Used to take slices of the game board.
# Returns: CROSS if crosses have won the game,
#         NOUGHT if noughts have won the game,
#         false otherwise.

sub have_winner(\@\@) {
    my ( $rows, $grid ) = @_;
    foreach my $row ( @$rows ) {
        my $winner = won @$grid[ @$row ];
        return $winner if $winner;
    }
    return "";
}

# return the opposite to the parameter.
# Parameter only checked if it is a NOUGHT; not checked otherwise.
sub opponent($) {
    return $_[0] eq NOUGHT ? CROSS : NOUGHT;
}

{
    # If noughts goes into one of the four middle places on a side as the
    # first move, then crosses can force a win.
    # This implements that strategy when noughts makes that first move.
    # Every time, crosses must win.  Here are some pictures showing the idea:

    #   | |    x | |    x | |    x | | x  x |o| x  x |o| x
    # --+-+--  --+-+--  --+-+--  --+-+--  --+-+--  --+-+--
    # o |x|    o |x|    o |x|    o |x|    o |x|    o |x|
    # --+-+--  --+-+--  --+-+--  --+-+--  --+-+--  --+-+--
    #   | |      | |      | | o    | | o    | | o  x | | o

    # Notice that x creates a "fork" where there are two ways of
    # winning a row.  Noughts has every move forced.

    # This data structure shows, given the location where noughts
    # goes first, the second and third locations where crosses goes
    # to implement one version of the strategy above.
    my %adjacent_corners =
        (
         1 => [ 2, 8 ],
         3 => [ 0, 2 ],
         5 => [ 8, 6 ],
         7 => [ 6, 0 ]
        );
    # $nought_pos is the first position of the nought.
    # $step is the number of steps into the scenario.
    my $nought_pos;
    my $step;

    # This checks whether we are in the state where noughts is vulnerable.
    # Either already in progress in the scenario, or:
    # We have: 1 nought on the game board;
    #          a cross in the centre;
    # the nought is in one of the four positions in the middle of a side.
    sub o_vulnerable(\@) {
        my ( $grid ) = @_;
        print "\$step = $step\n" if defined $step and DEBUG;
        return 1 if $step;
        return unless scalar ( grep { $_ eq NOUGHT } @$grid ) == 1;
        print "Have one nought\n" if DEBUG;
        return unless $grid->[ CENTRE ] eq CROSS;
        print "have x in centre\n" if DEBUG;
        foreach my $side ( keys %adjacent_corners ) {
            if ( $grid->[ $side ] eq NOUGHT ) {
                ++$step;
                $nought_pos = $side;
                return 1;
            }
        }
        return;
    }

    # If we are implementing the fork, we simply determine the next place
    # crosses should go to implement the scenario and defeat those silly
    # noughts.
    sub implement_fork() {
        print "\$step = $step, $nought_pos = $nought_pos, ",
            "\$adjacent_corners{$nought_pos}->[ $step - 1 ] = ",
                "$adjacent_corners{$nought_pos}->[ $step - 1]\n" if DEBUG;
        return $adjacent_corners{$nought_pos}->[ $step++ - 1 ];
    }

    # We must initialise the "static" variables when we start a game.
    sub init() {
        $nought_pos = $step = undef;
    }
}

# Return index into game board of where should go next given:
# $i_am is either NOUGHT or CROSS
# $rows is an array of indexes that are rows
# $grid is the game board.

sub choose_go($\@\@$) {
    my ( $i_am, $rows, $grid, $cleverness ) = @_;
    # See if we can win:
    if ( rand MAX_CLEVER <= $cleverness ) {
        foreach my $row ( @$rows ) {
            if ( $i_am eq nearly_won( @$grid[ @$row ] ) ) {
                for ( my $i = 0; $i < ROW_LENGTH; ++$i ) {
                    return $row->[$i] if $grid->[ $row->[$i] ] eq EMPTY;
                }
            } 
        }
    }
    if ( rand MAX_CLEVER <= $cleverness ) {
        print "Going for stopping other:\n" if DEBUG;
        # else stop the other side from winning:
        foreach my $row ( @$rows ) {
            if ( opponent $i_am eq nearly_won( @$grid[ @$row ] ) ) {
                for ( my $i = 0; $i < ROW_LENGTH; ++$i ) {
                    return $row->[$i] if $grid->[ $row->[$i] ] eq EMPTY;
                }
            } 
        }
    }
    if ( rand MAX_CLEVER <= $cleverness ) {
        print "Going for centre:\n" if DEBUG;
        # else go in the centre if available:
        return CENTRE if $grid->[ CENTRE ] eq EMPTY;
    }
    return implement_fork if o_vulnerable @$grid
      and rand MAX_CLEVER <= $cleverness;
    if ( rand MAX_CLEVER <= $cleverness ) {
        # else go in the first available corner:
        print "Going for first corner:\n" if DEBUG;
        foreach my $corner ( @corners ) {
            return $corner if $grid->[ $corner ] eq EMPTY;
        }
    }
    # else return first available space:
    print "Going for first available space:\n" if DEBUG;
    for ( my $i = 0; $i < @$grid; ++$i ) {
        return $i if $grid->[ $i ] eq EMPTY;
    }
    # else game is over:
    return;
}

use File::Basename;

sub usage() {
    my $prog = basename $0;
    print << "USAGE";
Usage: $prog [--cleverness=N]
where N is an integer between 0 and @{[MAX_CLEVER]} inclusive.
Parts of the strategy are randomly disabled when N < 100.
USAGE
    exit 1;
}

my $cleverness = MAX_CLEVER;
GetOptions(
           "cleverness=i" => \$cleverness
          ) or usage;

usage unless $cleverness >= 0 and $cleverness <= MAX_CLEVER;

do {
    my @grid = ( EMPTY ) x GRIDLEN;
    my $winner;
    
    my $go = CROSS;
    my $humans_o_or_x = choose_human_or_computer;
    my $place;
    my $turn_number;
    init;
    do {
        if ( $humans_o_or_x and $go eq $humans_o_or_x ) {
            print_grid @grid;
            $place = get_humans_choice @grid;
        } else {
            $place = choose_go $go, @rows, @grid, $cleverness;
        }
        print "\$place = $place.\n" if defined $place and DEBUG;
        $grid[ $place ] = $go if defined $place;
        $winner = have_winner @rows, @grid;
        $go = opponent $go;
        print_grid @grid if not $humans_o_or_x and $go eq CROSS;
    } while ( not $winner and defined $place and ++$turn_number < 9);
    
    print_grid @grid;
    
    # This is to satisfy the requirements set by my five year old son
    # about colour schemes that depend on who won:
    my @o_colours = qw( yellow magenta green );
    my @x_xolours = qw( yellow magenta red );
    if ( $winner ) {
        my @c = $winner eq CROSS ? @x_xolours : @o_colours;
        print color($c[0]), "The ", color($c[1]), "winner",
            color($c[2]), " is ",  print_o_or_x $winner, "!\n";
    } else {
        print color('dark blue'), "It's a draw!\n", color('reset');
    }
    
    # Pause so need press a key before window closes,
    # or continue with a new game
    Continue;
} while ( 1 );