Implemented random integer package...
This commit is contained in:
parent
87ff5a032b
commit
5144a2569a
91
xerbia.adb
91
xerbia.adb
@ -1,6 +1,8 @@
|
|||||||
with ada.text_io;
|
with ada.text_io;
|
||||||
use ada.text_io;
|
use ada.text_io;
|
||||||
|
|
||||||
|
with ada.numerics.discrete_random;
|
||||||
|
|
||||||
procedure xerbia is
|
procedure xerbia is
|
||||||
|
|
||||||
------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
|
------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
|
||||||
@ -20,21 +22,12 @@ procedure xerbia is
|
|||||||
|
|
||||||
------------------------------------------------------------------------------------------
|
------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
function grey (text : in string) return string is begin return ascii.esc & "[1;30m" & text & ascii.esc & "[0m"; end grey;
|
subtype random_integer_range is integer range 0 .. 1024;
|
||||||
function red (text : in string) return string is begin return ascii.esc & "[1;31m" & text & ascii.esc & "[0m"; end red;
|
|
||||||
function green (text : in string) return string is begin return ascii.esc & "[1;32m" & text & ascii.esc & "[0m"; end green;
|
|
||||||
function yellow (text : in string) return string is begin return ascii.esc & "[1;33m" & text & ascii.esc & "[0m"; end yellow;
|
|
||||||
function blue (text : in string) return string is begin return ascii.esc & "[1;34m" & text & ascii.esc & "[0m"; end blue;
|
|
||||||
function pink (text : in string) return string is begin return ascii.esc & "[1;35m" & text & ascii.esc & "[0m"; end pink;
|
|
||||||
function cyan (text : in string) return string is begin return ascii.esc & "[1;36m" & text & ascii.esc & "[0m"; end cyan;
|
|
||||||
function white (text : in string) return string is begin return ascii.esc & "[1;37m" & text & ascii.esc & "[0m"; end white;
|
|
||||||
|
|
||||||
population : natural := 0;
|
package random_integer_package is new ada.numerics.discrete_random (random_integer_range);
|
||||||
reputation : integer := 0;
|
use random_integer_package;
|
||||||
migration : integer := 0;
|
|
||||||
|
|
||||||
resource : array (resource_type) of integer := (others => 0);
|
------------------------------------------------------------------------------------------
|
||||||
construction : array (construction_type) of natural := (others => 0);
|
|
||||||
|
|
||||||
reply_text : constant array (reply_type) of access string := (
|
reply_text : constant array (reply_type) of access string := (
|
||||||
new string'("Quit game."),
|
new string'("Quit game."),
|
||||||
@ -55,6 +48,33 @@ procedure xerbia is
|
|||||||
(0, 60, 30, 10)
|
(0, 60, 30, 10)
|
||||||
);
|
);
|
||||||
|
|
||||||
|
seed : generator;
|
||||||
|
|
||||||
|
population : natural := 0;
|
||||||
|
reputation : integer := 0;
|
||||||
|
migration : integer := 0;
|
||||||
|
|
||||||
|
resource : array (resource_type) of integer := (others => 0);
|
||||||
|
construction : array (construction_type) of natural := (others => 0);
|
||||||
|
|
||||||
|
------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
function randomize (minimum, maximum : in integer) return integer is
|
||||||
|
begin
|
||||||
|
return random (seed) mod (maximum - minimum + 1) + minimum;
|
||||||
|
end randomize;
|
||||||
|
|
||||||
|
------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
function grey (text : in string) return string is begin return ascii.esc & "[1;30m" & text & ascii.esc & "[0m"; end grey;
|
||||||
|
function red (text : in string) return string is begin return ascii.esc & "[1;31m" & text & ascii.esc & "[0m"; end red;
|
||||||
|
function green (text : in string) return string is begin return ascii.esc & "[1;32m" & text & ascii.esc & "[0m"; end green;
|
||||||
|
function yellow (text : in string) return string is begin return ascii.esc & "[1;33m" & text & ascii.esc & "[0m"; end yellow;
|
||||||
|
function blue (text : in string) return string is begin return ascii.esc & "[1;34m" & text & ascii.esc & "[0m"; end blue;
|
||||||
|
function pink (text : in string) return string is begin return ascii.esc & "[1;35m" & text & ascii.esc & "[0m"; end pink;
|
||||||
|
function cyan (text : in string) return string is begin return ascii.esc & "[1;36m" & text & ascii.esc & "[0m"; end cyan;
|
||||||
|
function white (text : in string) return string is begin return ascii.esc & "[1;37m" & text & ascii.esc & "[0m"; end white;
|
||||||
|
|
||||||
------------------------------------------------------------------------------------------
|
------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
procedure separator is
|
procedure separator is
|
||||||
@ -126,8 +146,30 @@ procedure xerbia is
|
|||||||
|
|
||||||
------------------------------------------------------------------------------------------
|
------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
procedure print_constructions is
|
||||||
|
begin
|
||||||
|
for index in construction_type loop
|
||||||
|
case construction (index) is
|
||||||
|
when 0 => put_line ("You don't have any construction of type " & red (construction_type'image (index)) & ".");
|
||||||
|
when 1 => put_line ("You have " & blue ("1") & " construction of type " & blue (construction_type'image (index)) & ".");
|
||||||
|
when others => put_line ("You have" & blue (construction (index)'image) & " constructions of type " & blue (construction_type'image (index)) & ".");
|
||||||
|
end case;
|
||||||
|
end loop;
|
||||||
|
--
|
||||||
|
separator;
|
||||||
|
end print_constructions;
|
||||||
|
|
||||||
------------------------------------------------------------------------------------------
|
------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
procedure print_statistics is
|
||||||
|
begin
|
||||||
|
put_line ("Reputation =" & reputation'image);
|
||||||
|
put_line ("Migration =" & migration'image);
|
||||||
|
put_line ("Population =" & population'image);
|
||||||
|
--
|
||||||
|
separator;
|
||||||
|
end print_statistics;
|
||||||
|
|
||||||
------------------------------------------------------------------------------------------
|
------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
------------------------------------------------------------------------------------------
|
------------------------------------------------------------------------------------------
|
||||||
@ -136,12 +178,31 @@ procedure xerbia is
|
|||||||
|
|
||||||
begin
|
begin
|
||||||
|
|
||||||
|
reset (seed);
|
||||||
|
|
||||||
|
reputation := randomize (0, 10);
|
||||||
|
migration := randomize (0, 10);
|
||||||
|
population := randomize (6, 12) * 20 + migration;
|
||||||
|
|
||||||
|
for index in resource_type loop
|
||||||
|
resource (index) := randomize (6, 12) * 20;
|
||||||
|
end loop;
|
||||||
|
|
||||||
|
for index in construction_type loop
|
||||||
|
construction (index) := randomize (1, 2);
|
||||||
|
end loop;
|
||||||
|
|
||||||
separator;
|
separator;
|
||||||
separator;
|
|
||||||
separator;
|
put_line (grey ("-- Xerbia is clone of ") & white ("Sumerian Game") & grey (", made for fun in readable and formatted ANSI C."));
|
||||||
|
put_line (grey ("-- Original game was designed by ") & white ("Mabel Addis") & grey (" and programmed by ") & white ("William McKay") & grey (" in 1964."));
|
||||||
|
put_line (grey ("-- "));
|
||||||
|
put_line (grey ("-- ") & blue ("Ognjen 'xolatile' Milan Robovic"));
|
||||||
|
|
||||||
print_help;
|
print_help;
|
||||||
print_resources;
|
print_resources;
|
||||||
|
print_constructions;
|
||||||
|
print_statistics;
|
||||||
|
|
||||||
------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
|
------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user