xerbia/xerbia.adb

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;