AdaPower Logged in as Guest
Ada Tools and Resources

Ada 95 Reference Manual
Ada Source Code Treasury
Bindings and Packages

Join >
Articles >
Ada FAQ >
Getting Started >
Home >
Books & Tutorials >
Source Treasury >
Packages for Reuse >
Latest Additions >
Ada Projects >
Press Releases >
Ada Audio / Video >
Home Pages >
Links >
Contact >
About >
Login >
Ada Applications - Tic
Source code of full Ada Applications

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 


   -- 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 =>
   -- Instantiate a package that generates random moves of BoardRange i.e
   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 
         -- 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;  
   -- 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
         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
         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
      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?");
      Put ("1. ");
      Put (Player1.Name(1..Player1.Length));
      Put ("2. ");
      Put (Player2.Name(1..Player2.Length));
      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


   -- 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");
      Put ("Please make it brief and keep it under 10 characters");
      Get_Line(No1.Name, No1.Length);
      Put("What do you want to call your opponent?");
      -- 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)");
      Put ("2. Circle (O)");
      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;
      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
         for I in 1..(2*(Boardrange'Last)+1) loop
            Put (Horiz); -- Bottom boundary
         end loop; -- FOR I
      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
   begin -- PlayerMove
      Correctchoice := False; -- Initialize
      Put (Mover.Name(1..Mover.Length)); -- ask player for input
      Put (", please enter the box where you want to place your mark");
      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
         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");
         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
      -- Generate Random Values
      RowGen : RandomMove.Generator;
      ColGen : RandomMove.Generator;
      -- Initialize this value to false in the beginning      
      CorrectChoice := False;
      while not CorrectChoice loop
         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);
            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(" has won.");
      -- 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

      Put ("1. Play Again"); -- after game end, ask players
      New_Line;              -- if they want another game
      Put ("2. Quit");

      Put ("Please enter your choice");
      Get (Continuechoice);

      -- Input for ContinueChoice
      if Continuechoice = 2 then -- IF players want to quit
      end if; -- Choice = 2


   end loop; -- end ContinueChoice
end Tic_Tac_Toe;

(c) 1998-2004 All Rights Reserved David Botton