unit TicTacF;
//*******************************************************
// Example program demonstrating game tree searching.
//*******************************************************
// Copyright (C) 1998 John Wiley & Sons, Inc.
// All rights reserved. See additional copyright
// information in Readme.txt.
//*******************************************************

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, StdCtrls, ExtCtrls;

const
    NUM_SQUARES = 9;
    NUM_PATTERNS = 10;
    
type
  TPlayer = (plHuman, plComputer, plNone, plDraw);
  TBoardValue = (bvTooSmall,            // Smaller than possible.
      bvLose, bvDraw, bvUnknown, bvWin, // Real values.
      bvTooBig);                        // Bigger than possible.

  TTicTacForm = class(TForm)
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Options1: TMenuItem;
    Help1: TMenuItem;
    mnuExit: TMenuItem;
    mnuPlayX: TMenuItem;
    mnuPlayO: TMenuItem;
    N1: TMenuItem;
    mnuLevel1: TMenuItem;
    mnuLevel2: TMenuItem;
    mnuLevel4: TMenuItem;
    mnuLevel5: TMenuItem;
    mnuLevel6: TMenuItem;
    mnuLevel7: TMenuItem;
    mnuLevel8: TMenuItem;
    mnuLevel9: TMenuItem;
    mnuAbout: TMenuItem;
    Panel1: TPanel;
    Square1: TImage;
    Panel2: TPanel;
    Square4: TImage;
    Panel3: TPanel;
    Square7: TImage;
    Panel4: TPanel;
    Square2: TImage;
    Panel5: TPanel;
    Square5: TImage;
    Panel6: TPanel;
    Square8: TImage;
    Panel7: TPanel;
    Square3: TImage;
    Panel8: TPanel;
    Square6: TImage;
    Panel9: TPanel;
    Square9: TImage;
    MsgLabel: TLabel;
    mnuLevel3: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure mnuAboutClick(Sender: TObject);
    procedure mnuExitClick(Sender: TObject);
    procedure TakeSquare(sq : Integer);
    procedure DrawSquare(sq : Integer);
    function GameOver : Boolean;
    procedure PlayerHasMoved;
    procedure MakeHumanMove;
    procedure MakeComputerMove;
    procedure PickComputerMove;
    procedure BoardValue(var best_move : Integer; var best_value : TBoardValue; player1, player2 : TPlayer; depth : Integer);
    function Winner : TPlayer;
    procedure StartNewGame;
    procedure mnuLevelClick(Sender: TObject);
    procedure SquareClick(Sender: TObject);
    function SelectedLevel(Sender : TObject) : Integer;
    function SelectedSquare(Sender : TObject) : Integer;
    procedure mnuPlayXClick(Sender: TObject);
    procedure mnuPlayOClick(Sender: TObject);
    function StoredMove : Integer;
  private
    { Private declarations }
    Square         : array [1..NUM_SQUARES] of TImage;
    mnuLevel       : array [1..NUM_SQUARES] of TMenuItem;

    GameInProgress : Boolean;
    NextPlayer     : TPlayer; // The player who should move next.
    PlayerX        : TPlayer; // The player who is X.
    PlayerO        : TPlayer; // The player who is O.
    Board          : array [1..NUM_SQUARES] of TPlayer;
    SkillLevel     : Integer;

    // Variables for precomputed moves and responses.
    pattern        : array [1..NUM_PATTERNS, 1..NUM_SQUARES] of TPlayer;
    pat_move       : array [1..NUM_PATTERNS] of Integer;
  public
    { Public declarations }
  end;

var
  TicTacForm: TTicTacForm;

implementation

{$R *.DFM}

// Initialize the game.
procedure TTicTacForm.FormCreate(Sender: TObject);
var
    i, pat : Integer;
