xhads/source/world.adb

-- Copyright (c) 2024 - Ognjen 'xolatile' Milan Robovic
--
-- GNU General Public Licence (version 3 or later)

with core, resource, item, unit, construction, world;

package body world is

------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------

	type sprite_array is array (natural range <>) of core.sprite;

	type world_array is array (natural range <>) of access information;

	type limit_array is array (codex) of integer;

	type landmark_sprite_array is array (codex) of access sprite_array;

                                             ------------------------------------------------------------------------------------------

	blocks    : core.sprite;
	landmarks : landmark_sprite_array := (others => null);

	limit : constant limit_array := (2, 2, 2, 2, 2, 2);

	landmark_limit     : constant integer := 140;
	construction_limit : constant integer :=  40;
	item_limit         : constant integer :=  40;

                                             ------------------------------------------------------------------------------------------

	procedure configure is
	begin
		core.echo (core.comment, "Configuring world components...");
		--
		blocks := core.import_sprite ("./sprite/world/terrain/terrain.png", 1, 1);
		--
		for index in codex
		loop
			landmarks (index) := new sprite_array (0 .. limit (index) - 1);
			--
			for value in 0 .. limit (index) - 1
			loop
				declare
					folder : constant string := core.lowercase (codex'image (index));
					file   : constant string := value'image;
				begin
					landmarks (index) (value) := core.import_sprite ("./sprite/world/landmark/" & folder & "/" & file & ".png", 1, 1);
				end;
			end loop;
		end loop;
	end configure;

                                             ------------------------------------------------------------------------------------------

	procedure make (index : in codex; width, height : in natural) is
	begin
		core.echo (core.comment, "-- Procedurally generating new map...");
		--
		core.echo (core.comment, "-- -- Map type           : " & index'image);
		core.echo (core.comment, "-- -- Map width          :"  & width'image);
		core.echo (core.comment, "-- -- Map height         :"  & height'image);
		core.echo (core.comment, "-- -- Landmark count     :"  & landmark_limit'image);
		core.echo (core.comment, "-- -- Construction count :"  & construction_limit'image);
		core.echo (core.comment, "-- -- Item count         :"  & item_limit'image);
		--
		map.terrain      := index;
		map.width        := width;
		map.height       := height;
		map.block        := new block_array  (0 .. width - 1, 0 .. height - 1);
		map.landmark     := new entity_array (0 .. landmark_limit);
		map.construction := new entity_array (0 .. construction_limit);
		map.item         := new entity_array (0 .. item_limit);
		--
		for x in 0 .. width - 1
		loop
			for y in 0 .. height - 1
			loop
				map.block (x, y) := core.random_integer (0, 23);
			end loop;
		end loop;
		--
		for object in 0 .. landmark_limit
		loop
			map.landmark (object).index := core.random_integer (0, limit (index) - 1);
			map.landmark (object).x     := core.base * core.random_integer (1, map.width  - 1);
			map.landmark (object).y     := core.base * core.random_integer (1, map.height - 1);
		end loop;
		--
		for object in 0 .. construction_limit
		loop
			map.construction (object).index := core.random_integer (0, construction.codex'pos (construction.codex'last));
			map.construction (object).x     := core.base * core.random_integer (1, map.width  - 1);
			map.construction (object).y     := core.base * core.random_integer (1, map.height - 1);
		end loop;
		--
		for object in 0 .. item_limit
		loop
			map.item (object).index := core.random_integer (0, item.codex'pos (item.codex'last));
			map.item (object).x     := core.base * core.random_integer (1, map.width  - 1);
			map.item (object).y     := core.base * core.random_integer (1, map.height - 1);
		end loop;
		--
		core.echo (core.success, "Finished procedurally generating new map.");
	end make;

                                             ------------------------------------------------------------------------------------------

	procedure draw (x, y, width, height : in integer; show_grid : in boolean) is
		crop_width  : integer := width  mod core.base;
		crop_height : integer := height mod core.base;
		u, v        : integer;
	begin
		for move_y in 0 .. height / core.base - 1
		loop
			for move_x in 0 .. + width / core.base - 1
			loop
				u := core.base * codex'pos (map.terrain) * 4;
				v := core.base * map.block (core.camera.x + move_x, core.camera.y + move_y);
				--
				core.crop (blocks, x + move_x * core.base, y + move_y * core.base, u, v, core.base, core.base);
			end loop;
			--
			u := core.base * codex'pos (map.terrain) * 4;
			v := core.base * map.block (width / core.base, core.camera.y + move_y);
			--
			core.crop (blocks, x + width - crop_width, y + move_y * core.base, u, v, crop_width, core.base);
		end loop;
		--
		for move_x in 0 .. width / core.base - 1
		loop
			u := core.base * codex'pos (map.terrain) * 4;
			v := core.base * map.block (core.camera.x + move_x, height / core.base);
			--
			core.crop (blocks, x + move_x * core.base, y + height - crop_height, u, v, core.base, crop_height);
		end loop;
		--
		u := core.base * codex'pos (map.terrain) * 4;
		v := core.base * map.block (width / core.base, height / core.base);
		--
		core.crop (blocks, x + width - crop_width, y + height - crop_height, u, v, crop_width, crop_height);
		--
		for object in 0 .. landmark_limit
		loop
			core.view (landmarks (map.terrain) (map.landmark (object).index),
			           map.landmark (object).x - core.camera.x * core.base,
			           map.landmark (object).y - core.camera.y * core.base,
			           x, y, width, height);
		end loop;
		--
		if show_grid then
			core.hexagonal_grid (x, y, width, height, false);
			core.hexagonal_grid (x, y, width, height, true);
		end if;
		--
		for object in 0 .. construction_limit
		loop
			if map.construction (object).x > width
			or map.construction (object).y > height then
				goto skip_drawing_out_of_view_construction;
			end if;
			--
			construction.draw (construction.codex'val (map.construction (object).index),
			                   map.construction (object).x - core.camera.x * core.base,
			                   map.construction (object).y - core.camera.y * core.base);
			--
			<<skip_drawing_out_of_view_construction>>
		end loop;
		--
		for object in 0 .. item_limit
		loop
			if map.item (object).x > width
			or map.item (object).y > height then
				goto skip_drawing_out_of_view_item;
			end if;
			--
			item.draw (item.codex'val (map.item (object).index),
			           map.item (object).x - core.camera.x * core.base,
			           map.item (object).y - core.camera.y * core.base);
			--
			<<skip_drawing_out_of_view_item>>
		end loop;
	end draw;

------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------

end world;