Simple Tic Tac Toe game with crude graphics and no error checking.
Distribute this code freely, modify it, copy it I dont care. Mail me if you
ever find this useful.
------------------------------------------------------
with Ada.Text_IO;
use Ada.Text_IO;
with Ada.Integer_Text_IO;
use Ada.Integer_Text_IO;
-- Where we get the Randon generator
with Ada.Numerics.Discrete_Random;
procedure Tic_Tac_Toe is
------------------------Samir--------------------------------
-------------------------------------------------------------
---------------DECLARATIONS------------------------
-- 9 spaces in the tic tac toe board, max nine moves
subtype Looprange is Integer range 1..9;
-------------------------------------------------------------
subtype Choicerange is Integer range 1..2;
-- Subtype that limits certain input choices
-------------------------------------------------------------
-- For names of players
subtype Nametype is String(1..10);
-------------------------------------------------------------
-- Tic Tac Toe board range
subtype Boardrange is Positive range 1..3;
-------------------------------------------------------------
-- X and O are player or computer marks
-- E indicates Empty
type Gamesymbol is(X , O , E);
-------------------------------------------------------------
-- New IO for GameSymbol
package Symbol_IO is new Ada.Text_Io.Enumeration_IO(Enum =>
Gamesymbol);
-------------------------------------------------------------
-- Instantiate a package that generates random moves of BoardRange i.e
1..3
package RandomMove is new Ada.Numerics.Discrete_Random (BoardRange);
-------------------------------------------------------------
type Boardarray is array (Boardrange, Boardrange) of Gamesymbol;
-- The array for the board
-------------------------------------------------------------
type Playertype is
record
-- For each player
Name : Nametype; -- player name
Length : Positive; -- player name length
Playsymbol : Gamesymbol; -- symbol associated with player
end record; -- PlayerType
-------------------------------------------------------------
-- Variable used for making a choice
Continuechoice : Choicerange;
-------------------------------------------------------------
---------------------FUNCTIONS-----------------------------
-- Function that looks throught the gameboard and decides
-- if someone has won the game
-- Board: Game board
function Someone_Has_Won (Board : Boardarray;
Samevalue : Gamesymbol) return Boolean is
Result : Boolean; -- Value to be returned
begin -- Someone_Has_Won
Result := False; -- Initialize to game not yet over
for Column in Boardrange loop
-- Look through all three coloumns
if Board(1,Column)=Board(2,Column) and
Board(2,Column)=Board(3,Column) and
Board(3,Column)=Samevalue then
Result:=True;
end if; -- Board (1, Column)
end loop; -- FOR Column
for Row in Boardrange loop
-- Look through all three rows
if Board(Row,1)=Board(Row,2) and
Board(Row,2)=Board(Row,3) and
Board(Row,3)=Samevalue then
Result:=True;
end if; -- Board (Row,1)
end loop; -- FOR Row
if (Board(1,1)=Board(2,2) and -- Check leading diagonal
Board(2,2)=Board(3,3) and
Board(3,3)=Samevalue) or
(Board(3,1)=Board(2,2) and -- Check other diagonal
Board(2,2)=Board(1,3) and
Board(1,3)=Samevalue) then
Result:=True;
end if;
return Result;
end Someone_Has_Won;
-------------------------------------------------------------
-- Function to decide who moves first
function Whofirst (Player1 : Playertype;
Player2 : Playertype)return Boolean is
-- Declaring local variables here
Result : Boolean; -- Value to be RETURNed
Hewhomoves : Choicerange; -- Input Variable
begin --WhoFirst
Result := True; -- Initialise to player 1
New_Line; -- moves first
Put ("Who moves first?");
New_Line;
Put ("1. ");
Put (Player1.Name(1..Player1.Length));
New_Line;
Put ("2. ");
Put (Player2.Name(1..Player2.Length));
New_Line;
Get (Item => Hewhomoves);
-- If computer wants to move first
if Hewhomoves = 2 then
Result := False;
end if; -- HeWhoMoves = 2
return Result;
end Whofirst; -- function to decide who moves first
-------------------------------------------------------------
---------------------PROCEDURES-----------------------------
-- Procedure that asks players for their names
-- No1 : First player
procedure Get_Player_Name (No1 : OUT PlayerType;
No2 : OUT PlayerType) is
begin -- Get_Player_Name
Put ("Please enter your name");
New_Line;
Put ("Please make it brief and keep it under 10 characters");
New_Line;
Get_Line(No1.Name, No1.Length);
Put("What do you want to call your opponent?");
New_Line;
Get_Line(No2.Name,No2.Length);
-- Name of the first player
if No1.Length = 10 then -- If name of first player is
Skip_Line; -- more than 10 characters, truncate it
end if;
end Get_Player_Name; -- Get name input
-------------------------------------------------------------
-- Procedure that associates each player with a cross or a
-- circle, depending upon user choice
-- No1, No2 : Player and computer respectively
procedure Associate_Player_With_Symbol (
No1 : in out Playertype;
No2 : in out Playertype ) is
Symbolchoice : Integer; -- User input variable
begin -- Associate_Player_With_Symbol
Put ("What symbol would you like, ");
Put (No1.Name(1..No1.Length)); -- Ask player 1 which symbol
New_Line; -- he would prefer
Put ("1. Cross (X)");
New_Line;
Put ("2. Circle (O)");
New_Line;
Get (Item => Symbolchoice);
-- Input for getting user choice of symbols
if Symbolchoice = 1 then -- player 1 prefers cross
No1.Playsymbol := X; -- assign symbols accordingly
No2.Playsymbol := O;
else -- SymbolChoice = 2, player 1 prefers circle
No1.Playsymbol := O; -- Assign symbols accordingly
No2.Playsymbol := X;
end if; -- SymbolChoice = X
Put ("Now, "); -- confirm which player plays under
Put (No1.Name(1..No1.Length)); -- which symbol
Put (" is ");
Symbol_Io.Put (Item => No1.Playsymbol);
Put (" and ");
Put (No2.Name(1..No2.Length));
Put (" is ");
Symbol_Io.Put (Item => No2.Playsymbol);
end Associate_Player_With_Symbol;
-------------------------------------------------------------
-- Procedure that displays the game board after each move
-- Board : The game board that is to be displayed
-- A board with the new BoardArray type is created according to
-- user and computer inputs
procedure Display_Board (Board : in Boardarray ) is
Blank : constant String := " "; -- for empty place
Vert : constant String := "|"; -- boundaries of the
Horiz : constant String := "-"; -- gameboard
begin -- Display_Board
for I in 1..(2*(Boardrange'Last)+1) loop
Put (Horiz); -- Top boundary
end loop;
New_Line;
for I in Board'range(1) loop -- Loop first dimension
Put (Vert); -- vertical separator
for J in Board'range(2) loop -- Loop second dimension
if Board(I, J) = X or Board(I, J) = O then -- not empty
Symbol_Io.Put (Item =>Board (I, J));
elsif Board (I, J) = E then -- space is empty
Put (Blank);
end if; -- Board (I, J)
Put (Vert); -- vertical separator
end loop; -- FOR J
New_Line;
for I in 1..(2*(Boardrange'Last)+1) loop
Put (Horiz); -- Bottom boundary
end loop; -- FOR I
New_Line;
end loop; -- FOR J
end Display_Board;
-------------------------------------------------------------
-- Procedure that aks the player for coordinate of box
-- where the player's symbol is to be placed
-- Board : the game board
-- Mover : player whose turn it is to move
procedure Playermove (Board : in out Boardarray;
Mover : in Playertype) is
X : Boardrange; -- horizontal coordinate
Y : Boardrange; -- vertical coordinate
Correctchoice : Boolean; -- to make sure occupied spaces are not
overwritten
begin -- PlayerMove
Correctchoice := False; -- Initialize
New_Line;
Put (Mover.Name(1..Mover.Length)); -- ask player for input
Put (", please enter the box where you want to place your mark");
New_Line;
while not CorrectChoice loop
Put ("Enter the row in which you want your '");
Symbol_Io.Put (Item => Mover.Playsymbol);
Put ("' mark to be placed"); -- ask for row specification
New_Line;
Get (Y);
-- Input for row
Put ("Now please enter the coloumn you want it placed.");
New_Line; -- ask for coloumn specification
Get (X);
-- Input for coloumn
if Board (Y, X) = E then -- If space specified is empty
Board (Y, X):= Mover.Playsymbol;
Correctchoice := True;
else -- Space already occupied
Put ("You attempted to fill in a");
Put (" box that is already occupied");
New_Line;
end if; -- Board (Y, X)= E
end loop; -- While not CorrectChoice
end Playermove; -- Procedure to get player move
-------------------------------------------------------------
procedure ComputerMove(Board : IN OUT BoardArray;
Mover : IN PlayerType) is
X : Boardrange; -- horizontal coordinate
Y : Boardrange; -- vertical coordinate
Correctchoice : Boolean; -- to make sure occupied spaces are not
overwritten
-- Generate Random Values
RowGen : RandomMove.Generator;
ColGen : RandomMove.Generator;
begin
-- Initialize this value to false in the beginning
CorrectChoice := False;
while not CorrectChoice loop
RandomMove.Reset(RowGen);
RandomMove.Reset(ColGen);
X := RandomMove.Random(RowGen);
Y := RandomMove.Random(ColGen);
-- Input for coloumn
if Board (X, Y) = E then -- If space specified is empty
Board (X, Y):= Mover.Playsymbol;
Correctchoice := True;
end if; -- Board (Y, X)= E
end loop; -- While not CorrectChoice
end ComputerMove;
-------------------------------------------------------------
-- Procedure that acts like a base for the whole game
-- other procedures branch off from Play_Game
procedure Play_Game is
Empty : constant Gamesymbol := E; -- Empty space
Gameboard : Boardarray; -- The game board
Player1 : PlayerType; -- Player1
Player2 : PlayerType; -- Computer
Mover : Playertype; -- The player whose turn
it is to move
PlayerTurnCount : Boolean; -- Counter variable for
the loop
Loopcount : Positive; -- To determine whose
turn it is
begin -- Play Game
Gameboard := (others => (others => Empty)); -- Initialize
GameBoard to fully empty
-- Procedure to get name of players
Get_Player_Name (No1=>Player1, No2=>Player2);
-- Procedure to associate each player with a symbol
Associate_Player_With_Symbol (No1 => Player1, No2 => Player2);
-- Call on WhoFirst to find who moves first
PlayerTurnCount := Whofirst(Player1, Player2);
-- Display empty board
Display_Board(Board => Gameboard);
for I in Looprange loop
-- GAME LOOP
-- A maximum of 9 spaces to be filled
Loopcount := I;
if PlayerTurnCount = True then -- to find whose turn it is
Mover := Player1;
else -- PlayerTurnCount = False
Mover := Player2;
end if; -- PlayerTurnCount = True
if Mover = Player1 then
-- Procedure that asks Player to move
Playermove (Board => Gameboard, Mover => Mover);
else
ComputerMove(Board=> GameBoard, Mover => Mover);
end if;
-- Display board after move
Display_Board(Board => Gameboard);
-- Condition for loop exit
exit when Someone_Has_Won(Gameboard, Mover.Playsymbol);
Playerturncount := not Playerturncount; -- Change of player
end loop; -- FOR I
if Someone_Has_Won(Gameboard, Mover.Playsymbol ) then
Put(Mover.Name(1..Mover.Length));
Put(" has won.");
New_Line;
-- IF game was ended after all spaces were filled
elsif NOT Someone_Has_Won(Gameboard,Mover.Playsymbol)
AND Loopcount = Looprange'Last then
Put ("The game is drawn");
end if;
end Play_Game; -- Base procedure off which others branch
-------------------------------------------------------------
begin -- Main Program Tic_Tac_Toe
loop -- ContinueChoice loop
Play_Game; -- Call on Play_Game to play
New_Line;
Put ("1. Play Again"); -- after game end, ask players
New_Line; -- if they want another game
Put ("2. Quit");
New_Line;
Put ("Please enter your choice");
Get (Continuechoice);
-- Input for ContinueChoice
if Continuechoice = 2 then -- IF players want to quit
New_Line;
exit;
end if; -- Choice = 2
Skip_Line;
end loop; -- end ContinueChoice
end Tic_Tac_Toe;
|