begin
    // Save controls for later use.
    Square[1] := Square1;
    Square[2] := Square2;
    Square[3] := Square3;
    Square[4] := Square4;
    Square[5] := Square5;
    Square[6] := Square6;
    Square[7] := Square7;
    Square[8] := Square8;
    Square[9] := Square9;
    mnuLevel[1] := mnuLevel1;
    mnuLevel[2] := mnuLevel2;
    mnuLevel[3] := mnuLevel3;
    mnuLevel[4] := mnuLevel4;
    mnuLevel[5] := mnuLevel5;
    mnuLevel[6] := mnuLevel6;
    mnuLevel[7] := mnuLevel7;
    mnuLevel[8] := mnuLevel8;
    mnuLevel[9] := mnuLevel9;

    // Make all squares fill using the form's color.
    for i := 1 to NUM_SQUARES do
    begin
        Square[i].Canvas.Brush.Color := Brush.Color;
    end;

    // Initialize the pattern data. The moves and replies
    // were generated by letting the program run through
    // the entire game tree for each move. We store the
    // results here to save time in later games.
    // Blank all the patterns.
    for pat := 1 to NUM_PATTERNS do
        for i := 1 to NUM_SQUARES do
            pattern[pat, i] := plNone;

    // Record human moving first patterns.
    for pat := 1 to NUM_SQUARES do
        pattern[pat, pat] := plHuman;
    pat_move[1] := 5;
    pat_move[2] := 1;
    pat_move[3] := 5;
    pat_move[4] := 1;
    pat_move[5] := 1;
    pat_move[6] := 3;
    pat_move[7] := 5;
    pat_move[8] := 2;
    pat_move[9] := 5;

    // If we move first, take the center square.
    pat_move[10] := 5;

    // Initialize default options.
    SkillLevel := 3;
    mnuLevel[SkillLevel].Checked := True;
    PlayerX := plHuman;
    PlayerO := plComputer;
    mnuPlayX.Checked := True;

    // Start a new game.
    StartNewGame;
end;

procedure TTicTacForm.mnuAboutClick(Sender: TObject);
const
    CRCR = #13#10#13#10;
begin
    MessageDlg(
        'This program uses a minimax search to play Tic Tac Toe.' + CRCR +
        'Use the Options pull-down menu to set the Skill Level. This determines the program''s maximum depth of recursion when searching the game tree.'
        , mtInformation, [mbOK], 0);
end;

procedure TTicTacForm.mnuExitClick(Sender: TObject);
begin
    Close;
end;

// The user clicked on a square. If it's the player's move,
// take the square for the player.
procedure TTicTacForm.TakeSquare(sq : Integer);
begin
    // Make sure a game is running, it's the player's
    // turn, and noone already owns this square.
    if (not GameInProgress) then exit;
    if (NextPlayer <> plHuman) then exit;
    if (Board[sq] <> plNone) then exit;

    // Take the square for the player
    Board[sq] := plHuman;
    DrawSquare(sq);

    if (GameOver) then exit;

    // Get ready for the next move.
    NextPlayer := plComputer;
    PlayerHasMoved;
end;

// Draw the correct image in a square.
procedure TTicTacForm.DrawSquare(sq : Integer);
begin
    if (Board[sq] = PlayerX) then
    begin
        Square[sq].Canvas.MoveTo(8, 8);
        Square[sq].Canvas.LineTo(57, 57);
        Square[sq].Canvas.MoveTo(57, 8);
        Square[sq].Canvas.LineTo(8, 57);
    end else begin
        Square[sq].Canvas.Ellipse(8, 8, 57, 57);
    end;
end;

// See if the game is over and tell who won.
function TTicTacForm.GameOver : Boolean;
var
    player : TPlayer;
begin
    player := Winner;
    Result := (player <> plNone);
    if (not Result) then exit;

    // Someone won.
    GameInProgress := False;
    if (player = PlayerX) then
        MsgLabel.Caption := 'X wins.'
    else if (player = PlayerO) then
        MsgLabel.Caption := 'O wins.'
    else
        MsgLabel.Caption := 'Noone wins.';

    Beep;
end;

// One of the players has made a move. Prepare to receive
// the NextPlayer's move.
//
// Since a human player moves by clicking on a square, we
// don't need to do much to prepare for the human to move.
//
// The computer, on the other hand, moves whenever we tell
// it to. To get ready for it we actually make it take
// its turn.
//
// When the computer is done moving it could call
// PlayerHasMoved again. In that case we would simply get
// ready for the human to move and then exit
// PlayerHasMoved. To avoid this extra procedure call, we
// instead prepare for the human's next move right after
// the computer has moved.
//
// It is important that this function not recurse deeply.
// Without a little caution it could make the computer
// move which calls PlayerHasMoved which makes the human
// move which calls PlayerHasMoved which makes the
// computer move which ...
procedure TTicTacForm.PlayerHasMoved;
begin
    // If the computer needs to move, make it do so.
    if (NextPlayer = plComputer) then
    begin
        MakeComputerMove;
        if (GameOver) then exit;
    end;

    // Now make the human should move.
    MakeHumanMove;
