Description
The object of Mine Detector is to mark all cells containing mines and to step on all cells that do not contain a mine. There is at most one mine per cell. Each cell displays the total number of mines in itself and in the adjacent cells.
Unlike other mine-finding games, this game, provide by Jeffrey R. Carter from PragmAda Software Engineering, never requires guessing and is a intellectually challenging game
The GtkAda version of Mine Detector is now maintained by Pascal Malaise.
Source code
field.ads
-- Mine Detector Game
-- Copyright (C) 2014 by PragmAda Software Engineering. All rights reserved.
-- **************************************************************************
--
-- Encapsulates the definition of the mine field
--
-- V7.1 2014 Dec 10 Protected field-updating operations
-- V7.0 2014 Dec 01 First Gnoga version
--
with Gnoga.Types;
package Field is
subtype Valid_Row is Positive range 1 .. 16; -- Size of the mine field
subtype Valid_Column is Positive range 1 .. 30;
type Cell_Location is record
Row : Valid_Row := 1;
Column : Valid_Column := 1;
end record;
subtype Valid_Count is Natural range 0 .. 9; -- Count of # of mines in a cell & its neighbors
type Field_Info (App_Data : Gnoga.Types.Pointer_to_Connection_Data_Class) is limited private;
private -- Field
subtype Row_Id is Integer range Valid_Row'First - 1 .. Valid_Row'Last + 1; -- Row around field makes things easier
subtype Column_Id is Integer range Valid_Column'First - 1 .. Valid_Column'Last + 1;
type State_Id is (Normal, Marked, Stepped_On); -- Possible states of a cell
subtype Count_Value is Integer range Valid_Count'First - 1 .. Valid_Count'Last; -- Extra value means not yet counted
type Cell_Info is record
State : State_Id := Normal;
Mine : Boolean := False;
Count : Count_Value := Count_Value'First;
Stepped : Boolean := False;
end record;
type Field_Set is array (Row_Id, Column_Id) of Cell_Info; -- A mine field
type Field_Info (App_Data : Gnoga.Types.Pointer_to_Connection_Data_Class) is record
Num_Mines : Natural := 0; -- Changed when first game is started.
Mine_Field : Field_Set;
Dead : Boolean := False;
To_Mark : Integer := 0;
Step_Count : Natural := 0;
end record;
end Field;
--
-- 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.fiels_operations.ads
-- Mine Detector Game
-- Copyright (C) 2014 by PragmAda Software Engineering. All rights reserved.
-- **************************************************************************
--
-- Encapsulates the operations on the mine field
--
-- V7.0 2014 Dec 01 First Gnoga version
--
package Field.Operations is
procedure Reset (Field : in out Field_Info);
-- Reset the mine field to its initial condition
procedure Mark
(Field : in out Field_Info;
Cell : in Cell_Location);
-- Mark a cell as having a mine, or unmark a marked cell
procedure Step
(Field : in out Field_Info;
Cell : in Cell_Location);
-- Step on a cell
type Game_State_ID is (In_Progress, Won, Lost);
function Game_State
(Field : Field_Info)
return Game_State_ID;
procedure Set_Mine_Count
(Field : in out Field_Info;
New_Mine_Count : in Natural);
-- Takes effect the next time a game is created.
end Field.Operations;
--
-- 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.
field-operations.adb
-- Mine Detector Game
-- Copyright (C) 2016 by PragmAda Software Engineering. All rights reserved.
-- **************************************************************************
--
-- v7.2 2016 May 15 Speed improvement
-- v7.1 2016 Feb 15 Cleaned up unreferenced packages and variables that are not modified
-- V7.0 2014 Dec 01 First Gnoga version
--
with Ada.Numerics.Discrete_Random;
with User_IF;
package body Field.Operations is
procedure Detect
(Field : in out Field_Info;
Cell : in Cell_Location)
is
-- null;
begin -- Detect
if Field.Dead then
return;
end if;
if Field.Mine_Field (Cell.Row, Cell.Column).State = Marked then
return; -- Can't count a marked cell
end if;
if Field.Mine_Field (Cell.Row, Cell.Column).Count not in Valid_Count then -- Cell has not been counted
Field.Mine_Field (Cell.Row, Cell.Column).Count := 0;
Count_Rows :
for Row in Cell.Row - 1 .. Cell.Row + 1 loop
Count_Columns :
for Column in Cell.Column - 1 .. Cell.Column + 1 loop
if Field.Mine_Field (Row, Column).Mine then
Field.Mine_Field (Cell.Row, Cell.Column).Count := Field.Mine_Field (Cell.Row, Cell.Column).Count + 1;
end if;
end loop Count_Columns;
end loop Count_Rows;
User_IF.Display_Count
(Data => Field.App_Data, Count => Field.Mine_Field (Cell.Row, Cell.Column).Count,
Stepped => Field.Mine_Field (Cell.Row, Cell.Column).State = Stepped_On, Cell => Cell);
end if;
end Detect;
procedure Set_Mine_Count
(Field : in out Field_Info;
New_Mine_Count : in Natural)
is
-- null;
begin -- Set_Mine_Count
Field.Num_Mines := New_Mine_Count;
end Set_Mine_Count;
procedure Reset (Field : in out Field_Info) is
subtype Rand_Set_Index is Integer range 1 .. Valid_Row'Last * Valid_Column'Last;
type Rand_Set is array (Rand_Set_Index) of Cell_Location; -- For randomly placing mines
package Random is new Ada.Numerics.Discrete_Random (Rand_Set_Index);
Rand_List : Rand_Set;
Index : Positive := Positive'Last;
Gen : Random.Generator;
Temp : Cell_Location;
begin -- Reset
Field.Dead := False;
Field.Mine_Field :=
Field_Set'
(others =>
(others => Cell_Info'(State => Normal, Mine => False, Count => Count_Value'First, Stepped => False)));
Field.To_Mark := Field.Num_Mines;
Field.Step_Count := 0;
-- Set the extra ring around the field to stepped_on
Step_On_Sides :
for Row in Field.Mine_Field'range (1) loop
Field.Mine_Field (Row, Field.Mine_Field'First (2)).State := Stepped_On;
Field.Mine_Field (Row, Field.Mine_Field'Last (2)).State := Stepped_On;
end loop Step_On_Sides;
Step_On_Top_Bottom :
for Column in Field.Mine_Field'range (2) loop
Field.Mine_Field (Field.Mine_Field'First (1), Column).State := Stepped_On;
Field.Mine_Field (Field.Mine_Field'Last (1), Column).State := Stepped_On;
end loop Step_On_Top_Bottom;
-- Fill Rand_List with all cell locations in preparation for placing mines
Fill_Rows :
for Row in Valid_Row loop
Fill_Columns :
for Column in Valid_Column loop
Rand_List (Valid_Column'Last * (Row - 1) + Column) := Cell_Location'(Row => Row, Column => Column);
end loop Fill_Columns;
end loop Fill_Rows;
Random.Reset (Gen);
-- Shuffle Rand_List, a list of cell locations
Shuffle :
for I in Rand_List'range loop
Index := Random.Random (Gen);
Temp := Rand_List (I);
Rand_List (I) := Rand_List (Index);
Rand_List (Index) := Temp;
end loop Shuffle;
-- Put mines in the first Num_Mines locations in Rand_List
Set_Mines :
for I in 1 .. Field.Num_Mines loop
Field.Mine_Field (Rand_List (I).Row, Rand_List (I).Column).Mine := True;
end loop Set_Mines;
-- Display the mine field
User_IF.Reset_Screen (Field.App_Data);
Display_Rows :
for Row in Valid_Row loop
Display_Columns :
for Column in Valid_Column loop
if Row = Valid_Row'First or else Row = Valid_Row'Last or else Column = Valid_Column'First
or else Column = Valid_Column'Last
then -- Cell is on the edge; automatically count these for the player
Detect (Field => Field, Cell => Cell_Location'(Row => Row, Column => Column));
end if;
end loop Display_Columns;
end loop Display_Rows;
User_IF.Display_To_Go (Data => Field.App_Data, To_Go => Field.To_Mark);
end Reset;
function Stepped_On_Neighbor
(Field : Field_Info;
Cell : Cell_Location)
return Boolean
is
-- See if a cell has a stepped-on neighbor
-- null;
begin -- Stepped_On_Neighbor
Check_Row :
for Row in Cell.Row - 1 .. Cell.Row + 1 loop
Check_Column :
for Column in Cell.Column - 1 .. Cell.Column + 1 loop
if (Row /= Cell.Row or else Column /= Cell.Column)
and then Field.Mine_Field (Row, Column).State = Stepped_On
then
return True;
end if;
end loop Check_Column;
end loop Check_Row;
return False;
end Stepped_On_Neighbor;
function Marked_Neighbor
(Field : Field_Info;
Cell : Cell_Location)
return Boolean
is -- See if a cell has a marked neighbor
-- null;
begin -- Marked_Neighbor
Check_Row :
for Row in Cell.Row - 1 .. Cell.Row + 1 loop
Check_Column :
for Column in Cell.Column - 1 .. Cell.Column + 1 loop
if (Row /= Cell.Row or else Column /= Cell.Column) and then Field.Mine_Field (Row, Column).State = Marked
then
return True;
end if;
end loop Check_Column;
end loop Check_Row;
return False;
end Marked_Neighbor;
function Num_Marked_Neighbors
(Field : Field_Info;
Cell : Cell_Location)
return Valid_Count
is
Result : Valid_Count := 0;
begin -- Num_Marked_Neighbors
Count_Rows :
for Row in Cell.Row - 1 .. Cell.Row + 1 loop
if Row in Valid_Row then
Count_Columns :
for Column in Cell.Column - 1 .. Cell.Column + 1 loop
if Column in Valid_Column and then Field.Mine_Field (Row, Column).State = Marked then
Result := Result + 1;
end if;
end loop Count_Columns;
end if;
end loop Count_Rows;
return Result;
end Num_Marked_Neighbors;
function Mark_Count_Satisfied
(Field : Field_Info;
Cell : Cell_Location)
return Boolean
is
-- null;
begin -- Mark_Count_Satisfied
return Field.Mine_Field (Cell.Row, Cell.Column).Count = Num_Marked_Neighbors (Field, Cell);
end Mark_Count_Satisfied;
procedure Auto_Step
(Field : in out Field_Info;
Cell : in Cell_Location)
is -- Doug's version
-- Automatically step on any (unstepped-upon) neighbors of Cell if:
-- (1) Cell has as many marked neighbors its count, or
-- (2) the neighbor has as many marked neighbors as its count.
Cell_Satisfied : constant Boolean := Mark_Count_Satisfied (Field, Cell);
begin -- Auto_Step
Step_Rows :
for Row in Cell.Row - 1 .. Cell.Row + 1 loop
if Row in Valid_Row then
Step_Columns :
for Column in Cell.Column - 1 .. Cell.Column + 1 loop
if Column in Valid_Column and then Field.Mine_Field (Row, Column).State /= Marked then
if Cell_Satisfied or Mark_Count_Satisfied (Field, (Row => Row, Column => Column)) then
Step (Field => Field, Cell => (Row => Row, Column => Column));
end if;
end if;
end loop Step_Columns;
end if;
end loop Step_Rows;
end Auto_Step;
procedure Mark
(Field : in out Field_Info;
Cell : in Cell_Location)
is
Old_State : constant State_Id := Field.Mine_Field (Cell.Row, Cell.Column).State;
begin -- Mark
if Field.Dead then
return;
end if;
if Stepped_On_Neighbor (Field, Cell) or else Marked_Neighbor (Field, Cell) then
Field.Mine_Field (Cell.Row, Cell.Column).State := Marked; -- Force detect to count cell's neighbors
Count_Rows :
for Row in Cell.Row - 1 .. Cell.Row + 1 loop -- Automatically detect around marked cell
if Row in Valid_Row then
Count_Columns :
for Column in Cell.Column - 1 .. Cell.Column + 1 loop
if Column in Valid_Column then
Detect (Field => Field, Cell => Cell_Location'(Row => Row, Column => Column));
end if;
end loop Count_Columns;
end if;
end loop Count_Rows;
Field.Mine_Field (Cell.Row, Cell.Column).State := Old_State;
case Old_State is
when Normal => -- Mark it
Field.Mine_Field (Cell.Row, Cell.Column).State := Marked;
User_IF.Display_Mark (Data => Field.App_Data, Cell => Cell);
Field.To_Mark := Field.To_Mark - 1;
when Marked => -- Unmark it
Field.Mine_Field (Cell.Row, Cell.Column).State := Normal;
User_IF.Display_Count
(Data => Field.App_Data, Count => Field.Mine_Field (Cell.Row, Cell.Column).Count,
Stepped => Field.Mine_Field (Cell.Row, Cell.Column).State = Stepped_On, Cell => Cell);
Field.To_Mark := Field.To_Mark + 1;
when Stepped_On =>
null; -- Can't marked a stepped-on cell
end case;
User_IF.Display_To_Go (Data => Field.App_Data, To_Go => Field.To_Mark);
if User_IF.Extended_Stepping (Field.App_Data) then
Auto_Step (Field => Field, Cell => Cell);
end if;
end if;
end Mark;
procedure Step
(Field : in out Field_Info;
Cell : in Cell_Location)
is
function Num_Normal_Neighbors
(Cell : Cell_Location)
return Valid_Count
is
Result : Valid_Count := 0;
begin -- Num_Normal_Neighbors
Count_Rows :
for Row in Cell.Row - 1 .. Cell.Row + 1 loop
if Row in Valid_Row then
Count_Columns :
for Column in Cell.Column - 1 .. Cell.Column + 1 loop
if Column in Valid_Column and then Field.Mine_Field (Row, Column).State = Normal then
Result := Result + 1;
end if;
end loop Count_Columns;
end if;
end loop Count_Rows;
return Result;
end Num_Normal_Neighbors;
begin -- Step
if Field.Dead then
return;
end if;
if Field.Mine_Field (Cell.Row, Cell.Column).State = Marked then
User_IF.Display_Mark (Data => Field.App_Data, Cell => Cell);
return;
end if;
if Field.Mine_Field (Cell.Row, Cell.Column).Stepped then -- Avoid inifinite recursion.
return;
end if;
if not Stepped_On_Neighbor (Field, Cell) and then not Marked_Neighbor (Field, Cell) then
User_IF.Display_Blank (Data => Field.App_Data, Cell => Cell);
else
Field.Step_Count := Field.Step_Count + 1;
Field.Mine_Field (Cell.Row, Cell.Column).State := Stepped_On;
Field.Mine_Field (Cell.Row, Cell.Column).Stepped := True;
Count_Rows :
for Row in Cell.Row - 1 .. Cell.Row + 1 loop -- Automatically detect around stepped-on cell
if Row in Valid_Row then
Count_Columns :
for Column in Cell.Column - 1 .. Cell.Column + 1 loop
if Column in Valid_Column then
Detect (Field => Field, Cell => Cell_Location'(Row => Row, Column => Column));
end if;
end loop Count_Columns;
end if;
end loop Count_Rows;
if Field.Mine_Field (Cell.Row, Cell.Column).Mine then -- Stepped on a mine!
Field.Dead := True;
User_IF.Display_Mine (Data => Field.App_Data, Cell => Cell);
return;
end if;
User_IF.Display_Count
(Data => Field.App_Data, Count => Field.Mine_Field (Cell.Row, Cell.Column).Count,
Stepped => Field.Mine_Field (Cell.Row, Cell.Column).State = Stepped_On, Cell => Cell);
Auto_Step (Field => Field, Cell => Cell);
if Field.Dead then
return;
end if;
if User_IF.Auto_Marking (Field.App_Data) then
-- See if stepping here has created any normal cells that obviously contain mines;
-- if so, mark them.
if Field.Mine_Field (Cell.Row, Cell.Column).Count - Num_Marked_Neighbors (Field, Cell) =
Num_Normal_Neighbors (Cell)
then
Mark_Rows :
for Row in Cell.Row - 1 .. Cell.Row + 1 loop
Mark_Columns :
for Column in Cell.Column - 1 .. Cell.Column + 1 loop
if Field.Mine_Field (Row, Column).State = Normal then
Mark (Field => Field, Cell => (Row => Row, Column => Column));
end if;
end loop Mark_Columns;
end loop Mark_Rows;
end if;
end if;
Field.Step_Count := Field.Step_Count - 1;
if Field.Step_Count <= 0 then
Release_Rows :
for Row in Valid_Row loop
Release_Columns :
for Column in Valid_Column loop
Field.Mine_Field (Row, Column).Stepped := False;
end loop Release_Columns;
end loop Release_Rows;
end if;
end if;
end Step;
-- The game is Lost when a mine has been stepped on, Won when all mines have been marked & all other cells stepped on,
-- and In_Progress otherwise
function Game_State
(Field : Field_Info)
return Game_State_ID
is
-- null;
begin -- Game_State
if Field.Dead then -- A mine has been stepped on
return Lost;
end if;
Check_Rows :
for Row in Valid_Row loop
Check_Columns :
for Column in Valid_Column loop
if Field.Mine_Field (Row, Column).State = Normal
or else (Field.Mine_Field (Row, Column).State = Marked) /= Field.Mine_Field (Row, Column).Mine
then
return In_Progress;
end if;
end loop Check_Columns;
end loop Check_Rows;
return Won;
end Game_State;
end Field.Operations;
--
-- 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.
user_if.ads
-- Mine Detector Game
-- Copyright (C) 2014 by PragmAda Software Engineering. All rights reserved.
-- **************************************************************************
--
-- Provide the user interface
--
-- V7.0 2014 Dec 01 First Gnoga version
--
with Field;
with Gnoga.Types;
package User_IF is
procedure Display_Count
(Data : in Gnoga.Types.Pointer_to_Connection_Data_Class;
Count : in Field.Valid_Count;
Stepped : in Boolean;
Cell : in Field.Cell_Location);
procedure Display_Mark
(Data : in Gnoga.Types.Pointer_to_Connection_Data_Class;
Cell : in Field.Cell_Location);
-- Display a marked cell
procedure Display_Mine
(Data : in Gnoga.Types.Pointer_to_Connection_Data_Class;
Cell : in Field.Cell_Location);
-- Display a mine.
procedure Display_Blank
(Data : in Gnoga.Types.Pointer_to_Connection_Data_Class;
Cell : in Field.Cell_Location);
-- Display a blank cell
procedure Display_To_Go
(Data : in Gnoga.Types.Pointer_to_Connection_Data_Class;
To_Go : in Integer);
-- Display # of mines still to mark; can be negative
procedure Reset_Screen (Data : in Gnoga.Types.Pointer_to_Connection_Data_Class); -- Return to start of game condition
function Auto_Marking
(Data : Gnoga.Types.Pointer_to_Connection_Data_Class)
return Boolean; -- Get auto-marking state
function Extended_Stepping
(Data : in Gnoga.Types.Pointer_to_Connection_Data_Class)
return Boolean;
-- Get extended-stepping (after mark) state
end User_IF;
--
-- 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.
user_if.adb
-- Mine Detector Game
-- Copyright (C) 2016 by PragmAda Software Engineering. All rights reserved.
-- **************************************************************************
--
-- v7.5 2016 May 01 Used some colors; better name Stepped in Display
-- V7.4 2016 Feb 15 Cleaned up unreferenced packages and variables that are not modified
-- V7.3 2015 Jun 15 Changed from Docker to Grid and added touch-screen support
-- V7.2 2015 Jan 01 Improved "termination" screen
-- V7.1 2014 Dec 10 Protected field-updating operations
-- V7.0 2014 Dec 01 First Gnoga version
--
with Ada.Characters.Wide_Wide_Latin_1;
with Field.Operations;
pragma Elaborate (Field.Operations);
with Gnoga.Application.Multi_Connect;
with Gnoga.Gui.Base;
with Gnoga.Gui.Element.Common;
with Gnoga.Gui.Element.Form;
with Gnoga.Gui.View.Grid;
with Gnoga.Gui.Window;
with Gnoga.Types.Colors;
use Ada;
use Ada.Characters;
package body User_IF is
use Gnoga;
use all type Gnoga.String;
subtype String is Gnoga.String;
Gray : constant Gnoga.Types.RGBA_Type := (Red => 224, Green => 224, Blue => 224, Alpha => 1.0);
type Button_Set is array (Field.Valid_Row, Field.Valid_Column) of Gnoga.Gui.Element.Common.Button_Type;
type Action_ID is (Button_Press, Right_Click, Restart, Quit);
type Atomic_Boolean is new Boolean;
pragma Atomic (Atomic_Boolean);
type App_Info;
type App_Ptr is access all App_Info;
protected type Sequentialize is
entry Respond
(Action : in Action_ID;
App_Data : in App_Ptr;
Cell : in Field.Cell_Location := (Row => 1, Column => 1));
end Sequentialize;
type App_Info is new Gnoga.Types.Connection_Data_Type with record
Field : Standard.Field.Field_Info (App_Data => App_Info'Unchecked_Access);
Window : Gnoga.Gui.Window.Pointer_To_Window_Class;
Big_View : Gnoga.Gui.View.Grid.Grid_View_Type;
Left_View : aliased Gnoga.Gui.View.View_Type;
Right_View : aliased Gnoga.Gui.View.View_Type;
Mines_Left : Gnoga.Gui.Element.Common.Span_Type;
Button : Button_Set;
Restart_Button : Gnoga.Gui.Element.Common.Button_Type;
Level_Form : Gnoga.Gui.Element.Form.Form_Type;
Level : Gnoga.Gui.Element.Form.Selection_Type;
Mark_Form : Gnoga.Gui.Element.Form.Form_Type;
Mark_Check : Gnoga.Gui.Element.Form.Check_Box_Type;
Mark_Label : Gnoga.Gui.Element.Form.Label_Type;
Step_Form : Gnoga.Gui.Element.Form.Form_Type;
Step_Check : Gnoga.Gui.Element.Form.Check_Box_Type;
Step_Label : Gnoga.Gui.Element.Form.Label_Type;
Rules : Gnoga.Gui.Element.Common.Button_Type;
About : Gnoga.Gui.Element.Common.Button_Type;
Quit : Gnoga.Gui.Element.Common.Button_Type;
Game_Over : Gnoga.Gui.Element.Common.Span_Type;
Mode_Form : Gnoga.Gui.Element.Form.Form_Type;
Mode_Check : Gnoga.Gui.Element.Form.Check_Box_Type;
Mode_Label : Gnoga.Gui.Element.Form.Label_Type;
Auto_Marking_Desired : Atomic_Boolean := False;
Extended_Stepping_Desired : Atomic_Boolean := False;
Sequentializer : Sequentialize;
end record;
You_Won_Message : constant String := "You Won";
You_Lost_Message : constant String := "BOOM!";
Exploded : constant String := "X";
type Level_Info is record
Name : String;
Mines : Natural;
end record;
type Level_List is array (Positive range <>) of Level_Info;
Levels : constant Level_List :=
(1 => (Name => " 50", Mines => 50), 2 => (Name => "100", Mines => 100), 3 => (Name => "150", Mines => 150),
4 => (Name => "200", Mines => 200), 5 => (Name => "250", Mines => 250));
Default_Level : constant := 2;
subtype Cell_String is String;
procedure Show_Game_Over (App_Data : in App_Ptr) is
-- null;
begin -- Show_Game_Over
case Field.Operations.Game_State (App_Data.Field) is
when Field.Operations.Won =>
App_Data.Game_Over.Text (Value => You_Won_Message);
when Field.Operations.Lost =>
App_Data.Game_Over.Text (Value => You_Lost_Message);
when Field.Operations.In_Progress =>
null;
end case;
end Show_Game_Over;
pragma Inline (Show_Game_Over);
use type Field.Operations.Game_State_ID;
Button_Size : constant := 30;
procedure Display
(App_Data : in App_Ptr;
Cell : in Field.Cell_Location;
Text : in Cell_String;
Stepped : in Boolean)
is
-- null;
begin -- Display
App_Data.Button (Cell.Row, Cell.Column).Text (Value => Text);
if not Stepped then
App_Data.Button (Cell.Row, Cell.Column).Background_Color (Enum => Gnoga.Types.Colors.Light_Green);
App_Data.Button (Cell.Row, Cell.Column).Shadow_None;
else
if Text = Exploded then
App_Data.Button (Cell.Row, Cell.Column).Background_Color (Enum => Gnoga.Types.Colors.Red);
else
App_Data.Button (Cell.Row, Cell.Column).Background_Color (RGBA => Gray);
end if;
App_Data.Button (Cell.Row, Cell.Column).Shadow
(Horizontal_Position => "1px", Vertical_Position => "1px", Inset_Shadow => True);
end if;
if Field.Operations.Game_State (App_Data.Field) /= Field.Operations.In_Progress then
Show_Game_Over (App_Data => App_Data);
end if;
end Display;
pragma Inline (Display);
procedure Display_Blank
(Data : in Gnoga.Types.Pointer_to_Connection_Data_Class;
Cell : in Field.Cell_Location)
is
App_Data : constant App_Ptr := App_Ptr (Data);
begin -- Display_Blank
Display (App_Data => App_Data, Cell => Cell, Text => " ", Stepped => False);
end Display_Blank;
procedure Display_Count
(Data : in Gnoga.Types.Pointer_to_Connection_Data_Class;
Count : in Field.Valid_Count;
Stepped : in Boolean;
Cell : in Field.Cell_Location)
is
Zero_Pos : constant := Character'Pos ('0');
App_Data : constant App_Ptr := App_Ptr (Data);
begin -- Display_Count
Display
(App_Data => App_Data, Cell => Cell, Text => From_ASCII (Character'Val (Zero_Pos + Count)), Stepped => Stepped);
end Display_Count;
procedure Display_Mark
(Data : in Gnoga.Types.Pointer_to_Connection_Data_Class;
Cell : in Field.Cell_Location)
is
App_Data : constant App_Ptr := App_Ptr (Data);
begin -- Display_Mark
Display (App_Data => App_Data, Cell => Cell, Text => "M", Stepped => False);
end Display_Mark;
procedure Display_Mine
(Data : in Gnoga.Types.Pointer_to_Connection_Data_Class;
Cell : in Field.Cell_Location)
is
App_Data : constant App_Ptr := App_Ptr (Data);
begin -- Display_Mine
Display (App_Data => App_Data, Cell => Cell, Text => Exploded, Stepped => True);
end Display_Mine;
procedure Display_To_Go
(Data : in Gnoga.Types.Pointer_to_Connection_Data_Class;
To_Go : in Integer)
is
Image : constant String := Gnoga.Image (To_Go);
App_Data : constant App_Ptr := App_Ptr (Data);
begin -- Display_To_Go
App_Data.Mines_Left.Text (Value => Image);
end Display_To_Go;
procedure Reset_Screen (Data : in Gnoga.Types.Pointer_to_Connection_Data_Class) is
App_Data : constant App_Ptr := App_Ptr (Data);
begin -- Reset_Screen
App_Data.Mines_Left.Text (Value => "0");
App_Data.Game_Over.Text (Value => "");
Button_Row :
for Row in Field.Valid_Row loop
Button_Column :
for Column in Field.Valid_Column loop
Display_Blank (Data => Data, Cell => (Row => Row, Column => Column));
end loop Button_Column;
end loop Button_Row;
end Reset_Screen;
function Auto_Marking
(Data : Gnoga.Types.Pointer_to_Connection_Data_Class)
return Boolean
is
App_Data : constant App_Ptr := App_Ptr (Data);
begin -- Auto_Marking
return Boolean (App_Data.Auto_Marking_Desired);
end Auto_Marking;
function Extended_Stepping
(Data : in Gnoga.Types.Pointer_to_Connection_Data_Class)
return Boolean
is
App_Data : constant App_Ptr := App_Ptr (Data);
begin -- Extended_Stepping
return Boolean (App_Data.Extended_Stepping_Desired);
end Extended_Stepping;
procedure When_Close (Object : in out Gnoga.Gui.Base.Base_Type'Class) is
App_Data : constant App_Ptr := App_Ptr (Object.Connection_Data);
begin -- When_Close
App_Data.Sequentializer.Respond (Action => Quit, App_Data => App_Data);
end When_Close;
procedure Mark_Toggle (Object : in out Gnoga.Gui.Base.Base_Type'Class) is
App_Data : constant App_Ptr := App_Ptr (Object.Connection_Data);
begin -- Mark_Toggle
App_Data.Auto_Marking_Desired := Atomic_Boolean (App_Data.Mark_Check.Checked);
end Mark_Toggle;
procedure Step_Toggle (Object : in out Gnoga.Gui.Base.Base_Type'Class) is
App_Data : constant App_Ptr := App_Ptr (Object.Connection_Data);
begin -- Step_Toggle
App_Data.Extended_Stepping_Desired := Atomic_Boolean (App_Data.Step_Check.Checked);
end Step_Toggle;
procedure Button_Press (Object : in out Gnoga.Gui.Base.Base_Type'Class) is
Name : constant String := Object.ID;
Row : constant Field.Valid_Row := Value (Name.Slice (Name.First, Name.First + 1));
Column : constant Field.Valid_Column := Value (Name.Slice (Name.Last - 1, Name.Last));
App_Data : constant App_Ptr := App_Ptr (Object.Connection_Data);
begin -- Button_Press
App_Data.Sequentializer.Respond
(Action => Button_Press, App_Data => App_Data, Cell => (Row => Row, Column => Column));
end Button_Press;
procedure Right_Click (Object : in out Gnoga.Gui.Base.Base_Type'Class) is
Name : constant String := Object.ID;
Row : constant Field.Valid_Row := Value (Name.Slice (Name.First, Name.First + 1));
Column : constant Field.Valid_Column := Value (Name.Slice (Name.Last - 1, Name.Last));
App_Data : constant App_Ptr := App_Ptr (Object.Connection_Data);
begin -- Right_Click
App_Data.Sequentializer.Respond
(Action => Right_Click, App_Data => App_Data, Cell => (Row => Row, Column => Column));
end Right_Click;
procedure When_Restart_Button (Object : in out Gnoga.Gui.Base.Base_Type'Class) is
App_Data : constant App_Ptr := App_Ptr (Object.Connection_Data);
begin -- When_Restart_Button
App_Data.Sequentializer.Respond (Action => Restart, App_Data => App_Data);
end When_Restart_Button;
procedure Rules_Pressed (Object : in out Gnoga.Gui.Base.Base_Type'Class) is
App_Data : constant App_Ptr := App_Ptr (Object.Connection_Data);
Rules : constant String :=
"The object of the game is to mark all cells containing " &
"mines and to step on all cells that do not contain a " & "mine." & Wide_Wide_Latin_1.LF &
Wide_Wide_Latin_1.LF & "The game is played on a rectangular field of 16 x 30 " &
"cells. A number of mines are hidden within the field." & Wide_Wide_Latin_1.LF & Wide_Wide_Latin_1.LF &
"Some of the cells have numbers on them. The numbers represent " &
"the total number of mines in that cell and its " &
"immediate neighbors. As you play the game, additional cells " & "will become numbered." &
Wide_Wide_Latin_1.LF & Wide_Wide_Latin_1.LF &
"You step on a cell by clicking on it. You mark a cell by right " &
"clicking on it. A marked cell has an M on it. Marking a " &
"marked cell unmarks it. You can only mark or step " & "on a cell with a number on it." & Wide_Wide_Latin_1.LF &
Wide_Wide_Latin_1.LF & "When you step on a cell, an auto-stepping algorithm " &
"automatically steps on any of its neighbors that " & "obviously do not contain mines. Since this is then " &
"done for the neighbors of the stepped-on neighbors, " &
"the auto-stepping algorithm will spread across areas " &
"of the field that obviously do not contain mines. The " &
"auto-stepping algorithm is invoked even if the cell is " &
"already stepped on. This can be useful to clear around " & "a new mark." & Wide_Wide_Latin_1.LF &
Wide_Wide_Latin_1.LF & "If you step on a cell containing a mine, either " &
"directly or indirectly through the auto-stepping " & "algorithm, the cell shows an X, and the game is over." &
Wide_Wide_Latin_1.LF & Wide_Wide_Latin_1.LF & "The game is over when you step on a mine, or when you " &
"have marked all mines and stepped on all other cells. " & "If you win, '" & You_Won_Message &
"' appears below the " & "'Quit' button. If you lose, '" & You_Lost_Message & "' appears there." &
Wide_Wide_Latin_1.LF & Wide_Wide_Latin_1.LF & "At the top right of the field is a number. At the " &
"start of a game this is the number of mines in the " & "field. Each time you mark a cell, this number is " &
"decreased by one. Each time you unmark a marked cell, " &
"this number is increased by one. If you successfully " & "complete a game, this number will be zero." &
Wide_Wide_Latin_1.LF & Wide_Wide_Latin_1.LF & "The 'New Game' button starts a new game. Any game in " &
"progress is abandoned." & Wide_Wide_Latin_1.LF & Wide_Wide_Latin_1.LF &
"The level drop-down allows you to choose how many mines " &
"will be in the field at the start of the next game. You " & "can choose from" & Levels (Levels'First).Name &
" to " & Levels (Levels'Last).Name & " mines. This goes into effect " &
"the next time you start a new game. At higher numbers of " &
"mines, it may not be possible to win the game without luck." & Wide_Wide_Latin_1.LF & Wide_Wide_Latin_1.LF &
"The 'Auto Mark' check box enables an auto-marking " &
"algorithm that marks any cells that obviously contain " &
"a mine. At lower levels, the game does not present much " &
"of an intellectual challenge with this option. At higher " &
"levels, it's very difficult to play without this option." & Wide_Wide_Latin_1.LF & Wide_Wide_Latin_1.LF &
"The 'Auto Step after Mark' check box enables the auto-" &
"stepping algorithm after a cell is marked, either " & "directly or indirectly through the auto-marking " &
"algorithm." & Wide_Wide_Latin_1.LF & Wide_Wide_Latin_1.LF &
"The 'Mark' check box is for use with touch screens or other " &
"systems for which right clicking is difficult or impossible. " &
"When this box is not checked, clicking on a cells steps on the " &
"cell. When this box is checked, clicking on a cell marks or " & "unmarks the cell.";
begin -- Rules_Pressed
App_Data.Window.Alert (Message => Rules);
end Rules_Pressed;
procedure About_Pressed (Object : in out Gnoga.Gui.Base.Base_Type'Class) is
App_Data : constant App_Ptr := App_Ptr (Object.Connection_Data);
begin -- About_Pressed
App_Data.Window.Alert
(Message =>
"Mine Detector" & Wide_Wide_Latin_1.LF & "Copyright (C) 2015 by" & Wide_Wide_Latin_1.LF &
"PragmAda Software Engineering" & Wide_Wide_Latin_1.LF & "Released as Free Software under the terms" &
Wide_Wide_Latin_1.LF & "of the GNU Public License" & Wide_Wide_Latin_1.LF & '"' & "Ada Inside" & '"');
end About_Pressed;
function Image
(Row : Field.Valid_Row;
Column : Field.Valid_Column)
return String
is
-- Returns a 4-Character String of the form "RRCC", where
-- RR is the zero-filled image of Row
-- CC is the zero-filled image of Column
Row_Image : String := Image (Row, Prefix => ' ');
Column_Image : String := Image (Column, Prefix => ' ');
Row_First : Positive := Row_Image.First;
Column_First : Positive := Column_Image.First;
begin -- Image
Row_Image.Replace_Unicode (Row_Image.First, '0');
Column_Image.Replace_Unicode (Column_Image.First, '0');
if Row >= 10 then
Row_First := Row_First + 1;
end if;
if Column >= 10 then
Column_First := Column_First + 1;
end if;
return Row_Image.Slice (Row_First, Row_Image.Last) & Column_Image.Slice (Column_First, Column_Image.Last);
end Image;
procedure Create_Level_Option_Menu (App_Data : in out App_Info) is
-- null;
begin -- Create_Level_Option_Menu
Add_Options :
for I in Levels'range loop
App_Data.Level.Add_Option (Value => Levels (I).Name, Text => Levels (I).Name);
end loop Add_Options;
App_Data.Level.Selected (Index => Default_Level);
end Create_Level_Option_Menu;
procedure On_Connect
(Main_Window : in out Gnoga.Gui.Window.Window_Type'Class;
Connection : access Gnoga.Application.Multi_Connect.Connection_Holder_Type)
is
App_Data : constant App_Ptr := new App_Info;
begin -- On_Connect
App_Data.Window := Main_Window'Unchecked_Access;
Main_Window.Connection_Data (Data => App_Data);
Field.Operations.Set_Mine_Count (Field => App_Data.Field, New_Mine_Count => Levels (Default_Level).Mines);
Main_Window.Buffer_Connection;
App_Data.Big_View.Create
(Parent => Main_Window, Layout => Gnoga.Gui.View.Grid.Horizontal_Split, Set_Sizes => False);
App_Data.Big_View.Background_Color (Enum => Gnoga.Types.Colors.Light_Blue);
App_Data.Left_View.Create (Parent => App_Data.Big_View.Panel (1, 1).all);
App_Data.Left_View.Hidden;
App_Data.Left_View.Background_Color (Enum => Gnoga.Types.Colors.Light_Blue);
Button_Row :
for Row in App_Data.Button'Range (1) loop
Button_Column :
for Column in App_Data.Button'Range (2) loop
App_Data.Button (Row, Column).Create
(Parent => App_Data.Left_View, Content => " ", ID => User_IF.Image (Row, Column));
App_Data.Button (Row, Column).Overflow (Value => Gnoga.Gui.Element.Hidden);
App_Data.Button (Row, Column).Vertical_Align (Value => Gnoga.Gui.Element.Middle);
App_Data.Button (Row, Column).Minimum_Width (Value => Button_Size);
App_Data.Button (Row, Column).Maximum_Width (Value => Button_Size);
App_Data.Button (Row, Column).Minimum_Height (Value => Button_Size);
App_Data.Button (Row, Column).Maximum_Height (Value => Button_Size);
App_Data.Button (Row, Column).Text_Alignment (Value => Gnoga.Gui.Element.Center);
App_Data.Button (Row, Column).Margin (Top => "1px", Right => "1px", Bottom => "1px", Left => "1px");
App_Data.Button (Row, Column).Border (Width => "thin");
App_Data.Button (Row, Column).On_Click_Handler (Handler => Button_Press'Access);
App_Data.Button (Row, Column).On_Context_Menu_Handler (Handler => Right_Click'Access);
end loop Button_Column;
App_Data.Left_View.Put_HTML (HTML => "<br />");
end loop Button_Row;
App_Data.Left_View.Hidden (Value => False);
App_Data.Right_View.Create (Parent => App_Data.Big_View.Panel (1, 2).all);
App_Data.Right_View.Background_Color (Enum => Gnoga.Types.Colors.Light_Blue);
App_Data.Mines_Left.Create (Parent => App_Data.Right_View, Content => "0");
App_Data.Mines_Left.Width (Value => 100);
App_Data.Mines_Left.Text_Alignment (Value => Gnoga.Gui.Element.Center);
App_Data.Mines_Left.Display (Value => "block");
App_Data.Restart_Button.Create (Parent => App_Data.Right_View, Content => "New Game");
App_Data.Restart_Button.Display (Value => "block");
App_Data.Restart_Button.On_Click_Handler (Handler => When_Restart_Button'Access);
App_Data.Level_Form.Create (Parent => App_Data.Right_View);
App_Data.Level_Form.Display (Value => "block");
App_Data.Level.Create (Form => App_Data.Level_Form);
App_Data.Level.Width (Value => 57);
Create_Level_Option_Menu (App_Data => App_Data.all);
App_Data.Mark_Form.Create (Parent => App_Data.Right_View);
App_Data.Mark_Form.Display (Value => "block");
App_Data.Mark_Check.Create (Form => App_Data.Mark_Form);
App_Data.Mark_Check.Checked (Value => False);
App_Data.Mark_Check.On_Click_Handler (Handler => Mark_Toggle'Access);
App_Data.Mark_Label.Create
(Form => App_Data.Mark_Form, Label_For => App_Data.Mark_Check, Content => "Auto Mark", Auto_Place => False);
App_Data.Step_Form.Create (Parent => App_Data.Right_View);
App_Data.Step_Form.Display (Value => "block");
App_Data.Step_Check.Create (Form => App_Data.Step_Form);
App_Data.Step_Check.Checked (Value => False);
App_Data.Step_Check.On_Click_Handler (Handler => Step_Toggle'Access);
App_Data.Step_Label.Create
(Form => App_Data.Step_Form, Label_For => App_Data.Step_Check, Content => "Auto Step after Mark",
Auto_Place => False);
App_Data.Rules.Create (Parent => App_Data.Right_View, Content => "Rules");
App_Data.Rules.Display (Value => "block");
App_Data.Rules.On_Click_Handler (Handler => Rules_Pressed'Access);
App_Data.About.Create (Parent => App_Data.Right_View, Content => "About");
App_Data.About.Display (Value => "block");
App_Data.About.On_Click_Handler (Handler => About_Pressed'Access);
App_Data.Quit.Create (Parent => App_Data.Right_View, Content => "Quit");
App_Data.Quit.Display (Value => "block");
App_Data.Quit.On_Click_Handler (Handler => When_Close'Access);
App_Data.Mode_Form.Create (Parent => App_Data.Right_View);
App_Data.Mode_Form.Display (Value => "block");
App_Data.Mode_Check.Create (Form => App_Data.Mode_Form);
App_Data.Mode_Check.Checked (Value => False);
App_Data.Mode_Label.Create
(Form => App_Data.Mode_Form, Label_For => App_Data.Mode_Check, Content => "Mark", Auto_Place => False);
App_Data.Game_Over.Create (Parent => App_Data.Right_View, Content => You_Won_Message);
App_Data.Game_Over.Width (Value => 100);
App_Data.Game_Over.Text_Alignment (Value => Gnoga.Gui.Element.Center);
App_Data.Game_Over.Display (Value => "block");
Main_Window.Buffer_Connection (Value => False);
Field.Operations.Reset (Field => App_Data.Field);
end On_Connect;
End_Message : constant String := "Mine Detector ended.";
protected body Sequentialize is
entry Respond
(Action : in Action_ID;
App_Data : in App_Ptr;
Cell : in Field.Cell_Location := (Row => 1, Column => 1)) when Standard.True
is
View : Gnoga.Gui.View.View_Type;
begin -- Respond
case Action is
when Button_Press =>
if Field.Operations.Game_State (App_Data.Field) /= Field.Operations.In_Progress then
Show_Game_Over (App_Data => App_Data);
elsif App_Data.Mode_Check.Checked then
Field.Operations.Mark (Field => App_Data.Field, Cell => Cell);
else
Field.Operations.Step (Field => App_Data.Field, Cell => Cell);
end if;
when Right_Click =>
if Field.Operations.Game_State (App_Data.Field) /= Field.Operations.In_Progress then
Show_Game_Over (App_Data => App_Data);
else
Field.Operations.Mark (Field => App_Data.Field, Cell => Cell);
end if;
when Restart =>
Field.Operations.Set_Mine_Count
(Field => App_Data.Field, New_Mine_Count => Levels (App_Data.Level.Selected_Index).Mines);
Field.Operations.Reset (Field => App_Data.Field);
when Quit =>
App_Data.Big_View.Remove;
View.Create (Parent => App_Data.Window.all);
View.Put_Line (Message => End_Message);
App_Data.Window.Close;
App_Data.Window.Close_Connection;
end case;
end Respond;
end Sequentialize;
begin -- User_IF
Gnoga.Application.Title (Name => "Mine Detector");
Gnoga.Application.HTML_On_Close (HTML => End_Message);
Gnoga.Application.Multi_Connect.Initialize;
Gnoga.Application.Multi_Connect.On_Connect_Handler (Event => On_Connect'Access, Path => "default");
Gnoga.Application.Multi_Connect.Message_Loop;
end User_IF;
--
-- 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.
connectfour.properties
#Connect Four en
ADPT=Adapted for GNOGA by Pascal Pignard (20150613).
APPE=Application ended.
CPYR=Connect Four (TM) by Barry Fagin and Martin Carlisle
DEVP=Developed by Barry Fagin and Martin Carlisle, US Air Force Academy.
IAMT=I am thinking...
INFO=This Connect Four (TM) game was initially coded in Ada 2005 and compiled with the JVM-GNAT compiler.
IWIN=I win\! - Press left mouse button
TIEG=Tie Game\! - Press Left Mouse Button
YWIN=You win\! - Press left mouse button
TITL=Connect Four (TM)mine_detector.adb
-- Mine Detector Game
-- Copyright (C) 2014 by PragmAda Software Engineering. All rights reserved.
-- **************************************************************************
--
-- V7.0 2014 Dec 01 First Gnoga version
--
with User_IF;
procedure Mine_Detector is
-- null;
begin -- Mine_Detector
null;
end Mine_Detector;
--
-- 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 Mine_Detector is
for Object_Dir use Settings.Obj_Dir;
for Exec_Dir use Settings.Exe_Dir;
for Main use ("mine_detector.adb");
for Create_Missing_Dirs use Settings'Create_Missing_Dirs;
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 Mine_Detector;