xhads/source/core.adb

with core;

use core;

package body core is

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

	procedure configure is
	begin
		engine_configure;
		--
		hexagon_grid_sprite := load_sprite ("./sprite/ui/hexagon_grid_tile.png", 1, 1);
		hexagon_fill_sprite := load_sprite ("./sprite/ui/hexagon_fill_tile.png", 1, 1);
	end configure;

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

	procedure synchronize is
	begin
		global_time := global_time + 1;
		--
		global_time    := global_time mod (gameplay_framerate * animation_framerate);
		gameplay_time  := global_time mod (gameplay_framerate);
		animation_time := global_time /   (gameplay_framerate / animation_framerate);
		--
		engine_synchronize;
	end synchronize;

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

	procedure draw_state_box (x, y : in integer) is
	begin
		write ("Cursor X       :" & integer'image (cursor_x),                          x, y +   0, 16#CCCCCC#);
		write ("Cursor Y       :" & integer'image (cursor_y),                          x, y +  32, 16#CCCCCC#);
		write ("Cursor Mode    :" & integer'image (cursor_mode),                       x, y +  64, 16#CCCCCC#);
		write ("Signal Code    :" & signal_code'image (signal_code'val (signal_mode)), x, y +  96, 16#CCCCCC#);
		write ("Camera X       :" & integer'image (camera.x),                          x, y + 128, 16#CCCCCC#);
		write ("Camera Y       :" & integer'image (camera.y),                          x, y + 160, 16#CCCCCC#);
		write ("Global Time    :" & integer'image (global_time),                       x, y + 192, 16#CCCCCC#);
		write ("Gameplay Time  :" & integer'image (gameplay_time),                     x, y + 224, 16#CCCCCC#);
		write ("Animation Time :" & integer'image (animation_time),                    x, y + 256, 16#CCCCCC#);
		write ("Framerate      :" & integer'image (framerate),                         x, y + 288, 16#CCCCCC#);
	end draw_state_box;

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

	function flip_coin return integer is
	begin
		return (random_integer (0, 1));
	end flip_coin;

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

	function roll_dice return integer is
	begin
		return (random_integer (1, 6));
	end roll_dice;

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

	function by_chance (chance : in integer) return integer is
	begin
		return (random_integer (0, 100) mod chance);
	end by_chance;

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

	function sigmoid (value : in boolean) return integer is
	begin
		return (if value then -1 else 1);
	end sigmoid;

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

	function c_string (ada_string : string) return string is
	begin
		return (ada_string & character'val (0));
	end c_string;

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

	function clip (value, minimum, maximum : in integer) return integer is
	begin
		if     value < minimum then return minimum; end if;
		if     value > maximum then return maximum; end if;
		return value;
	end clip;

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

	function load_sprite (file_path : in string; frames, states : in integer) return sprite is
		this : sprite;
	begin
		this.index  := import_sprite (c_string (file_path));
		this.width  := sprite_width  (this.index) / states;
		this.height := sprite_height (this.index) / frames;
		this.frames := frames;
		this.states := states;
		--
		return this;
	end load_sprite;

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

	procedure crop (data : in sprite; x, y, u, v, width, height : in integer) is
	begin
		render_sprite (data.index, x, y, u, v, width, height);
	end crop;

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

	procedure view (data : in sprite; x, y, u, v, width, height : in integer) is
		--~crop_u, crop_v, crop_width, crop_height : integer;
	begin
		if x > u + width
		or y > v + height
		or x < u - data.width
		or y < v - data.height then
			return;
		end if;
		--
		--~crop_width  := data.width  - (if x + data.width  > u + width  then (x + data.width)  mod (u + width)  else 0);
		--~crop_height := data.height - (if y + data.height > v + height then (y + data.height) mod (v + height) else 0);
		--
		--~crop_u := (if x < u then data.width  - u mod (x + data.width)  else 0);
		--~crop_v := (if y < v then data.height - v mod (y + data.height) else 0);
		--~crop_u := (if x < u and x < u - data.width  then data.width  - (x + data.width)  mod u else 0);
		--~crop_v := (if y < v and y < v - data.height then data.height - (y + data.height) mod v else 0);
		--~crop_u := data.width  - (if x < u then (x + data.width)  mod u else 0);
		--~crop_v := data.height - (if y < v then (y + data.height) mod v else 0);
		--~crop_u := data.width  - (if x < u then u mod x else 0);
		--~crop_v := data.height - (if y < v then v mod y else 0);
		--
		--~render_sprite (data.index, x, y, crop_u, crop_v, crop_width, crop_height);
		render_sprite (data.index, x, y, 0, 0, data.width, data.height);
	end view;

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

	procedure draw (data : in sprite; x, y : in integer) is
	begin
		render_sprite (data.index, x, y, 0, 0, data.width, data.height);
	end draw;

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

	procedure move (data : in sprite; x, y, frame, state : in integer) is
	begin
		render_sprite (data.index, x, y, state * data.width, (animation_time mod frame) * data.height, data.width, data.height);
	end move;

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

	procedure line (origin, offset : in vector_2) is
	begin
		render_vector (origin.x, origin.y, origin.x + offset.x, origin.y + offset.y);
	end line;

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

	procedure write (text : in string; x, y : in integer; colour : in integer := 16#A37A28#) is
	begin
		render_string (c_string (text), x, y, colour, 0);
	end write;

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

	procedure debug (text : in string) is
	begin
		put_line ("> " & text);
	end debug;

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

	procedure hexagonal_grid (x, y, width, height : in integer; fill : in boolean) is
		crop_width  : constant integer := width  mod hexagon_grid_sprite.width;
		crop_height : constant integer := height mod hexagon_grid_sprite.height;
		use_sprite  : constant sprite  := (if fill then hexagon_fill_sprite else hexagon_grid_sprite);
	begin
		for move_y in 0 .. height / hexagon_grid_sprite.height - 1
		loop
			for move_x in 0 .. width / hexagon_grid_sprite.width - 1
			loop
				draw (use_sprite, x + move_x * hexagon_grid_sprite.width, y + move_y * hexagon_grid_sprite.height);
			end loop;
			--
			crop (use_sprite, x + width - crop_width, y + move_y * hexagon_grid_sprite.height, 0, 0, crop_width, hexagon_grid_sprite.height);
		end loop;
		--
		for move_x in 0 .. width / hexagon_grid_sprite.width - 1
		loop
			crop (use_sprite, x + move_x * hexagon_grid_sprite.width, y + height - crop_height, 0, 0, hexagon_grid_sprite.width, crop_height);
		end loop;
		--
		crop (use_sprite, x + width - crop_width, y + height - crop_height, 0, 0, crop_width, crop_height);
	end hexagonal_grid;

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

	function lowercase (text : in string) return string is
		result : string (1 .. text'length);
	begin
		for index in text'range
		loop
			if text (index) in 'A' .. 'Z' then
				result (index) := character'val (character'pos (text (index)) + 32);
			else
				result (index) := text (index);
			end if;
		end loop;
		--
		return result;
	end lowercase;

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

	function uppercase (text : in string) return string is
		result : string (1 .. text'length);
	begin
		for index in text'range
		loop
			if text (index) in 'a' .. 'z' then
				result (index) := character'val (character'pos (text (index)) - 32);
			else
				result (index) := text (index);
			end if;
		end loop;
		--
		return result;
	end uppercase;

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

	procedure draw_central_grid (x, y, width, height : in integer) is
	begin
		render_vector (width / 2 + x,              y, width / 2 + x, height     + y);
		render_vector (            x, height / 2 + y, width     + x, height / 2 + y);
	end draw_central_grid;

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

	procedure draw_squared_grid (x, y, width, height : in integer) is
		offset : constant vector_2 := (((width - base) / 2) mod base, ((height - base) / 2) mod base);
		repeat : constant vector_2 := (2 * (((width - base) / 2) / base) + 1, 2 * (((height - base) / 2) / base) + 1);
	begin
		for next in 0 .. repeat.y
		loop
			line ((x, y + offset.y + next * base), (width, 0));
		end loop;
		--
		if repeat.y mod 4 = 1 then
			for next in 0 .. repeat.x - 1 loop line ((x + offset.x + base / 2 + next * base, y                    ), (0, offset.y)); end loop;
			for next in 0 .. repeat.x - 1 loop line ((x + offset.x + base / 2 + next * base, y + height - offset.y), (0, offset.y)); end loop;
			--
			for step in 0 .. repeat.y / 2 - 1 loop
				for next in 0 .. repeat.x - 1 loop line ((x + offset.x + base / 2 + next * base, y + base + offset.y + 2 * step * base), (0, base)); end loop;
			end loop;
			for step in 0 .. repeat.y / 2 loop
				for next in 0 .. repeat.x loop line ((x + offset.x + next * base, y + offset.y + 2 * step * base), (0, base)); end loop;
			end loop;
		else
			for next in 0 .. repeat.x - 1 loop line ((x + offset.x + next * base, y                    ), (0, offset.y)); end loop;
			for next in 0 .. repeat.x - 1 loop line ((x + offset.x + next * base, y + height - offset.y), (0, offset.y)); end loop;
			--
			for step in 0 .. repeat.y / 2 - 1 loop
				for next in 0 .. repeat.x loop line ((x + offset.x + next * base, y + base + offset.y + 2 * step * base), (0, base)); end loop;
			end loop;
			for step in 0 .. repeat.y / 2 loop
				for next in 0 .. repeat.x - 1 loop line ((x + offset.x + base / 2 + next * base, y + offset.y + 2 * step * base), (0, base)); end loop;
			end loop;
		end if;
	end draw_squared_grid;

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

	procedure draw_hexagon_grid (x, y, width, height : in integer) is
		offset : constant vector_2 := (((width - base) / 2) mod base, ((height - base) / 2) mod base);
		repeat : constant vector_2 := (2 * (((width - base) / 2) / base) + 1, 2 * (((height - base) / 2) / base) + 1);
	begin
		for step in 0 .. repeat.y
		loop
			if step mod 2 = 1 then
				for next in 0 .. repeat.x - 1
				loop
					line ((x + offset.x + base / 2 + next * base, y + offset.y + step * base + base / 4), (-base / 2, -base / 2));
					line ((x + offset.x + base / 2 + next * base, y + offset.y + step * base + base / 4), ( base / 2, -base / 2));
				end loop;
			else
				for next in 0 .. repeat.x - 1
				loop
					line ((x + offset.x + base / 2 + next * base, y + offset.y + step * base - base / 4), (-base / 2, base / 2));
					line ((x + offset.x + base / 2 + next * base, y + offset.y + step * base - base / 4), ( base / 2, base / 2));
				end loop;
			end if;
		end loop;
		--
		if repeat.y mod 4 = 1 then
			for next in 0 .. repeat.x - 1 loop line ((x + offset.x + base / 2 + next * base, y                               ), (0, offset.y - base / 4)); end loop;
			for next in 0 .. repeat.x - 1 loop line ((x + offset.x + base / 2 + next * base, y + base / 4 + height - offset.y), (0, offset.y - base / 4)); end loop;
			--
			for step in 0 .. repeat.y / 2 - 1 loop
				for next in 0 .. repeat.x - 1 loop line ((x + offset.x + base / 2 + next * base, y + 5 * base / 4 + offset.y + 2 * step * base), (0, base / 2)); end loop;
			end loop;
			for step in 0 .. repeat.y / 2 loop
				for next in 0 .. repeat.x loop line ((x + offset.x + next * base, y + base / 4 + offset.y + 2 * step * base), (0, base / 2)); end loop;
			end loop;
		else
			for next in 0 .. repeat.x - 1 loop line ((x + offset.x + next * base, y                    ), (0, offset.y)); end loop;
			for next in 0 .. repeat.x - 1 loop line ((x + offset.x + next * base, y + height - offset.y), (0, offset.y)); end loop;
			--
			for step in 0 .. repeat.y / 2 - 1 loop
				for next in 0 .. repeat.x loop line ((x + offset.x + next * base, y + 5 * base / 4 + offset.y + 2 * step * base), (0, base / 2)); end loop;
			end loop;
			for step in 0 .. repeat.y / 2 loop
				for next in 0 .. repeat.x - 1 loop line ((x + offset.x + base / 2 + next * base, y + base / 4 + offset.y + 2 * step * base), (0, base / 2)); end loop;
			end loop;
		end if;
	end draw_hexagon_grid;

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

end core;