Description
A Gnoga program to play Tic-tac-toe, provide by Jeffrey R. Carter from PragmAda Software Engineering.
Source code
tic_tac_toe.ads
-- Tic_Tac_Toe: a program to play Tic-Tac-Toe
-- Copyright (C) 2016 by PragmAda Software Engineering. All rights reserved.
--
-- 2016 Aug 26 J. Carter V1.0--Initial version
--
package Tic_Tac_Toe is
pragma Pure;
end Tic_Tac_Toe;
--
-- This is free software; you can redistribute it and/or modify it under
-- terms of the GNU General Public License as published by the Free Software
-- Foundation; version 2.
-- This software is distributed in the hope that it will be useful, but WITH
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
-- for more details. Free Software Foundation, 59 Temple Place - Suite
-- 330, Boston, MA 02111-1307, USA.tic_tac_toe-ui.ads
-- Tic_Tac_Toe: a program to play Tic-Tac-Toe
-- Copyright (C) 2016 by PragmAda Software Engineering. All rights reserved.
--
-- 2016 Aug 26 J. Carter V1.0--Initial version
--
-- Tic_Tac_Toe: user interface
--
package Tic_Tac_Toe.UI is
pragma Elaborate_Body;
end Tic_Tac_Toe.UI;
--
-- This is free software; you can redistribute it and/or modify it under
-- terms of the GNU General Public License as published by the Free Software
-- Foundation; version 2.
-- This software is distributed in the hope that it will be useful, but WITH
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
-- for more details. Free Software Foundation, 59 Temple Place - Suite
-- 330, Boston, MA 02111-1307, USA.tic_tac_toe-ui.adb
-- Tic_Tac_Toe: a program to play Tic-Tac-Toe
-- Copyright (C) 2016 by PragmAda Software Engineering. All rights reserved.
--
-- 2016 Aug 26 J. Carter V1.0--Initial version
--
with Gnoga.Application.Multi_Connect;
with Gnoga.Gui.Base;
with Gnoga.Gui.Element.Common;
with Gnoga.Gui.Element.Form;
with Gnoga.Types.Colors;
with Gnoga.Gui.View.Grid;
with Gnoga.Gui.Window;
package body Tic_Tac_Toe.UI is
use Gnoga;
use all type Gnoga.String;
subtype String is Gnoga.String;
subtype Row_ID is Integer range 1 .. 3;
subtype Column_ID is Integer range 1 .. 3;
type Piece_ID is (X, O, Empty);
type Board_Set is array (Row_ID, Column_ID) of Piece_ID;
Empty_Board : constant Board_Set := (Row_ID => (Column_ID => Empty));
type Button_Set is array (Row_ID, Column_ID) of Gnoga.Gui.Element.Common.Button_Type;
subtype Square_String is String;
X_Mark : constant Square_String := "X";
O_Mark : constant Square_String := "O";
Empty_Mark : constant Square_String := " ";
type App_Info is new Gnoga.Types.Connection_Data_Type with record
Window : Gnoga.Gui.Window.Pointer_To_Window_Class;
Grid : Gnoga.Gui.View.Grid.Grid_View_Type;
Left_View : Gnoga.Gui.View.View_Type;
Right_View : Gnoga.Gui.View.View_Type;
Square : Button_Set;
Message : Gnoga.Gui.Element.Common.Span_Type;
Control : Gnoga.Gui.Element.Form.Form_Type;
Won : Gnoga.Gui.Element.Form.Text_Type;
Won_Label : Gnoga.Gui.Element.Form.Label_Type;
Lost : Gnoga.Gui.Element.Form.Text_Type;
Lost_Label : Gnoga.Gui.Element.Form.Label_Type;
Kat : Gnoga.Gui.Element.Form.Text_Type;
Kat_Label : Gnoga.Gui.Element.Form.Label_Type;
First_Check : Gnoga.Gui.Element.Form.Check_Box_Type;
First_Label : Gnoga.Gui.Element.Form.Label_Type;
Again : Gnoga.Gui.Element.Common.Button_Type;
Quit : Gnoga.Gui.Element.Common.Button_Type;
Board : Board_Set;
Player : Piece_ID := X;
Computer : Piece_ID := O;
Player_Mark : Square_String := X_Mark;
Computer_Mark : Square_String := O_Mark;
Num_Won : Natural := 0;
Num_Lost : Natural := 0;
Num_Kat : Natural := 0;
Player_Move : Natural := 0;
Computer_Move : Natural := 0;
end record;
type App_Ptr is access all App_Info;
Your_Turn : constant String := "Your turn";
You_Won : constant String := "You won";
You_Lost : constant String := "You lost";
Kat_Game : constant String := "Kat game";
package Logic is
procedure Process_Player_Move
(App : in out App_Info;
Row : in Row_ID;
Column : in Column_ID);
-- Respond to Player moving to (Row, Column)
procedure Reset (App : in out App_Info);
-- Reset the board for a new game
end Logic;
package body Logic is separate;
procedure Square_Click (Object : in out Gnoga.Gui.Base.Base_Type'Class) is
Name : constant String := Object.ID;
Row : constant Row_ID := Value (Name.Slice (Name.First, Name.First));
Column : constant Column_ID := Value (Name.Slice (Name.Last, Name.Last));
App : constant App_Ptr := App_Ptr (Object.Connection_Data);
begin -- Square_Click
Logic.Process_Player_Move (App => App.all, Row => Row, Column => Column);
end Square_Click;
procedure New_Game (Object : in out Gnoga.Gui.Base.Base_Type'Class) is
App : constant App_Ptr := App_Ptr (Object.Connection_Data);
begin -- New_Game
Logic.Reset (App => App.all);
end New_Game;
End_Message : constant String := "Tic-Tac-Toe ended.";
procedure On_Quit (Object : in out Gnoga.Gui.Base.Base_Type'Class) is
App : constant App_Ptr := App_Ptr (Object.Connection_Data);
View : Gnoga.Gui.View.View_Type;
begin -- On_Quit
App.Grid.Remove;
View.Create (Parent => App.Window.all);
View.Put_Line (Message => End_Message);
App.Window.Close;
App.Window.Close_Connection;
exception -- On_Quit
when E : others =>
Gnoga.Log (Message => "On_Quit: ", Occurrence => E);
end On_Quit;
procedure On_Connect
(Main_Window : in out Gnoga.Gui.Window.Window_Type'Class;
Connection : access Gnoga.Application.Multi_Connect.Connection_Holder_Type)
is
function Image
(Row : Row_ID;
Column : Column_ID)
return String;
-- Returns a 2-Character String of the form "RC", where
-- R is the image of Row
-- C is the image of Column
function Image
(Row : Row_ID;
Column : Column_ID)
return String
is
Row_Image : constant String := Image (Row);
Column_Image : constant String := Image (Column);
begin -- Image
return From_Unicode (Row_Image (Row_Image.Last) & Column_Image (Column_Image.Last));
end Image;
Button_Size : constant := 100;
App : constant App_Ptr := new App_Info;
begin -- On_Connect
Main_Window.Connection_Data (Data => App);
App.Window := Main_Window'Unchecked_Access;
App.Grid.Create (Parent => Main_Window, Layout => Gnoga.Gui.View.Grid.Horizontal_Split);
App.Grid.Background_Color (Enum => Gnoga.Types.Colors.Light_Blue);
App.Left_View.Create (Parent => App.Grid.Panel (1, 1).all);
App.Left_View.Background_Color (Enum => Gnoga.Types.Colors.Light_Blue);
App.Left_View.Text_Alignment (Value => Gnoga.Gui.Element.Center);
App.Board := Empty_Board;
Square_Rows :
for Row in App.Square'Range (1) loop
Square_Columns :
for Column in App.Square'Range (2) loop
App.Square (Row, Column).Create
(Parent => App.Left_View, Content => Empty_Mark, ID => On_Connect.Image (Row, Column));
App.Square (Row, Column).Overflow (Value => Gnoga.Gui.Element.Hidden);
App.Square (Row, Column).Vertical_Align (Value => Gnoga.Gui.Element.Middle);
App.Square (Row, Column).Minimum_Width (Value => Button_Size);
App.Square (Row, Column).Maximum_Width (Value => Button_Size);
App.Square (Row, Column).Minimum_Height (Value => Button_Size);
App.Square (Row, Column).Maximum_Height (Value => Button_Size);
App.Square (Row, Column).Text_Alignment (Value => Gnoga.Gui.Element.Center);
App.Square (Row, Column).Margin (Top => "1px", Right => "1px", Bottom => "1px", Left => "1px");
App.Square (Row, Column).Border (Width => "thin");
App.Square (Row, Column).Font (Height => "xx-large");
App.Square (Row, Column).Background_Color (Enum => Gnoga.Types.Colors.Yellow);
App.Square (Row, Column).On_Click_Handler (Handler => Square_Click'Access);
end loop Square_Columns;
App.Left_View.Put_HTML (HTML => "<br />");
end loop Square_Rows;
App.Message.Create (Parent => App.Left_View, Content => Your_Turn);
App.Right_View.Create (Parent => App.Grid.Panel (1, 2).all);
App.Right_View.Background_Color (Enum => Gnoga.Types.Colors.Light_Blue);
App.Control.Create (Parent => App.Right_View);
App.Control.Background_Color (Enum => Gnoga.Types.Colors.Light_Blue);
App.Control.Text_Alignment (Value => Gnoga.Gui.Element.Center);
App.Won.Create (Form => App.Control, Size => 4, Value => "0");
App.Won_Label.Create (Form => App.Control, Label_For => App.Won, Content => "Won");
App.Control.New_Line;
App.Lost.Create (Form => App.Control, Size => 4, Value => "0");
App.Lost_Label.Create (Form => App.Control, Label_For => App.Lost, Content => "Lost");
App.Control.New_Line;
App.Kat.Create (Form => App.Control, Size => 4, Value => "0");
App.Kat_Label.Create (Form => App.Control, Label_For => App.Kat, Content => "Kat");
App.Control.New_Line;
App.First_Check.Create (Form => App.Control, Checked => False);
App.First_Label.Create
(Form => App.Control, Label_For => App.First_Check, Content => "Computer moves 1st", Auto_Place => False);
App.Control.New_Line;
App.Again.Create (Parent => App.Control, Content => "New Game");
App.Again.On_Click_Handler (Handler => New_Game'Access);
App.Control.New_Line;
App.Quit.Create (Parent => App.Control, Content => "Quit");
App.Quit.On_Click_Handler (Handler => On_Quit'Access);
exception -- On_Connect
when E : others =>
Gnoga.Log (Message => "On_Connect: ", Occurrence => E);
end On_Connect;
begin -- Tic_Tac_Toe.UI
Gnoga.Application.Title (Name => "Tic-Tac-Toe");
Gnoga.Application.HTML_On_Close (HTML => End_Message);
Gnoga.Application.Multi_Connect.Initialize;
Gnoga.Application.Multi_Connect.On_Connect_Handler (Event => On_Connect'Access);
Gnoga.Application.Multi_Connect.Message_Loop;
exception -- Tic_Tac_Toe.UI
when E : others =>
Gnoga.Log (E);
end Tic_Tac_Toe.UI;
--
-- This is free software; you can redistribute it and/or modify it under
-- terms of the GNU General Public License as published by the Free Software
-- Foundation; version 2.
-- This software is distributed in the hope that it will be useful, but WITH
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
-- for more details. Free Software Foundation, 59 Temple Place - Suite
-- 330, Boston, MA 02111-1307, USA.tic_tac_toe-ui-logic.adb
-- Tic_Tac_Toe: a program to play Tic-Tac-Toe
-- Copyright (C) 2016 by PragmAda Software Engineering. All rights reserved.
--
-- 2016 Aug 26 J. Carter V1.0--Initial version
--
separate (Tic_Tac_Toe.UI)
package body Logic is
procedure Process_Player_Move
(App : in out App_Info;
Row : in Row_ID;
Column : in Column_ID)
is
procedure Disable_All (App : in out App_Info);
-- Disables all the board squares
procedure Enable_Empty (App : in out App_Info);
-- Enables board squares that are empty
function Game_Won
(App : App_Info)
return Boolean;
-- Returns True if (Row, Column) results in a row, column, or diagonal with 3 of App.Player in a row; False otherwise
function Count_Row
(App : App_Info;
Row : Row_ID;
Value : Piece_ID)
return Natural;
-- Returns the number of squares in Row with value Value
function Count_Column
(App : App_Info;
Column : Column_ID;
Value : Piece_ID)
return Natural;
-- Returns the number of squares in Column with value Value
function Count_UL_Diag
(App : App_Info;
Value : Piece_ID)
return Natural;
-- Returns the number of squares in the UL-LR diagonal with value Value
function Count_UR_Diag
(App : App_Info;
Value : Piece_ID)
return Natural;
-- Returns the number of squares in the UR-LL diagonal with value Value
procedure Computer_Move
(App : in out App_Info;
Won : out Boolean);
-- Chooses and makes Computer's move
-- Won is True if this move causes Computer to win; False otherwise
procedure Disable_All (App : in out App_Info) is
-- Empty
begin -- Disable_All
All_Rows :
for Row in App.Square'Range (1) loop
All_Columns :
for Column in App.Square'Range (2) loop
App.Square (Row, Column).Disabled;
end loop All_Columns;
end loop All_Rows;
end Disable_All;
procedure Enable_Empty (App : in out App_Info) is
-- Empty
begin -- Enable_Empty
All_Rows :
for Row in App.Square'Range (1) loop
All_Columns :
for Column in App.Square'Range (2) loop
if App.Board (Row, Column) = Empty then
App.Square (Row, Column).Disabled (Value => False);
end if;
end loop All_Columns;
end loop All_Rows;
end Enable_Empty;
function Game_Won
(App : App_Info)
return Boolean
is
Count : Natural := Count_Row (App, Row, App.Player);
begin -- Game_Won
if Count = 3 then
return True;
end if;
Count := Count_Column (App, Column, App.Player);
if Count = 3 then
return True;
end if;
if Row = Column then -- On UL-LR diagonal
Count := Count_UL_Diag (App, App.Player);
if Count = 3 then
return True;
end if;
end if;
if (Row = 1 and Column = 3) or (Row = 2 and Column = 2) or (Row = 3 and Column = 1) then -- On UR-LL diagonal
Count := Count_UR_Diag (App, App.Player);
return Count = 3;
end if;
return False;
end Game_Won;
function Count_Row
(App : App_Info;
Row : Row_ID;
Value : Piece_ID)
return Natural
is
Result : Natural := 0;
begin -- Count_Row
All_Columns :
for Column in App.Board'Range (2) loop
if App.Board (Row, Column) = Value then
Result := Result + 1;
end if;
end loop All_Columns;
return Result;
end Count_Row;
function Count_Column
(App : App_Info;
Column : Column_ID;
Value : Piece_ID)
return Natural
is
Result : Natural := 0;
begin -- Count_Column
All_Rows :
for Row in App.Board'Range (1) loop
if App.Board (Row, Column) = Value then
Result := Result + 1;
end if;
end loop All_Rows;
return Result;
end Count_Column;
function Count_UL_Diag
(App : App_Info;
Value : Piece_ID)
return Natural
is
Result : Natural := 0;
begin -- Count_UL_Diag
Count :
for RC in App.Board'Range (1) loop
if App.Board (RC, RC) = Value then
Result := Result + 1;
end if;
end loop Count;
return Result;
end Count_UL_Diag;
function Count_UR_Diag
(App : App_Info;
Value : Piece_ID)
return Natural
is
Result : Natural := 0;
Column : Column_ID := Column_ID'Last;
begin -- Count_UR_Diag
Count :
for Row in App.Board'Range (1) loop
if App.Board (Row, Column) = Value then
Result := Result + 1;
end if;
if Column > Column_ID'First then
Column := Column - 1;
end if;
end loop Count;
return Result;
end Count_UR_Diag;
procedure Computer_Move
(App : in out App_Info;
Won : out Boolean)
is
type Count_Set is array (Row_ID, Column_ID) of Natural;
procedure Find_Winning_Move
(App : in out App_Info;
Won : out Boolean);
-- If there's a winning move, makes it and sets Won to True
-- Otherwise, sets Won to False
procedure Block_Player
(App : in out App_Info;
Moved : out Boolean);
-- If Player can win, moves to block and sets Moved to True
-- Otherwise, sets Moved to False
procedure Check_Special_Cases
(App : in out App_Info;
Moved : out Boolean);
-- If any of the special cases apply, makes the correct move and sets Moved to True
-- Otherwise, sets Moved to False
--
-- These replace the heuristic "prevent Player from getting 2 in a row in more than one direction"
-- Except for 6 cases on the Computer's 2nd move when Player is X and the Computer has moved in the center, this is
-- accomplished by the other heuristics, so it's easier to just check those special cases
function Board_Count
(App : App_Info)
return Count_Set;
-- Returns the number of directions Computer can get 2 in a row for each square
procedure Make_2_In_A_Row
(App : in out App_Info;
Count : in Count_Set;
Moved : out Boolean);
-- If Computer can make 2 in a row, makes that move
procedure Move_Empty (App : in out App_Info);
-- Finds an empty square and moves there
procedure Find_Winning_Move
(App : in out App_Info;
Won : out Boolean)
is
-- Empty
begin -- Find_Winning_Move
Won := False;
if App.Computer_Move <= 2 then
return;
end if;
Win_Rows :
for Row in App.Board'Range (1) loop
Win_Columns :
for Column in App.Board'Range (2) loop
if App.Board (Row, Column) = Empty then
if Count_Row (App, Row, App.Computer) = 2 or Count_Column (App, Column, App.Computer) = 2 then
App.Board (Row, Column) := App.Computer;
App.Square (Row, Column).Text (Value => App.Computer_Mark);
Won := True;
return;
end if;
if Row = Column and then Count_UL_Diag (App, App.Computer) = 2 then -- On UL-LR diagonal
App.Board (Row, Column) := App.Computer;
App.Square (Row, Column).Text (Value => App.Computer_Mark);
Won := True;
return;
end if;
if ((Row = 1 and Column = 3) or (Row = 2 and Column = 2) or (Row = 3 and Column = 1))
and then Count_UR_Diag (App, App.Computer) = 2 -- On UR-LL diagonal
then
App.Board (Row, Column) := App.Computer;
App.Square (Row, Column).Text (Value => App.Computer_Mark);
Won := True;
return;
end if;
end if;
end loop Win_Columns;
end loop Win_Rows;
end Find_Winning_Move;
procedure Block_Player
(App : in out App_Info;
Moved : out Boolean)
is
-- Empty
begin -- Block_Player
Moved := False;
if App.Player_Move <= 1 then
return;
end if;
Block_Rows :
for Row in App.Board'Range (1) loop
Block_Columns :
for Column in App.Board'Range (2) loop
if App.Board (Row, Column) = Empty then
if Count_Row (App, Row, App.Player) = 2 or else Count_Column (App, Column, App.Player) = 2
or else (Row = Column and then Count_UL_Diag (App, App.Player) = 2)
or else -- On UL-LR diagonal
(((Row = 1 and Column = 3) or (Row = 2 and Column = 2) or (Row = 3 and Column = 1))
and then Count_UR_Diag (App, App.Player) = 2) -- On UR-LL diagonal
then
App.Board (Row, Column) := App.Computer;
App.Square (Row, Column).Text (Value => App.Computer_Mark);
Moved := True;
return;
end if;
end if;
end loop Block_Columns;
end loop Block_Rows;
end Block_Player;
procedure Check_Special_Cases
(App : in out App_Info;
Moved : out Boolean)
is
-- Empty
begin -- Check_Special_Cases
Moved := False;
if App.Computer_Move /= 2 or App.Board (2, 2) /= App.Computer or App.Player /= X then
return;
end if;
if (App.Board (1, 1) = App.Player and App.Board (3, 3) = App.Player) or
(App.Board (1, 3) = App.Player and App.Board (3, 1) = App.Player)
then
App.Board (1, 2) := App.Computer;
App.Square (1, 2).Text (Value => App.Computer_Mark);
Moved := True;
return;
end if;
if App.Board (1, 1) = App.Player and App.Board (3, 2) = App.Player then
App.Board (3, 1) := App.Computer;
App.Square (3, 1).Text (Value => App.Computer_Mark);
Moved := True;
return;
end if;
if (App.Board (1, 3) = App.Player and App.Board (3, 2) = App.Player) or
(App.Board (2, 3) = App.Player and App.Board (3, 2) = App.Player)
then
App.Board (3, 3) := App.Computer;
App.Square (3, 3).Text (Value => App.Computer_Mark);
Moved := True;
return;
end if;
if App.Board (2, 1) = App.Player and App.Board (3, 3) = App.Player then
App.Board (3, 1) := App.Computer;
App.Square (3, 1).Text (Value => App.Computer_Mark);
Moved := True;
end if;
end Check_Special_Cases;
function Board_Count
(App : App_Info)
return Count_Set
is
Count : Count_Set := (Row_ID => (Column_ID => 0));
begin -- Board_Count
Count_Rows :
for Row in App.Board'Range (1) loop
Count_Columns :
for Column in App.Board'Range (2) loop
if App.Board (Row, Column) = Empty then
if Count_Row (App, Row, App.Computer) = 1 and then Count_Row (App, Row, Empty) = 2 then
Count (Row, Column) := Count (Row, Column) + 1;
end if;
if Count_Column (App, Column, App.Computer) = 1 and then Count_Column (App, Column, Empty) = 2 then
Count (Row, Column) := Count (Row, Column) + 1;
end if;
if Row = Column and then Count_UL_Diag (App, App.Computer) = 1
and then Count_UL_Diag (App, Empty) = 2
then
Count (Row, Column) := Count (Row, Column) + 1;
end if;
if ((Row = 1 and Column = 3) or (Row = 2 and Column = 2) or (Row = 3 and Column = 1))
and then Count_UR_Diag (App, App.Computer) = 1 and then Count_UR_Diag (App, Empty) = 2
then
Count (Row, Column) := Count (Row, Column) + 1;
end if;
end if;
end loop Count_Columns;
end loop Count_Rows;
return Count;
end Board_Count;
procedure Make_2_In_A_Row
(App : in out App_Info;
Count : in Count_Set;
Moved : out Boolean)
is
procedure Move_If_2
(App : in out App_Info;
Count : in Count_Set;
Row : in Row_ID;
Column : in Column_ID;
Moved : out Boolean);
-- If (Row, Column) is empty and makes 2 in a row for Computer, moves there and sets Moved to True
-- Otherwise, sets Moved to False
procedure Move_If_2
(App : in out App_Info;
Count : in Count_Set;
Row : in Row_ID;
Column : in Column_ID;
Moved : out Boolean)
is
-- Empty
begin -- Move_If_2
Moved := False;
if Count (Row, Column) > 0 and App.Board (Row, Column) = Empty then
App.Board (Row, Column) := App.Computer;
App.Square (Row, Column).Text (Value => App.Computer_Mark);
Moved := True;
end if;
end Move_If_2;
begin -- Make_2_In_A_Row
Move_If_2 (App => App, Count => Count, Row => 2, Column => 2, Moved => Moved); -- Center is best
if Moved then
return;
end if;
Move_If_2 (App => App, Count => Count, Row => 1, Column => 1, Moved => Moved); -- Corners 2nd best
if Moved then
return;
end if;
Move_If_2 (App => App, Count => Count, Row => 1, Column => 3, Moved => Moved);
if Moved then
return;
end if;
Move_If_2 (App => App, Count => Count, Row => 3, Column => 1, Moved => Moved);
if Moved then
return;
end if;
Move_If_2 (App => App, Count => Count, Row => 3, Column => 3, Moved => Moved);
if Moved then
return;
end if;
Move_If_2 (App => App, Count => Count, Row => 1, Column => 2, Moved => Moved); -- Edge last choice
if Moved then
return;
end if;
Move_If_2 (App => App, Count => Count, Row => 2, Column => 1, Moved => Moved);
if Moved then
return;
end if;
Move_If_2 (App => App, Count => Count, Row => 2, Column => 3, Moved => Moved);
if Moved then
return;
end if;
Move_If_2 (App => App, Count => Count, Row => 3, Column => 2, Moved => Moved);
end Make_2_In_A_Row;
procedure Move_Empty (App : in out App_Info) is
procedure Move_If_Empty
(App : in out App_Info;
Row : in Row_ID;
Column : in Column_ID;
Moved : out Boolean);
-- If (Row, Column) is empty, moves there and sets Moved to True; otherwise, sets Moved to False
procedure Move_If_Empty
(App : in out App_Info;
Row : in Row_ID;
Column : in Column_ID;
Moved : out Boolean)
is
-- Empty
begin -- Move_If_Empty
Moved := False;
if App.Board (Row, Column) = Empty then
App.Board (Row, Column) := App.Computer;
App.Square (Row, Column).Text (Value => App.Computer_Mark);
Moved := True;
end if;
end Move_If_Empty;
Moved : Boolean;
begin -- Move_Empty
Move_If_Empty (App => App, Row => 2, Column => 2, Moved => Moved); -- Move in the center if possible
if Moved then
return;
end if;
Move_If_Empty (App => App, Row => 1, Column => 1, Moved => Moved); -- Move in a corner if possible
if Moved then
return;
end if;
Move_If_Empty (App => App, Row => 1, Column => 3, Moved => Moved);
if Moved then
return;
end if;
Move_If_Empty (App => App, Row => 3, Column => 1, Moved => Moved);
if Moved then
return;
end if;
Move_If_Empty (App => App, Row => 3, Column => 3, Moved => Moved);
if Moved then
return;
end if;
Move_If_Empty (App => App, Row => 1, Column => 2, Moved => Moved); -- Move to an edge otherwise
if Moved then
return;
end if;
Move_If_Empty (App => App, Row => 2, Column => 1, Moved => Moved);
if Moved then
return;
end if;
Move_If_Empty (App => App, Row => 2, Column => 3, Moved => Moved);
if Moved then
return;
end if;
Move_If_Empty (App => App, Row => 3, Column => 2, Moved => Moved);
if not Moved then
raise Program_Error with "Move_Empty: impossible";
end if;
end Move_Empty;
Moved : Boolean;
Count : Count_Set;
begin -- Computer_Move
App.Computer_Move := App.Computer_Move + 1;
Find_Winning_Move (App => App, Won => Won); -- See if Computer can win
if Won then
return;
end if;
Block_Player (App => App, Moved => Moved); -- See if Player will win if not blocked
if Moved then
return;
end if;
Check_Special_Cases
(App => App, Moved => Moved); -- Prevent Player from getting 2 in a row in more than one direction
if Moved then
return;
end if;
if App.Computer_Move > 1
then -- Count the # of directions that a move in each square gives 2 computer and 1 empty
Count := Board_Count (App);
Force_Rows :
for Row in App.Board'Range (1) loop -- If any count > 1 then Computer can force a win
Force_Columns :
for Column in App.Board'Range (2) loop
if Count (Row, Column) > 1 then
App.Board (Row, Column) := App.Computer;
App.Square (Row, Column).Text (Value => App.Computer_Mark);
return;
end if;
end loop Force_Columns;
end loop Force_Rows;
-- Moving to make 2 in a row forces PLayer to block
Make_2_In_A_Row (App => App, Count => Count, Moved => Moved);
if Moved then
return;
end if;
end if;
Move_Empty (App => App); -- No moves that make 2 in a row, so move to an empty square
end Computer_Move;
Won : Boolean;
begin -- Process_Player_Move
Disable_All (App => App);
App.Player_Move := App.Player_Move + 1;
App.Message.Text (Value => "");
App.Board (Row, Column) := App.Player;
App.Square (Row, Column).Text (Value => App.Player_Mark);
if Game_Won (App) then
App.Num_Won := App.Num_Won + 1;
App.Won.Value (Value => App.Num_Won);
App.Message.Text (Value => You_Won);
return;
end if;
if App.Player_Move >= 5 and then App.Player = X then -- Player moved 1st, didn't win, no more moves, so kat
App.Num_Kat := App.Num_Kat + 1;
App.Kat.Value (Value => App.Num_Kat);
App.Message.Text (Value => Kat_Game);
return;
end if;
Computer_Move (App => App, Won => Won);
if Won then -- Computer won, Player lost
App.Num_Lost := App.Num_Lost + 1;
App.Lost.Value (Value => App.Num_Lost);
App.Message.Text (Value => You_Lost);
return;
end if;
if App.Computer_Move >= 5 and then App.Computer = X then -- Comuter moved 1st, didn't win, no more moves, so kat
App.Num_Kat := App.Num_Kat + 1;
App.Kat.Value (Value => App.Num_Kat);
App.Message.Text (Value => Kat_Game);
return;
end if;
Enable_Empty (App => App);
App.Message.Text (Value => Your_Turn);
exception -- Process_Player_Move
when E : others =>
Gnoga.Log (Message => "Process_Player_Move: ", Occurrence => E);
end Process_Player_Move;
procedure Reset (App : in out App_Info) is
-- Empty
begin -- Reset
All_Rows :
for Row in App.Square'Range (1) loop
All_Columns :
for Column in App.Square'Range (2) loop
App.Square (Row, Column).Text (Value => Empty_Mark);
App.Square (Row, Column).Disabled (Value => False);
end loop All_Columns;
end loop All_Rows;
App.Player_Move := 0;
App.Computer_Move := 0;
App.Board := Empty_Board;
App.Message.Text (Value => Your_Turn);
if not App.First_Check.Checked then
App.Player := X;
App.Player_Mark := X_Mark;
App.Computer := O;
App.Computer_Mark := O_Mark;
else
App.Player := O;
App.Player_Mark := O_Mark;
App.Computer := X;
App.Computer_Mark := X_Mark;
App.Board (2, 2) := App.Computer;
App.Square (2, 2).Text (Value => App.Computer_Mark);
App.Square (2, 2).Disabled;
App.Computer_Move := 1;
end if;
exception -- Reset
when E : others =>
Gnoga.Log (Message => "Reset: ", Occurrence => E);
end Reset;
end Logic;
--
-- This is free software; you can redistribute it and/or modify it under
-- terms of the GNU General Public License as published by the Free Software
-- Foundation; version 2.
-- This software is distributed in the hope that it will be useful, but WITH
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
-- for more details. Free Software Foundation, 59 Temple Place - Suite
-- 330, Boston, MA 02111-1307, USA.
tic_tac_toe-program.adb
-- Tic_Tac_Toe: a program to play Tic-Tac-Toe
-- Copyright (C) 2016 by PragmAda Software Engineering. All rights reserved.
--
-- 2016 Aug 26 J. Carter V1.0--Initial version
--
-- Tic_Tac_Toe: main program procedure
--
with Tic_Tac_Toe.UI;
procedure Tic_Tac_Toe.Program is
-- Empty
begin -- Tic_Tac_Toe.Program
null;
end Tic_Tac_Toe.Program;
--
-- This is free software; you can redistribute it and/or modify it under
-- terms of the GNU General Public License as published by the Free Software
-- Foundation; version 2.
-- This software is distributed in the hope that it will be useful, but WITH
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
-- for more details. Free Software Foundation, 59 Temple Place - Suite
-- 330, Boston, MA 02111-1307, USA.Project file
with "settings.gpr";
with "gnoga.gpr";
project Tic_Tac_Toe is
for Object_Dir use Settings.Obj_Dir;
for Exec_Dir use Settings.Exe_Dir;
for Main use ("tic_tac_toe-program.adb");
for Create_Missing_Dirs use Settings'Create_Missing_Dirs;
package Builder is
for Executable ("tic_tac_toe-program.adb") use "tic_tac_toe";
end Builder;
package Compiler is
for Default_Switches ("Ada") use Settings.Compiler'Default_Switches ("Ada") & "-gnatyN";
end Compiler;
package Binder renames Settings.Binder;
package Linker renames Settings.Linker;
package Pretty_Printer renames Settings.Pretty_Printer;
end Tic_Tac_Toe;