diff --git a/xerbia.adb b/xerbia.adb index b85b88d..d95032b 100644 --- a/xerbia.adb +++ b/xerbia.adb @@ -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); use random_integer_package; @@ -57,6 +57,8 @@ procedure xerbia is 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 @@ -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 input : string (1 .. 1024); + count : integer; begin - loop input := get_line; + loop get_line (input, count); -- 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); end if; end loop; @@ -104,11 +120,12 @@ procedure xerbia is function query_construction return construction_type is input : string (1 .. 1024); + count : integer; begin - loop input := get_line; + loop get_line (input, count); -- 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); end if; 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 @@ -199,10 +303,30 @@ begin put_line (grey ("-- ")); put_line (grey ("-- ") & blue ("Ognjen 'xolatile' Milan Robovic")); - print_help; - print_resources; + 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; - print_statistics; + + put_line (grey ("The end!")); + + separator; ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------