
Task

Play a game of tic-tac-toe.

Ensure that legal moves are played and that a winning position is notified.


Tic-tac-toe   is also known as:

   naughts and crosses 
   tic tac toe 
   tick tack toe 
   three in a row 
   tres en rayo       and
   Xs  and  Os


See also
   MathWorld™, Tic-Tac-Toe game.
   Wikipedia tic-tac-toe.


program tic(Input, Output);
 
type
    Contents = (Unassigned, Human, Computer);
var
    best_i, best_j: Integer; { best solution a depth of zero in the search }
    b: array[0..2, 0..2] of Contents;  {zero based so modulus works later}
    player: Contents;
 
procedure displayBoard;
var
    i, j: Integer;
    t: array [Contents] of char;
begin
    t[Unassigned] := ' ';
    t[Human] := 'O';
    t[Computer] := 'X';
    for i := 0 to 2 do begin
        for j := 0 to 2 do begin
            write(t[b[i][j]]);
            if j <> 2 then write(' | ');
        end;
        writeln();
    if i < 2 then writeln('---------');
    end;
    writeln();
    writeln();
end;
 
function swapPlayer (Player: Contents): Contents;
begin
    if Player = Computer then swapPlayer := Human else swapPlayer := Computer;
end;
 
function checkWinner: Contents;
var
    i: Integer;
begin
    checkWinner := Unassigned;  (* no winner yet *)
    for i := 0 to 2 do begin
        (* first horizontal solution *)
        if ((checkWinner = Unassigned) and (b[i][0] <> Unassigned)) and ((b[i][1] = b[i][0]) and (b[i][2] = b[i][0])) then
            checkWinner := b[i][0]
        else
        (* now vertical solution *)
        if ((checkWinner = Unassigned) and (b[0][i] <> Unassigned)) and ((b[1][i] = b[0][i]) and (b[2][i] = b[0][i])) then
            checkWinner := b[0][i];
    end; (* now check the paths of the two cross line slants that share the middle position *)
    if (checkWinner = Unassigned) and (b[1][1] <> Unassigned) then begin
       if ((b[1][1] = b[0][0]) and (b[2][2] = b[0][0])) then checkWinner := b[0][0]
       else if ((b[1][1] = b[2][0]) and (b[0][2] = b[1][1])) then checkWinner := b[1][1];
    end;
end;
 
{ Basic strategy test - is this te best solution we have seen } 
function saveBest(CurScore, CurBest: Contents) : boolean;
begin
    if CurScore = CurBest then saveBest := false
    else if (Curscore = Unassigned) and (CurBest = Human) then saveBest := false
    else if (Curscore = Computer) and ((CurBest = Unassigned) or (CurBest = Human)) then saveBest := false
    else saveBest := true;
end;
 
 
{ Basic strategy - recursive depth first serach of possible moves
  if computer can win save it, otherwise block if need be, else do deeper.
  At each level modify the board for the next call, but clean up as go back up,
  by remembering the modified position on the call stack. } 
function test_move (val: Contents; depth: Integer): Contents;
var
    i, j: Integer;
    score, best, changed: Contents;
begin
    best := Computer;
    changed := Unassigned;
    score := checkWinner();
    if score <> Unassigned then begin
      if score = val then test_move := Human else test_move := Computer;
    end else begin
      for i := 0 to 2 do for j := 0 to 2 do begin
        if b[i][j] = Unassigned then begin
          changed := val;
          b[i][j] := val; (* the value for now and try wioth the other player *)
          score := test_move(swapPlayer(val), depth + 1);
          if (score <> Unassigned) then score := swapPlayer(score);
          b[i][j] := Unassigned;
          if saveBest(score, best) then begin
            if depth = 0 then begin { top level, so remember actual position }
              best_i := i;
              best_j := j;
            end;
            best := score;
          end;
        end;
      end;
      if (changed <> Unassigned) then test_move := best else test_move := Unassigned;
    end;
end;
 
function playGame(whom:Contents): string;
var
    i, j, k, move: Integer;
    win: Contents;
begin
    win := Unassigned;
    for i := 0 to 2 do for j := 0 to 2 do b[i][j] := Unassigned;
 
    writeln('The board positions are numbered as follows:');
    writeln('1 | 2 | 3');
    writeln('---------');
    writeln('4 | 5 | 6');
    writeln('---------');
    writeln('7 | 8 | 9');
    writeln('You have O, I have X.');
    writeln();
 
    k := 1;
	repeat {rather a for loop but can not have two actions or early termination in Pascal}
        begin
          if whom = Human then begin
            repeat begin
              write('Your move: ');
              readln(move);
              if (move < 1) or (move > 9) then writeln('Opps: enter a number between 1 - 9')
              else move := pred(move); {humans do 1 -9, but the computer wants 0-8 for modulus to work}
            end until ((move >= 0) and (move <= 8));
            i := move div 3; { convert from range to corridinated of the array }
            j := move mod 3;
            if b[i][j] = Unassigned then b[i][j] := Human;
          end;
          if  whom = Computer then begin
            (* randomize if computer opens, so its not always the same game *)
            if k = 1 then begin
              best_i := random(3); {Pascal random returns positive integers from 0 to func arg}
              best_j := random(3);
            end else
              win := test_move(Computer, 0);
            b[best_i][best_j] := Computer;
            writeln('My move: ', best_i * 3 + best_j + 1);
          end;
 
          displayBoard();
          win := checkWinner();
          if win <> Unassigned then begin
            if win = Human then playGame := 'You win.' else playGame := 'I win.';
          end else begin
			k := succ(k); { "for" loop counter actions }
            whom := swapPlayer(whom);
          end;
        end;
	until (win <> Unassigned) or (k > 9);
	if win = Unassigned then playGame := 'A draw.';
end;
 
begin
    randomize();
    player := Human;
    while (true) do 
        begin
            writeln(playGame(player));
            writeln();
            player := swapPlayer(player);
        end
end.