334 lines
12 KiB
Ada
334 lines
12 KiB
Ada
with ada.text_io;
|
|
use ada.text_io;
|
|
|
|
with ada.numerics.discrete_random;
|
|
|
|
procedure xerbia is
|
|
|
|
------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
|
|
|
|
type resource_type is (
|
|
wheat, gold, wood, stone
|
|
);
|
|
|
|
type construction_type is (
|
|
granary, mine, storehouse, quarry
|
|
);
|
|
|
|
type reply_type is (
|
|
quit, help, report, status, build, train, trade, plant,
|
|
turn
|
|
);
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
subtype random_integer_range is integer range -1024 .. 1024;
|
|
|
|
package random_integer_package is new ada.numerics.discrete_random (random_integer_range);
|
|
use random_integer_package;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
reply_text : constant array (reply_type) of access string := (
|
|
new string'("Quit game."),
|
|
new string'("Print reply strings and their explanation, like this one."),
|
|
new string'("Request a report from your court advisors about the state of your fortress."),
|
|
new string'("Request a meeting with lords and merchants about affairs in your fiefdom."),
|
|
new string'("Propose what kind of construction should be built this month to your architect."),
|
|
new string'("Spend more time training with your warriors this entire month."),
|
|
new string'("Discuss what goods should be sold or bought this month with merchant guild."),
|
|
new string'("Order what kind of plants should your peasants harvest this month."),
|
|
new string'("Submit your monthly strategy to the council and wait until next month.")
|
|
);
|
|
|
|
construction_price : constant array (construction_type, resource_type) of natural := (
|
|
(0, 10, 60, 30),
|
|
(0, 120, 60, 10),
|
|
(0, 30, 10, 60),
|
|
(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);
|
|
|
|
reply : reply_type := help;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
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
|
|
begin
|
|
put_line (grey ("------------------------------------------------------------------------------------------"));
|
|
end separator;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
function limited_string_equality (input, equal : in string) return boolean is
|
|
begin
|
|
for index in equal'range loop
|
|
if input (index) /= equal (index) then
|
|
return false;
|
|
end if;
|
|
end loop;
|
|
--
|
|
return true;
|
|
end limited_string_equality;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
function query_reply return reply_type is
|
|
input : string (1 .. 1024);
|
|
count : integer;
|
|
begin
|
|
loop get_line (input, count);
|
|
--
|
|
for index in reply_type loop
|
|
if limited_string_equality (input, reply_type'image (index)) then
|
|
return (index);
|
|
end if;
|
|
end loop;
|
|
--
|
|
put_line ("Incorrect " & red ("reply") & ", type '" & blue ("help") & "' to list replies or look at message above.");
|
|
--
|
|
end loop;
|
|
end query_reply;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
function query_construction return construction_type is
|
|
input : string (1 .. 1024);
|
|
count : integer;
|
|
begin
|
|
loop get_line (input, count);
|
|
--
|
|
for index in construction_type loop
|
|
if limited_string_equality (input, construction_type'image (index)) then
|
|
return (index);
|
|
end if;
|
|
end loop;
|
|
--
|
|
put_line ("Incorrect " & red ("construction") & ", type '" & blue ("help") & "' to list replies or look at message above.");
|
|
--
|
|
end loop;
|
|
end query_construction;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
procedure print_help is
|
|
begin
|
|
for index in reply_type loop
|
|
put_line (blue (reply_type'image (index)) & grey (" <> ") & reply_text (index).all);
|
|
end loop;
|
|
--
|
|
separator;
|
|
end print_help;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
procedure print_resources is
|
|
begin
|
|
for index in resource_type loop
|
|
case resource (index) is
|
|
when 0 => put_line ("You don't have any " & red (resource_type'image (index)) & ".");
|
|
when 1 => put_line ("You have " & blue ("1") & " unit of " & blue (resource_type'image (index)) & ".");
|
|
when others => put_line ("You have" & blue (resource (index)'image) & " unit of " & blue (resource_type'image (index)) & ".");
|
|
end case;
|
|
end loop;
|
|
--
|
|
separator;
|
|
end print_resources;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
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;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
procedure build_construction is
|
|
reply : construction_type;
|
|
lacks : integer;
|
|
begin
|
|
for index in construction_type loop
|
|
put (grey ("->") & " build " & blue (construction_type'image (index)) & " (");
|
|
--
|
|
for price in resource_type loop
|
|
if (construction_price (index, price) > 0) then
|
|
if resource (price) < construction_price (index, price) then
|
|
put (resource_type'image (price) & red (integer'image (construction_price (index, price))));
|
|
else
|
|
put (resource_type'image (price) & green (integer'image (construction_price (index, price))));
|
|
end if;
|
|
end if;
|
|
--
|
|
if price /= resource_type'first and price /= resource_type'last then
|
|
put (", ");
|
|
end if;
|
|
end loop;
|
|
--
|
|
put_line (");");
|
|
end loop;
|
|
--
|
|
separator;
|
|
--
|
|
reply := query_construction;
|
|
--
|
|
separator;
|
|
--
|
|
for index in resource_type loop
|
|
if resource (index) < construction_price (reply, index) then
|
|
lacks := construction_price (reply, index) - resource (index);
|
|
--
|
|
put_line ("You're lacking " & red (resource_type'image (index)) & ", need" & red (lacks'image) & " more.");
|
|
put_line ("Your architect humbly refused to build " & construction_type'image (reply) & ".");
|
|
--
|
|
separator;
|
|
return;
|
|
end if;
|
|
end loop;
|
|
--
|
|
for index in resource_type loop
|
|
resource (index) := resource (index) - construction_price (reply, index);
|
|
end loop;
|
|
--
|
|
construction (reply) := construction (reply) + 1;
|
|
--
|
|
put_line ("Construction of " & green (construction_type'image (reply)) & " was completed successfully.");
|
|
--
|
|
separator;
|
|
end build_construction;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
procedure compute_turn is
|
|
problem : constant array (resource_type) of access string := (
|
|
new string'("rats"),
|
|
new string'("thieves"),
|
|
new string'("rotting"),
|
|
new string'("cracking")
|
|
);
|
|
--
|
|
gained, lost : integer := 0;
|
|
begin
|
|
put_line ("Your strategy has been submitted to the council, now you can only wait.");
|
|
put_line ("...");
|
|
put_line ("One month later, your advisor brings your short report on activities in your fortress.");
|
|
--
|
|
for index in resource_type loop
|
|
gained := construction (construction_type'val (resource_type'pos (index))) * 20;
|
|
lost := randomize (1, 10);
|
|
resource (index) := resource (index) + gained - lost;
|
|
--
|
|
put_line ("Your fortress gained" & green (gained'image) & " units of " & resource_type'image (index) & ", but lost" & red (lost'image) & " due to " & problem (index).all & ".");
|
|
end loop;
|
|
--
|
|
reputation := reputation + randomize (-3, 3) + resource (gold) / 120 + resource (wheat) / 60;
|
|
migration := randomize (0, 6) - resource (wheat) / 120;
|
|
population := population + migration;
|
|
resource (wheat) := resource (wheat) - population / 3;
|
|
resource (gold) := resource (gold) - abs reputation / 3;
|
|
--
|
|
put_line ("Beside that, " & red (integer'image (population / 3)) & " units of wheat was spent on feeding the people.");
|
|
put_line ("Also, only " & red (integer'image (abs reputation / 3)) & " gold was spent inside castle.");
|
|
--
|
|
separator;
|
|
end compute_turn;
|
|
|
|
------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
|
|
|
|
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;
|
|
|
|
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"));
|
|
|
|
gameplay: loop
|
|
separator;
|
|
|
|
exit when reply = quit;
|
|
|
|
case reply is
|
|
when help => print_help;
|
|
when report => print_resources;
|
|
when status => print_statistics;
|
|
when build => build_construction;
|
|
when turn => compute_turn;
|
|
when others => null;
|
|
end case;
|
|
|
|
reply := query_reply;
|
|
end loop gameplay;
|
|
|
|
separator;
|
|
|
|
print_constructions;
|
|
|
|
put_line (grey ("The end!"));
|
|
|
|
separator;
|
|
|
|
------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
|
|
|
|
end xerbia;
|