walshm@clutx.clarkson.edu (Matthew S. Walsh) (11/18/90)
Does anyone have a public domain program written in Pascal which plays TIC TAC TOE - allowing the player to play the computer? I don't need or want anything with graphics, just plain text characters for the board. Ideally I'd like something to run on UNIX. Thanks matt walsh Matthew Walsh::217-398-8593:205 E. Clark suite 204:Champaign Il 61820 walshm@clutx.clarkson.edu::Dynamic Entertaining Mechanical Systems, inc And if they catch you in the back seat trying to pick her locks, They're gonna send you back to mother in a cardboard box!
davidr@hplsla.HP.COM (David M. Reed) (11/22/90)
I copied this out of Turbo TECHNIX (March/April 1988). I really liked
its presentation of abstract data types and their implementation. (And
my kids like the game.) I do not know if this is what you want, but it
should be a good start.
********************************************************
Unit TicTac;
{
TICTAC.PAS unit to implement abstract data types MOVE, LOCATION, GAME
author bruce f. webster ( from Turbo TECHNIX, March/April 1988 )
last update 12 dec 87
}
Interface
{ definitions for abstract data type Move }
TYPE Move = (BLANK, X, O);
FUNCTION Opposite (M : Move) : Move;
{ definitions for abstract data type Location }
CONST GLim = 9;
TYPE Location = 1..GLim;
{ definitions for abstract data type Game }
TYPE Board = ARRAY [Location] OF Move;
Game = RECORD
Grid : Board;
Next,
Win : Move;
Moves : INTEGER;
END;
FUNCTION GetLoc (VAR g : Game; l : Location) : Move;
FUNCTION NextMove (g : Game) : Move;
FUNCTION MovesMade (g : Game) : INTEGER;
FUNCTION GameOver (VAR g : Game) : BOOLEAN;
FUNCTION Winner (g : Game) : Move;
PROCEDURE DoMove (VAR g : Game; l : Location);
PROCEDURE NewGame (VAR g : Game; First : Move);
Implementation
{****************************************************************************}
FUNCTION Opposite (M : Move) : Move;
{ return opposite of value passed }
BEGIN
CASE M OF
BLANK : Opposite := BLANK;
X : Opposite := O;
O : Opposite := X;
END; { CASE M }
END; { of PROC Opposite }
{****************************************************************************}
PROCEDURE SetLoc (VAR g : Game; l : Location; m : Move);
{ sets a location in the game to a given value }
BEGIN
g.Grid [l] := m;
END; { of PROC SetLoc }
{****************************************************************************}
FUNCTION GetLoc (VAR g : Game; l : Location) : Move;
{ returns value of a given location in the game }
BEGIN
GetLoc := g.Grid [l];
END; { of PROC GetLoc }
{****************************************************************************}
FUNCTION NextMove (g : Game) : Move;
{ returns next move }
BEGIN
NextMove := g.Next;
END; { of FUNC NextMove }
{****************************************************************************}
FUNCTION MovesMade (g : Game) : INTEGER;
{ returns number of moves made in game so far }
BEGIN
MovesMade := g.Moves;
END; { of FUNC MovesMade }
{****************************************************************************}
PROCEDURE InARow (VAR g : Game; i, j, k : Location);
{ checks for three X's or O's in a row }
BEGIN
WITH g DO BEGIN
IF (Win = BLANK) THEN BEGIN
IF ( (Grid [i] = Grid [j] ) AND (Grid [j] = Grid [k] ) AND
(Grid [i] <> BLANK) ) THEN Win := Grid [i];
END; { IF Win }
END; { WITH g }
END; { of PROC InARow }
{****************************************************************************}
PROCEDURE CheckForWin (VAR g : Game; l : Location);
{ see if last move won the game }
BEGIN
CASE l OF
1 : BEGIN
InARow (g, 1, 2, 3);
InARow (g, 1, 5, 9);
InARow (g, 1, 4, 7);
END;
2 : BEGIN
InARow (g, 1, 2, 3);
InARow (g, 2, 5, 8);
END;
3 : BEGIN
InARow (g, 1, 2, 3);
InARow (g, 3, 5, 7);
InARow (g, 3, 6, 9);
END;
4 : BEGIN
InARow (g, 1, 4, 7);
InARow (g, 4, 5, 6);
END;
5 : BEGIN
InARow (g, 1, 5, 9);
InARow (g, 2, 5, 8);
InARow (g, 3, 5, 7);
InARow (g, 4, 5, 6);
END;
6 : BEGIN
InARow (g, 3, 6, 9);
InARow (g, 4, 5, 6);
END;
7 : BEGIN
InARow (g, 1, 4, 7);
InARow (g, 3, 5, 7);
InARow (g, 7, 8, 9);
END;
8 : BEGIN
InARow (g, 2, 5, 8);
InARow (g, 7, 8, 9);
END;
9 : BEGIN
InARow (g, 1, 5, 9);
InARow (g, 3, 6, 9);
InARow (g, 7, 8, 9);
END;
END; { CASE }
END; { of PROC CheckForWin }
{****************************************************************************}
FUNCTION GameOver (VAR g : Game) : BOOLEAN;
{ returns status of game (over or not ) }
BEGIN
GameOver := ( (g.Win <> BLANK) OR (g.Moves = GLim) );
END; { of FUNC GameOver }
{****************************************************************************}
FUNCTION Winner (g : Game) : Move;
{ returns winner of game }
BEGIN
Winner := g.Win;
END; { of FUNC Winner }
{****************************************************************************}
PROCEDURE DoMove (VAR g : Game; l : Location);
{ make next move in game }
BEGIN
WITH g DO BEGIN
SetLoc ( g, l, g.Next);
Moves := Moves + 1;
CheckForWin (g, l);
IF NOT (GameOver (g) ) THEN Next := Opposite (Next)
ELSE Next := BLANK;
END; { WITH g }
END; { if PROC DoMove }
{****************************************************************************}
PROCEDURE NewGame (VAR g : Game; First : Move);
{ initialize a new game }
VAR loop : INTEGER;
BEGIN
WITH g DO BEGIN
FOR loop := 1 TO GLim DO SetLoc (g, loop, BLANK);
Next := First;
Win := BLANK;
Moves := 0;
END; { WITH g }
END; { of PROC NewGame }
END. { of Unit TicTac }
*****************************************************************************
Unit TicTacMv;
{
TICTACMV.PAS unit for making computer's moves for tictactoe
author bruce f. webster ( from Turbo TECHNIX, March/April 1988 )
last update 12 dec 87
}
Interface
Uses TicTac;
VAR CFlag : INTEGER; { 0 if computer moves first, 1 otherwise }
CMove : Move; { contains computer's marker (X, O) }
PROCEDURE GenerateMove (g : Game; VAR l : Location);
Implementation
{****************************************************************************}
FUNCTION WinFound (g : Game; VAR l : Location) : BOOLEAN;
{ checks for winning move in game }
VAR temp : Game;
count : INTEGER;
BEGIN
count := 1;
WinFound := FALSE;
REPEAT
IF (GetLoc (g, count) = BLANK) THEN BEGIN
temp := g;
DoMove (temp, count);
IF (GameOver (temp) AND (Winner (temp) <> BLANK) ) THEN BEGIN
l := 1;
WinFound := TRUE;
Exit;
END; { IF GameOver }
END; { IF GetLoc }
count := SUCC (count);
UNTIL (count > Glim);
END; { of FUNC WinFound }
{****************************************************************************}
FUNCTION BlockFound (g : Game; VAR l : Location) : BOOLEAN;
{ checks for blocking move in game }
VAR temp : Game;
count : INTEGER;
loc : Location;
BEGIN
count := 1;
BlockFound := FALSE;
REPEAT
IF (GetLoc (g, count) = BLANK) THEN BEGIN
temp := g;
DoMove (temp, count);
IF NOT (WinFound (temp, loc) ) THEN BEGIN
l := count;
BlockFound := TRUE;
Exit;
END; { IF NOT WinFound }
END; { IF GetLoc }
count := SUCC (count);
UNTIL (count > GLim);
END; { of FUNC BlockFound }
{****************************************************************************}
PROCEDURE GenerateMove (g : Game; VAR l : Location);
{ generates next move for computer }
VAR NMoves : INTEGER;
BEGIN
l := 5;
NMoves := MovesMade (g);
IF (NMoves <= 2) THEN BEGIN
IF (GetLoc (g, l) = BLANK) THEN Exit;
END; { IF NMoves }
IF (WinFound (g, l) ) THEN Exit;
IF (NMoves > 2) AND (BlockFound (g, l) ) THEN Exit;
REPEAT
IF (NMoves <= 4) THEN l := 1 + 2 * Random (5)
ELSE l := 1 + Random (Glim);
UNTIL (GetLoc (g, l) = BLANK);
END; { of PROC GenerateMoves }
END. { of Unit TicTacMv }
*****************************************************************************
Unit TicTacIO;
{
TICTACIO.PAS unit to implement screen and keyboard routines for tictactoe
author bruce f. webster ( from Turbo TECHNIX, March/April 1988 )
last update 12 dec 87
}
Interface
Uses CRT, TicTac;
{ define types for parameters }
TYPE CharSet = SET OF Char;
MsgStr = STRING [80];
PROCEDURE DisplayGame (theGame : Game);
PROCEDURE DrawGrid;
PROCEDURE ReadChar (VAR Ch : Char; Prompt : MsgStr; OKSet : CharSet);
PROCEDURE ReadInt (VAR Val : INTEGER; Prompt : MsgStr; Low, High : INTEGER);
Implementation
CONST BoardX = 10; { positioning for tictactoe grid }
BoardY = 10;
Bar = #186; { special characters used for grid }
Line = #205;
Cross = #206;
{**************************************************************************}
PROCEDURE DrawGrid;
{ draws full-sized tictactoe grid, with smaller numbers one beside it }
{==========================================================================}
PROCEDURE DrawHorz (x, y : INTEGER);
{ draws horizontal bar for tictactoe grid }
BEGIN
GotoXY (x, y);
WRITE (Line, Line, Line, Line, Line, Cross);
WRITE (Line, Line, Line, Line, Line, Cross);
WRITE (Line, Line, Line, Line, Line);
END; { of locPROC DrawHorz }
{==========================================================================}
PROCEDURE DrawVert (x, y : INTEGER);
{ draws vertical bar for tictactoe grid }
VAR loop,
count : INTEGER;
BEGIN
FOR loop := 1 TO 3 DO BEGIN
FOR count := 0 TO 2 DO BEGIN
GotoXY (x, y + count);
WRITE (Bar);
END; { FOR count }
y := y + 4;
END; { FOR loop }
END; { of locPROC DrawVert }
{==========================================================================}
PROCEDURE DrawMoves (x, y : INTEGER);
{ draws 3x3 grid with numbered positions }
BEGIN
GotoXY (x, y); WRITE ('1', Bar, '2', Bar, '3');
GotoXY (x, y + 1); WRITE (Line, Cross, Line, Cross, Line);
GotoXY (x, y + 2); WRITE ('4', Bar, '5', Bar, '6');
GotoXY (x, y + 3); WRITE (Line, Cross, Line, Cross, Line);
GotoXY (x, y + 4); WRITE ('7', Bar, '8', Bar, '9');
END; { of locPROC DrawMoves }
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * }
BEGIN { of PROC DrawGrid }
DrawHorz (BoardX, BoardY);
DrawHorz (BoardX, BoardY + 4);
DrawVert (BoardX + 5, BoardY - 3);
DrawVert (BoardX + 11, BoardY - 3);
DrawMoves (BoardX + 20, BoardY);
END; { of PROC DrawGrid }
{**************************************************************************}
PROCEDURE DisplayGame (theGame : Game);
{ draws status of tictactoe game on screen }
VAR count,
col,
row : INTEGER;
m : Move;
BEGIN
FOR count := 1 TO GLim DO BEGIN
m := GetLoc (theGame, count);
col := BoardX + 2 + 6 * ( (count - 1) MOD 3);
row := BoardY - 2 + 4 * ( (count - 1) DIV 3);
GotoXY (col, row);
CASE m OF
BLANK : WRITE (' ');
X : WRITE ('X');
O : WRITE ('O');
END; { CASE m }
END; { FOR count }
END; { of PROC DisplayGame }
{**************************************************************************}
PROCEDURE ReadChar (VAR Ch : Char; Prompt : MsgStr; OKSet : CharSet);
{ prompt for and get one character of a given set }
BEGIN
GotoXY ( 1, 1);
ClrEol;
WRITE (Prompt);
REPEAT
Ch := UpCase (ReadKey);
UNTIL Ch IN OKSet;
WRITE (Ch);
END; { of PROC ReadChar }
{**************************************************************************}
PROCEDURE ReadInt (VAR Val : INTEGER; Prompt : MsgStr; Low, High : INTEGER);
{ prompt for and get an integer value in a given range }
BEGIN
{$I-}
REPEAT
GotoXY (1, 1);
ClrEol;
WRITE (Prompt, ' (', Low, ', ', High, '): ');
READLN (Val);
UNTIL (IOResult = 0) AND (Val >= Low) AND (Val <= High);
{$I+}
END; { of PROC ReadInt }
END. { of Unit TicTacIO }
*****************************************************************************
PROGRAM TicTacToe;
{
TTT.PAS implementation of tic-tac-toe on the computer
author bruce f. webster ( from Turbo TECHNIX, March/April 1988 )
last update 12 dec 87
}
Uses CRT, TicTac, TicTacMv, TicTacIO;
VAR theGame : Game;
Next : Location;
Ch : CHAR;
{***************************************************************************}
PROCEDURE StartGame (VAR theGame : Game);
{ set up a new game }
VAR answer : CHAR;
BEGIN
ClrScr;
ReadChar (answer, 'Who moves first: H)uman or C)omputer ? ', ['H', 'C'] );
IF (answer = 'C') THEN CFlag := 0
ELSE CFlag := 1;
ReadChar (answer, 'Do you wish to be X or O ? ', ['X', 'O'] );
IF (answer = 'X') THEN CMove := O
ELSE CMove := X;
IF (CFlag <> 0) THEN NewGame (theGame, Opposite (CMove) )
ELSE NewGame (theGame, CMove);
DrawGrid;
DisplayGame (theGame);
END; { of PROC StartGame }
{***************************************************************************}
PROCEDURE GetMove (theGame : Game; VAR l : Location);
{ select the next move for the game }
CONST bell = #7;
VAR loc : INTEGER;
BEGIN
IF (MovesMade (theGame) MOD 2) = CFlag THEN GenerateMove (theGame, l)
ELSE BEGIN
REPEAT
ReadInt (loc, 'Enter move: ', 1, GLim);
IF (GetLoc (theGame, loc) <> BLANK) THEN WRITE (bell);
UNTIL (GetLoc (theGame, loc) = BLANK);
l := loc;
END; { ELSE }
END; { of PROC GetMove }
{***************************************************************************}
PROCEDURE ShowResults (VAR theGame : Game);
{ show results of tictactoe game }
VAR m : Move;
BEGIN
m := Winner (theGame);
GotoXY (1, 1);
ClrEol;
CASE m OF
BLANK : WRITE ('The game was a draw');
X : WRITE ('The winner is X');
O : WRITE ('The winner is O');
END; { CASE m }
WRITE (' -- press any key to continue (Q to quit) ');
END; { of PROC ShowResults }
{ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * }
BEGIN { of PROG TicTacToe }
REPEAT
StartGame (theGame);
REPEAT
GetMove (theGame, Next);
DoMove (theGame, Next);
DisplayGame (theGame);
UNTIL (GameOver (theGame) );
ShowResults (theGame);
Ch := UpCase (ReadKey);
UNTIL (Ch = 'Q');
END. { of PROG TicTacToe }gideon@cs.utexas.edu (Timothy Tin-Wai Chan) (11/23/90)
I have spotted a bug (or was it a typo?) in the Tic Tac Toe program.
In the unit "TicTacMv", in the procedure BlockFound, the line
l := 1;
should be changed to:
l := count;
-- Tim