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;