end;

// Give the human a chance to move.
//
// Just tell the human to move. The SquareClick procedure
// does the rest, including calling PlayerHasMoved.
procedure TTicTacForm.MakeHumanMove;
begin
    MsgLabel.Caption := 'Your turn.'
end;

// Give the computer a chance to move.
procedure TTicTacForm.MakeComputerMove;
begin
    // Get ready.
    MsgLabel.Caption := 'The computer''s turn.';
    MsgLabel.Refresh;

    // Pick a move.
    Screen.Cursor := crHourGlass;
    PickComputerMove;
    Screen.Cursor := crDefault;

    // Get ready for the next move.
    NextPlayer := plHuman;
end;

// Use a minimax strategy to pick a move.
//
// For each possible move the computer could make, compute
// the best possible response the human could make. Select
// the move for which this response is worst (for the
// human).
//
// Moves get values:
//       Win      This player will win.
//       Unknown  Can't tell who will win.
//       Draw     There will be a draw.
//       Lose     The other player will win.
procedure TTicTacForm.PickComputerMove;
var
    best_move  : Integer;    // The best move we can make.
    best_value : TBoardValue; // The best move's value.
begin
    // See if we recognize a pattern
    best_move := StoredMove;

    // If we did not find a pattern, search for a move.
    if (best_move < 1) then
    begin
        BoardValue(best_move, best_value, plComputer, plHuman, 0);
    end;

    // Take the best square.
    Board[best_move] := plComputer;
    DrawSquare(best_move); // Update the display.
end;

// Find the value of this board. Return the best move and
// the best value for the board through best_move and
// best_value.
//
// player1 is the player about to move. player2 is the
// opponent. depth is the current depth of recursion. We
// use this to stop looking at a certain depth.
procedure TTicTacForm.BoardValue(var best_move : Integer; var best_value : TBoardValue; player1, player2 : TPlayer; depth : Integer);
var
    good_value, enemy_value : TBoardValue;
    i, good_i, enemy_i      : Integer;
    player                  : TPlayer;
begin
    // If we are in too deep, we know nothing.
    if (depth >= SkillLevel) then begin
        best_value := bvUnknown;
        exit;
    end;

    // If this board is finished, we know how we would do.
    player := Winner;

    if (player <> plNone) then
    begin
        // Convert the value for the winner pl into the
        // value for player player1.
        if (player = player1) then
            best_value := bvWin
        else if (player = player2) then
            best_value := bvLose
        else
            best_value := bvDraw;
        exit;
    end;

    // Try all the legal moves.
    good_i := -1;
    good_value := bvTooBig; // Bigger than is possible.
    for i := 1 to NUM_SQUARES do
    begin
        // If the move is legal, try it.
        if (Board[i] = plNone) then
        begin
            // See what value this would give the opponent.
            // Make the move.
            Board[i] := player1;
            BoardValue(enemy_i, enemy_value, player2, player1, depth + 1);

            // Unmake the move.
            Board[i] := plNone;

            // See if this is lower than the previous best
            // move for the opponent.
            if (enemy_value < good_value) then
            begin
                good_i := i;
                good_value := enemy_value;
                // If the opponent will lose, things can't
                // get better for us so take this move.
                if (good_value <= bvLose) then break;
            end;
        end; // End if (Board[i] := None) then ...
    end; // End for i := 1 to NUM_SQUARES do

    // Translate the opponent's value into ours.
    if (good_value = bvWin) then
        // Opponent wins, we lose.
        best_value := bvLose
    else if (enemy_value = bvLose) then
        // Opponent loses, we win.
        best_value := bvWin
    Else
        // DRAW and UNKNOWN are the same for both players.
        best_value := good_value;
    best_move := good_i;
end;

