#!/usr/bin/perl -w
use strict;
# how do you play a perfect move?
# Well, if you can win, you win.
# Otherwise, if you can block the other player from winning, you do that.
# Otherwise, if the other player is doing the Fork of Death, you block them.
# Otherwise, if you can put the other player over a barrel, you do that.
# Otherwise, if you can keep the other player from putting you over a 
# barrel, you do that.
# Otherwise, if you can force the other player to make a move, you do that.
# Otherwise, you pick the best available space.
# That's not exactly what I ended up implementing, but it's close.

# Representation: '-', 'x', or 'o'.
# Moves are 1 through 9.  Board positions, confusingly, are 0 through 8.
# Computer plays second, so it's 'o'.

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

sub winner {
    my (@board) = @_;
    local $_;
    for (@rows) {
	my $xes = 0;
	my $oes = 0;
	for my $pos (@$_) {
	    $xes++ if $board[$pos] eq 'x';
	    $oes++ if $board[$pos] eq 'o';
	}
	return 'x' if $xes == 3;
	return 'o' if $oes == 3;
    }
    return undef;
}

sub winning_move {
    my ($player, @board) = @_;
    local $_;
    for (@rows) {
	my $marks = 0;
	my $blanks = 0;
	for my $pos (@$_) {
	    die "trying to find a winning move on @board; $pos undef" 
		if not defined $board[$pos];
	    $marks++ if $board[$pos] eq $player;
	    $blanks++ if $board[$pos] eq '-';
	}
	if ($marks == 2 and $blanks == 1) {
	    for my $pos (@$_) {
		if ($board[$pos] eq '-') {
		    # warn "winning move for $player\n";
		    return $pos + 1;
		}
	    }
	}
    }
    return undef;  # no winning move
}

sub fork_of_death_blocking_move {
	my (@board) = @_;
	if ("@board" eq "x - - - o - - - x" or
	    "@board" eq "- - x - o - x - -") {
		return 2;
	} else {
		return undef;
	}
}

# find a move that $player could use to force the other player to 
# move in at least $waysrequired ways.  You want to make sure the other 
# player can't force you to move in two ways, and you want to force them
# to move in one.
sub forcing_move {
    my ($player, $waysrequired, @board) = @_;
    local $_;
    # this array holds information about how many ways the other
    # player would have to play to block us from winning if we played
    # in a particular space.
    my @scores = (0) x 9;
    my $maxscore = 0;
    for (@rows) {
	my $marks = 0;
	my $blanks = 0;
	for my $pos (@$_) {
	    $marks++ if $board[$pos] eq $player;
	    $blanks++ if $board[$pos] eq '-';
	}
	if ($marks == 1 and $blanks == 2) {
	    for my $pos (@$_) {
		$scores[$pos]++ if $board[$pos] eq '-';
		$maxscore = $scores[$pos] if $scores[$pos] > $maxscore;
	    }
	}
    }

    return undef if $maxscore == 0 or $maxscore < $waysrequired;

    # OK, now we know how many ways $player can force the other player
    # to move by playing in any particular space.
    for (0..8) {
	if ($scores[$_] == $maxscore) {
	    # warn "forcing move $maxscore for $player\n";
	    return $_ + 1;
	}
    }
}

sub best_available {
    my @board = @_;
    local $_;
    for (4, 0, 2, 6, 8, 1, 3, 5, 7) {
	if ($board[$_] eq '-') {
	    # warn "best available is $_ + 1\n";
	    return $_ + 1;
	}
    }
    warn "no best-available move on a full board @board";
    return undef;
}

sub perfect_move {
    my ($player, $opponent, @board) = @_;
    return 
	winning_move ($player, @board) ||
	winning_move ($opponent, @board) ||
	fork_of_death_blocking_move(@board) ||
	forcing_move ($opponent, 2, @board) ||
	forcing_move ($player, 1, @board) ||
	best_available (@board);
}

