Data update
This commit is contained in:
Ingy döt Net
parent
5150844a7d
commit
4bb20c9b71
7735 changed files with 38060 additions and 199180 deletions
|
|
@ -1,368 +0,0 @@
|
|||
with Ada.Numerics.Discrete_Random;
|
||||
with Ada.Text_IO;
|
||||
|
||||
procedure Minesweeper is
|
||||
package IO renames Ada.Text_IO;
|
||||
package Nat_IO is new IO.Integer_IO (Natural);
|
||||
package Nat_RNG is new Ada.Numerics.Discrete_Random (Natural);
|
||||
|
||||
type Stuff is (Empty, Mine);
|
||||
type Field is record
|
||||
Contents : Stuff := Empty;
|
||||
Opened : Boolean := False;
|
||||
Marked : Boolean := False;
|
||||
end record;
|
||||
type Grid is array (Positive range <>, Positive range <>) of Field;
|
||||
|
||||
-- counts how many mines are in the surrounding fields
|
||||
function Mines_Nearby (Item : Grid; X, Y : Positive) return Natural is
|
||||
Result : Natural := 0;
|
||||
begin
|
||||
-- left of X:Y
|
||||
if X > Item'First (1) then
|
||||
-- above X-1:Y
|
||||
if Y > Item'First (2) then
|
||||
if Item (X - 1, Y - 1).Contents = Mine then
|
||||
Result := Result + 1;
|
||||
end if;
|
||||
end if;
|
||||
-- X-1:Y
|
||||
if Item (X - 1, Y).Contents = Mine then
|
||||
Result := Result + 1;
|
||||
end if;
|
||||
-- below X-1:Y
|
||||
if Y < Item'Last (2) then
|
||||
if Item (X - 1, Y + 1).Contents = Mine then
|
||||
Result := Result + 1;
|
||||
end if;
|
||||
end if;
|
||||
end if;
|
||||
-- above of X:Y
|
||||
if Y > Item'First (2) then
|
||||
if Item (X, Y - 1).Contents = Mine then
|
||||
Result := Result + 1;
|
||||
end if;
|
||||
end if;
|
||||
-- below of X:Y
|
||||
if Y < Item'Last (2) then
|
||||
if Item (X, Y + 1).Contents = Mine then
|
||||
Result := Result + 1;
|
||||
end if;
|
||||
end if;
|
||||
-- right of X:Y
|
||||
if X < Item'Last (1) then
|
||||
-- above X+1:Y
|
||||
if Y > Item'First (2) then
|
||||
if Item (X + 1, Y - 1).Contents = Mine then
|
||||
Result := Result + 1;
|
||||
end if;
|
||||
end if;
|
||||
-- X+1:Y
|
||||
if Item (X + 1, Y).Contents = Mine then
|
||||
Result := Result + 1;
|
||||
end if;
|
||||
-- below X+1:Y
|
||||
if Y < Item'Last (2) then
|
||||
if Item (X + 1, Y + 1).Contents = Mine then
|
||||
Result := Result + 1;
|
||||
end if;
|
||||
end if;
|
||||
end if;
|
||||
return Result;
|
||||
end Mines_Nearby;
|
||||
|
||||
-- outputs the grid
|
||||
procedure Put (Item : Grid) is
|
||||
Mines : Natural := 0;
|
||||
begin
|
||||
IO.Put (" ");
|
||||
for X in Item'Range (1) loop
|
||||
Nat_IO.Put (Item => X, Width => 3);
|
||||
end loop;
|
||||
IO.New_Line;
|
||||
IO.Put (" +");
|
||||
for X in Item'Range (1) loop
|
||||
IO.Put ("---");
|
||||
end loop;
|
||||
IO.Put ('+');
|
||||
IO.New_Line;
|
||||
for Y in Item'Range (2) loop
|
||||
Nat_IO.Put (Item => Y, Width => 3);
|
||||
IO.Put ('|');
|
||||
for X in Item'Range (1) loop
|
||||
if Item (X, Y).Opened then
|
||||
if Item (X, Y).Contents = Empty then
|
||||
if Item (X, Y).Marked then
|
||||
IO.Put (" - ");
|
||||
else
|
||||
Mines := Mines_Nearby (Item, X, Y);
|
||||
if Mines > 0 then
|
||||
Nat_IO.Put (Item => Mines, Width => 2);
|
||||
IO.Put (' ');
|
||||
else
|
||||
IO.Put (" ");
|
||||
end if;
|
||||
end if;
|
||||
else
|
||||
if Item (X, Y).Marked then
|
||||
IO.Put (" + ");
|
||||
else
|
||||
IO.Put (" X ");
|
||||
end if;
|
||||
end if;
|
||||
elsif Item (X, Y).Marked then
|
||||
IO.Put (" ? ");
|
||||
else
|
||||
IO.Put (" . ");
|
||||
end if;
|
||||
end loop;
|
||||
IO.Put ('|');
|
||||
IO.New_Line;
|
||||
end loop;
|
||||
IO.Put (" +");
|
||||
for X in Item'Range (1) loop
|
||||
IO.Put ("---");
|
||||
end loop;
|
||||
IO.Put ('+');
|
||||
IO.New_Line;
|
||||
end Put;
|
||||
|
||||
-- marks a field as possible bomb
|
||||
procedure Mark (Item : in out Grid; X, Y : in Positive) is
|
||||
begin
|
||||
if Item (X, Y).Opened then
|
||||
IO.Put_Line ("Field already open!");
|
||||
else
|
||||
Item (X, Y).Marked := not Item (X, Y).Marked;
|
||||
end if;
|
||||
end Mark;
|
||||
|
||||
-- clears a field and it's neighbours, if they don't have mines
|
||||
procedure Clear
|
||||
(Item : in out Grid;
|
||||
X, Y : in Positive;
|
||||
Killed : out Boolean)
|
||||
is
|
||||
-- clears the neighbours, if they don't have mines
|
||||
procedure Clear_Neighbours (The_X, The_Y : Positive) is
|
||||
begin
|
||||
-- mark current field opened
|
||||
Item (The_X, The_Y).Opened := True;
|
||||
-- only proceed if neighbours don't have mines
|
||||
if Mines_Nearby (Item, The_X, The_Y) = 0 then
|
||||
-- left of X:Y
|
||||
if The_X > Item'First (1) then
|
||||
-- above X-1:Y
|
||||
if The_Y > Item'First (2) then
|
||||
if not Item (The_X - 1, The_Y - 1).Opened and
|
||||
not Item (The_X - 1, The_Y - 1).Marked
|
||||
then
|
||||
Clear_Neighbours (The_X - 1, The_Y - 1);
|
||||
end if;
|
||||
end if;
|
||||
-- X-1:Y
|
||||
if not Item (The_X - 1, The_Y).Opened and
|
||||
not Item (The_X - 1, The_Y).Marked
|
||||
then
|
||||
Clear_Neighbours (The_X - 1, The_Y);
|
||||
end if;
|
||||
-- below X-1:Y
|
||||
if The_Y < Item'Last (2) then
|
||||
if not Item (The_X - 1, The_Y + 1).Opened and
|
||||
not Item (The_X - 1, The_Y + 1).Marked
|
||||
then
|
||||
Clear_Neighbours (The_X - 1, The_Y + 1);
|
||||
end if;
|
||||
end if;
|
||||
end if;
|
||||
-- above X:Y
|
||||
if The_Y > Item'First (2) then
|
||||
if not Item (The_X, The_Y - 1).Opened and
|
||||
not Item (The_X, The_Y - 1).Marked
|
||||
then
|
||||
Clear_Neighbours (The_X, The_Y - 1);
|
||||
end if;
|
||||
end if;
|
||||
-- below X:Y
|
||||
if The_Y < Item'Last (2) then
|
||||
if not Item (The_X, The_Y + 1).Opened and
|
||||
not Item (The_X, The_Y + 1).Marked
|
||||
then
|
||||
Clear_Neighbours (The_X, The_Y + 1);
|
||||
end if;
|
||||
end if;
|
||||
-- right of X:Y
|
||||
if The_X < Item'Last (1) then
|
||||
-- above X+1:Y
|
||||
if The_Y > Item'First (2) then
|
||||
if not Item (The_X + 1, The_Y - 1).Opened and
|
||||
not Item (The_X + 1, The_Y - 1).Marked
|
||||
then
|
||||
Clear_Neighbours (The_X + 1, The_Y - 1);
|
||||
end if;
|
||||
end if;
|
||||
-- X+1:Y
|
||||
if not Item (The_X + 1, The_Y).Opened and
|
||||
not Item (The_X + 1, The_Y).Marked
|
||||
then
|
||||
Clear_Neighbours (The_X + 1, The_Y);
|
||||
end if;
|
||||
-- below X+1:Y
|
||||
if The_Y < Item'Last (2) then
|
||||
if not Item (The_X + 1, The_Y + 1).Opened and
|
||||
not Item (The_X + 1, The_Y + 1).Marked
|
||||
then
|
||||
Clear_Neighbours (The_X + 1, The_Y + 1);
|
||||
end if;
|
||||
end if;
|
||||
end if;
|
||||
end if;
|
||||
end Clear_Neighbours;
|
||||
begin
|
||||
Killed := False;
|
||||
-- only clear closed and unmarked fields
|
||||
if Item (X, Y).Opened then
|
||||
IO.Put_Line ("Field already open!");
|
||||
elsif Item (X, Y).Marked then
|
||||
IO.Put_Line ("Field already marked!");
|
||||
else
|
||||
Killed := Item (X, Y).Contents = Mine;
|
||||
-- game over if killed, no need to clear
|
||||
if not Killed then
|
||||
Clear_Neighbours (X, Y);
|
||||
end if;
|
||||
end if;
|
||||
end Clear;
|
||||
|
||||
-- marks all fields as open
|
||||
procedure Open_All (Item : in out Grid) is
|
||||
begin
|
||||
for X in Item'Range (1) loop
|
||||
for Y in Item'Range (2) loop
|
||||
Item (X, Y).Opened := True;
|
||||
end loop;
|
||||
end loop;
|
||||
end Open_All;
|
||||
|
||||
-- counts the number of marks
|
||||
function Count_Marks (Item : Grid) return Natural is
|
||||
Result : Natural := 0;
|
||||
begin
|
||||
for X in Item'Range (1) loop
|
||||
for Y in Item'Range (2) loop
|
||||
if Item (X, Y).Marked then
|
||||
Result := Result + 1;
|
||||
end if;
|
||||
end loop;
|
||||
end loop;
|
||||
return Result;
|
||||
end Count_Marks;
|
||||
|
||||
-- read and validate user input
|
||||
procedure Get_Coordinates
|
||||
(Max_X, Max_Y : Positive;
|
||||
X, Y : out Positive;
|
||||
Valid : out Boolean)
|
||||
is
|
||||
begin
|
||||
Valid := False;
|
||||
IO.Put ("X: ");
|
||||
Nat_IO.Get (X);
|
||||
IO.Put ("Y: ");
|
||||
Nat_IO.Get (Y);
|
||||
Valid := X > 0 and X <= Max_X and Y > 0 and Y <= Max_Y;
|
||||
exception
|
||||
when Constraint_Error =>
|
||||
Valid := False;
|
||||
end Get_Coordinates;
|
||||
|
||||
-- randomly place bombs
|
||||
procedure Set_Bombs (Item : in out Grid; Max_X, Max_Y, Count : Positive) is
|
||||
Generator : Nat_RNG.Generator;
|
||||
X, Y : Positive;
|
||||
begin
|
||||
Nat_RNG.Reset (Generator);
|
||||
for I in 1 .. Count loop
|
||||
Placement : loop
|
||||
X := Nat_RNG.Random (Generator) mod Max_X + 1;
|
||||
Y := Nat_RNG.Random (Generator) mod Max_Y + 1;
|
||||
-- redo placement if X:Y already full
|
||||
if Item (X, Y).Contents = Empty then
|
||||
Item (X, Y).Contents := Mine;
|
||||
exit Placement;
|
||||
end if;
|
||||
end loop Placement;
|
||||
end loop;
|
||||
end Set_Bombs;
|
||||
|
||||
Width, Height : Positive;
|
||||
|
||||
begin
|
||||
-- can be dynamically set
|
||||
Width := 6;
|
||||
Height := 4;
|
||||
declare
|
||||
The_Grid : Grid (1 .. Width, 1 .. Height);
|
||||
-- 20% bombs
|
||||
Bomb_Count : Positive := Width * Height * 20 / 100;
|
||||
Finished : Boolean := False;
|
||||
Action : Character;
|
||||
Chosen_X, Chosen_Y : Positive;
|
||||
Valid_Entry : Boolean;
|
||||
begin
|
||||
IO.Put ("Nr. Bombs: ");
|
||||
Nat_IO.Put (Item => Bomb_Count, Width => 0);
|
||||
IO.New_Line;
|
||||
Set_Bombs
|
||||
(Item => The_Grid,
|
||||
Max_X => Width,
|
||||
Max_Y => Height,
|
||||
Count => Bomb_Count);
|
||||
while not Finished and Count_Marks (The_Grid) /= Bomb_Count loop
|
||||
Put (The_Grid);
|
||||
IO.Put ("Input (c/m/r): ");
|
||||
IO.Get (Action);
|
||||
case Action is
|
||||
when 'c' | 'C' =>
|
||||
Get_Coordinates
|
||||
(Max_X => Width,
|
||||
Max_Y => Height,
|
||||
X => Chosen_X,
|
||||
Y => Chosen_Y,
|
||||
Valid => Valid_Entry);
|
||||
if Valid_Entry then
|
||||
Clear
|
||||
(Item => The_Grid,
|
||||
X => Chosen_X,
|
||||
Y => Chosen_Y,
|
||||
Killed => Finished);
|
||||
if Finished then
|
||||
IO.Put_Line ("You stepped on a mine!");
|
||||
end if;
|
||||
else
|
||||
IO.Put_Line ("Invalid input, retry!");
|
||||
end if;
|
||||
when 'm' | 'M' =>
|
||||
Get_Coordinates
|
||||
(Max_X => Width,
|
||||
Max_Y => Height,
|
||||
X => Chosen_X,
|
||||
Y => Chosen_Y,
|
||||
Valid => Valid_Entry);
|
||||
if Valid_Entry then
|
||||
Mark (Item => The_Grid, X => Chosen_X, Y => Chosen_Y);
|
||||
else
|
||||
IO.Put_Line ("Invalid input, retry!");
|
||||
end if;
|
||||
when 'r' | 'R' =>
|
||||
Finished := True;
|
||||
when others =>
|
||||
IO.Put_Line ("Invalid input, retry!");
|
||||
end case;
|
||||
end loop;
|
||||
Open_All (The_Grid);
|
||||
IO.Put_Line
|
||||
("Solution: (+ = correctly marked, - = incorrectly marked)");
|
||||
Put (The_Grid);
|
||||
end;
|
||||
end Minesweeper;
|
||||
|
|
@ -105,7 +105,7 @@ proc test ind .
|
|||
.
|
||||
.
|
||||
.
|
||||
background 676
|
||||
gbackground 676
|
||||
proc start .
|
||||
gclear
|
||||
gcolor 353
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue