xhads/source/world.adb

with ada.strings.fixed;
with core, menu, resource, item, unit, construction;

use world;

package body world is

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

	type entity is
	record
		index, x, y : integer;
	end record;

	type block_array  is array (natural range <>, natural range <>) of integer;
	type entity_array is array (natural range <>)                   of entity;

	type information is
	record
		terrain      : codex;
		width        : natural;
		height       : natural;
		block        : access block_array;
		landmark     : access entity_array;
		construction : access entity_array;
	end record;

	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);
	map       : information;

	limit : constant limit_array := (29, 64, 70, 94, 51, 94);

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

	procedure configure is
	begin
		blocks := core.load_sprite ("sprite/world/terrain/terrain.png", 1, 1);
		--
		for index in codex
		loop
			landmarks (index) := new sprite_array (0 .. limit (index));
			for value in 0 .. limit (index)
			loop
				declare
					folder : constant string := core.lowercase (codex'image (index));
					file   : constant string := ada.strings.fixed.trim (integer'image (value), ada.strings.left);
				begin
					landmarks (index) (value) := core.load_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
		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 .. 24);
		map.construction := new entity_array (0 .. 11);
		--
		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 .. 24
		loop
			map.landmark (object).index := core.random_integer (0, limit (index));
			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 .. 11
		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;
	end make;

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

	procedure draw (x, y, width, height : in integer; show_grid : in boolean) is
		crop_width  : constant integer := width  mod core.base;
		crop_height : constant 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 (move_x, 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, 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 (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 .. 24
		loop
			core.draw (landmarks (map.terrain) (map.landmark (object).index), map.landmark (object).x, map.landmark (object).y);
		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 .. 11
		loop
			construction.draw (construction.codex'val (map.construction (object).index), map.construction (object).x, map.construction (object).y);
		end loop;
	end draw;

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

end world;