// Return the player who has won. If it is a draw, return
// Draw. If the game is not yet over, return None.
function TTicTacForm.Winner : TPlayer;
var
    i, sq : Integer;
begin
    // Look for three-in-a-row wins.
    sq := 1;
    for i := 1 to 3 do
    begin
        if (Board[sq] <> plNone) then
        begin
            if ((Board[sq] = Board[sq + 1]) and
                (Board[sq] = Board[sq + 2])) then
            begin
                Result := Board[sq];
                exit;
            end;
        end;
        sq := sq + 3;
    end;

    // Look for three-in-a-column wins.
    for sq := 1 to 3 do
    begin
        if (Board[sq] <> plNone) then
        begin
            if ((Board[sq] = Board[sq + 3]) and
                (Board[sq] = Board[sq + 6])) then
            begin
                Result := Board[sq];
                exit;
            end;
        end;
    end;

    // Look for diagonal wins.
    if (Board[1] <> plNone) then
    begin
        if ((Board[1] = Board[5]) and
            (Board[1] = Board[9])) then
        begin
            Result := Board[1];
            exit;
        end;
    end;
    if (Board[3] <> plNone) then
    begin
        if ((Board[3] = Board[5]) and
            (Board[3] = Board[7])) then
        begin
            Result := Board[3];
            exit;
        end;
    end;

    // There is no winner. See if it's a draw.
    Result := plNone;
    for sq := 1 to NUM_SQUARES do
        if (Board[sq] = plNone) then exit;

    // It's a draw.
    Result := plDraw;
end;

// Start a new game. Reset the board so noone owns any
// squares. Set the correct X player to move next.
procedure TTicTacForm.StartNewGame;
var
    i    : Integer;
    rect : TRect;
begin
    // Reset the board.
    rect.Left := 0;
    rect.Top := 0;
    rect.Bottom := Square1.Height;
    rect.Right := Square1.Width;
    for i := 1 to NUM_SQUARES do
    begin
        Board[i] := plNone;
        Square[i].Canvas.FillRect(rect);
    end;
    NextPlayer := PlayerX;
    GameInProgress := True;

    // Start the first move.
    PlayerHasMoved;
end;

// Change the skill level and start a new game.
procedure TTicTacForm.mnuLevelClick(Sender: TObject);
begin
    mnuLevel[SkillLevel].Checked := False;
    SkillLevel := SelectedLevel(Sender);
    mnuLevel[SkillLevel].Checked := True;
    StartNewGame;
end;

// Select a square.
procedure TTicTacForm.SquareClick(Sender: TObject);
begin
    TakeSquare(SelectedSquare(Sender));
end;

// Return the selected menu index.
function TTicTacForm.SelectedLevel(Sender : TObject) : Integer;
var
    i : Integer;
begin
    for i := 1 to NUM_SQUARES do
        if (mnuLevel[i] = Sender) then break;
    Result := i;
end;

// Return the selected square index.
function TTicTacForm.SelectedSquare(Sender : TObject) : Integer;
var
    i : Integer;
begin
    for i := 1 to NUM_SQUARES do
        if (Square[i] = Sender) then break;
    Result := i;
end;

// Let the user play X.
procedure TTicTacForm.mnuPlayXClick(Sender: TObject);
begin
    PlayerX := plHuman;
    PlayerO := plComputer;
    mnuPlayX.Checked := True;
    mnuPlayO.Checked := False;
    StartNewGame;
end;

// Let the user play O.
procedure TTicTacForm.mnuPlayOClick(Sender: TObject);
begin
    PlayerX := plComputer;
    PlayerO := plHuman;
    mnuPlayX.Checked := False;
    mnuPlayO.Checked := True;
    StartNewGame;
end;

// See if we recognize a pattern. If so, return the index
// of the corresponding move. Otherwise return 0.
function TTicTacForm.StoredMove : Integer;
var
    pat, i : Integer;
begin
    for pat := 1 to NUM_PATTERNS do
    begin
        // Check this pattern.
        for i := 1 to NUM_SQUARES do
            if (pattern[pat, i] <> Board[i]) then break;

        // See if we matched the pattern
        if (i > NUM_SQUARES) then
        begin
            Result := pat_move[pat];
            exit;
        end;
    end;
    Result := -1;
end;


end.
