Finished similar Ada version...

This commit is contained in:
Ognjen Milan Robovic 2024-06-17 09:14:42 -04:00
parent 5144a2569a
commit ec0406cefa

View File

@ -22,7 +22,7 @@ procedure xerbia is
------------------------------------------------------------------------------------------ ------------------------------------------------------------------------------------------
subtype random_integer_range is integer range 0 .. 1024; subtype random_integer_range is integer range -1024 .. 1024;
package random_integer_package is new ada.numerics.discrete_random (random_integer_range); package random_integer_package is new ada.numerics.discrete_random (random_integer_range);
use random_integer_package; use random_integer_package;
@ -57,6 +57,8 @@ procedure xerbia is
resource : array (resource_type) of integer := (others => 0); resource : array (resource_type) of integer := (others => 0);
construction : array (construction_type) of natural := (others => 0); construction : array (construction_type) of natural := (others => 0);
reply : reply_type := help;
------------------------------------------------------------------------------------------ ------------------------------------------------------------------------------------------
function randomize (minimum, maximum : in integer) return integer is function randomize (minimum, maximum : in integer) return integer is
@ -84,13 +86,27 @@ procedure xerbia is
------------------------------------------------------------------------------------------ ------------------------------------------------------------------------------------------
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 function query_reply return reply_type is
input : string (1 .. 1024); input : string (1 .. 1024);
count : integer;
begin begin
loop input := get_line; loop get_line (input, count);
-- --
for index in reply_type loop for index in reply_type loop
if input <= reply_type'image (index) then if limited_string_equality (input, reply_type'image (index)) then
return (index); return (index);
end if; end if;
end loop; end loop;
@ -104,11 +120,12 @@ procedure xerbia is
function query_construction return construction_type is function query_construction return construction_type is
input : string (1 .. 1024); input : string (1 .. 1024);
count : integer;
begin begin
loop input := get_line; loop get_line (input, count);
-- --
for index in construction_type loop for index in construction_type loop
if input = construction_type'image (index) then if limited_string_equality (input, construction_type'image (index)) then
return (index); return (index);
end if; end if;
end loop; end loop;
@ -172,8 +189,95 @@ procedure xerbia is
------------------------------------------------------------------------------------------ ------------------------------------------------------------------------------------------
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 begin
@ -199,10 +303,30 @@ begin
put_line (grey ("-- ")); put_line (grey ("-- "));
put_line (grey ("-- ") & blue ("Ognjen 'xolatile' Milan Robovic")); put_line (grey ("-- ") & blue ("Ognjen 'xolatile' Milan Robovic"));
print_help; gameplay: loop
print_resources; 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; print_constructions;
print_statistics;
put_line (grey ("The end!"));
separator;
------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------ ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------