Finished similar Ada version...

xerbia.adb

@@ -1,6 +1,8 @@
 with ada.text_io;
 use  ada.text_io;
 
+with ada.numerics.discrete_random;
+
 procedure xerbia is
 
 ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
@@ -20,21 +22,12 @@ procedure xerbia is
 
                                              ------------------------------------------------------------------------------------------
 
-	function grey   (text : in string) return string is begin return ascii.esc & "[1;30m" & text & ascii.esc & "[0m"; end grey;
+	subtype random_integer_range is integer range -1024 .. 1024;
-	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;
 
-	population : natural := 0;
+	package random_integer_package is new ada.numerics.discrete_random (random_integer_range);
-	reputation : integer := 0;
+	use     random_integer_package;
-	migration  : integer := 0;
 
-	resource     : array (resource_type)     of integer := (others => 0);
+                                             ------------------------------------------------------------------------------------------
-	construction : array (construction_type) of natural := (others => 0);
 
 	reply_text : constant array (reply_type) of access string := (
 		new string'("Quit game."),
@@ -55,6 +48,35 @@ procedure xerbia is
 		(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
@@ -64,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;
@@ -84,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;
@@ -126,22 +163,170 @@ procedure xerbia is
 
                                              ------------------------------------------------------------------------------------------
 
-                                             ------------------------------------------------------------------------------------------
+	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
 
-	separator;
+	reset (seed);
-	separator;
+
+	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;
 
-	print_help;
+	put_line (grey ("-- Xerbia is clone of ") & white ("Sumerian Game") & grey (", made for fun in readable and formatted ANSI C."));
-	print_resources;
+	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;
 
 ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------