sub print_board {
    my (@board) = @_;
    printf "%s%s%s\n%s%s%s\n%s%s%s\n", @board;
}

# This subroutine is really crappy, but that's OK --- it's just a 
# test-harness.
sub test1 {
    my @board = ('-') x 9;
    print "[1-9] ";
    $|=1;
    while (<STDIN>) {
	if ($_ < 1 or $_ > 9) {
	    print "Program can't understand $_";
	    next;
	}
	if ($board[$_-1] ne '-') {
	    print "Space $_ contains $board[$_-1] already\n";
	    next;
	}
	$board[$_-1] = 'x';

	if (my $winner = winner @board) {
	    print "$winner won\n";
	    last;
	}

	if ("@board" !~ /-/) {
	    print "cat's game\n";
	    last;
	}

	my $move = perfect_move 'o', 'x', @board;
	if (not defined $move or $move < 1 or $move > 9) {
	    die "broken move $move";
	}
	if ($board[$move-1] ne '-') {
	    die "program tried to play $move; already $board[$_-1] there\n";
	}
	$board[$move-1] = 'o';
	print_board @board;

	if (my $winner = winner @board) {
	    print "$winner won\n";
	    last;
	}

	if ("@board" !~ /-/) {
	    print "cat's game\n";
	    last;
	}

	print "[1-9] ";
    }
}

# I think it works.
# test1;

sub newpos {
    my @board = @_;
    if ("@board" !~ /-/ or winner @board) {
	return @board;  # game over
    }
    my $move = perfect_move 'o', 'x', @board;
    $board[$move-1] = 'o';
    return @board;
}

sub write_board_file {
    my @board = @_;
    my %spaces = (
		  'x' => 'ttt-x.png',
		  'o' => 'ttt-o.png',
		  '-' => 'ttt-blank.png',
		  );
    my $pos = join '', @board;
    my $fname = "ttt-$pos.html";
    open BOARD, ">$fname" or die "Can't open $fname: $!\n";

    my $headline;
    my $winner;
    if ($winner = winner @board) {
	$headline = "$winner won.";
    } elsif ($pos !~ /-/) {
	$headline = "Cat's game.";
    } else {
	$headline = "Your turn.";
    }
    
    print BOARD <<EOH;
<html><head><title>Tic-Tac-Toe position $pos -- $headline</title></head>
<body bgcolor=white background="ttt-bg.png">
<h1>$headline</h1>
<table border=0 cellpadding=0 cellspacing=0 align=center>
EOH
    local $_;
    for (0..8) {
	if ($_ % 3 == 0) {
	    print BOARD "<tr>\n";
	}
	print BOARD "<td>";
	if ($board[$_] eq '-' and not defined $winner) {
	    $board[$_] = 'x';  # temporarily
	    $pos = join '', newpos @board;
	    $board[$_] = '-';
	    print BOARD qq(<a href="ttt-$pos.html">),
	          qq(<img src="$spaces{$board[$_]}" height=50 width=50),
	          qq( border=0 alt="$board[$_]"></a>);
	} else {
	    print BOARD qq(<img src="$spaces{$board[$_]}" height=50 width=50),
	          qq( border=0 alt="$board[$_]"></a>);
	}
	print BOARD "</td>\n";
    }
    print BOARD "</table></body></html>\n";
    close BOARD;
}

sub test2 {
    local $_;
    for ([qw(x o o - o x x o x)], 
	 [qw(x o x o x o o x o)],
	 [qw(x - - - o - - - -)]) {
	write_board_file @$_;
    }
}

# test2;

# run all possible human moves
sub human_move {
    my @board = @_;
    write_board_file @board;
    return if "@board" !~ /-/ or winner @board;
    local $_;
    for (0..8) {
	if ($board[$_] eq '-') {
	    $board[$_] = 'x';
	    human_move (newpos @board);
	    $board[$_] = '-';
	}
    }
}

human_move (('-') x 9);