xhads/source/core.adb

with core;

use core;

package body core is

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

	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 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 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 write (text : in string; x, y : in integer) is
	begin
		null;
	end write;

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

	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);
		--~u, v        :          integer;
	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
				--~u := hexagon_grid_sprite.width  * codex'pos (map.terrain) * 4;
				--~v := hexagon_grid_sprite.height * map.block (move_x, move_y);
				--
				draw (use_sprite, x + move_x * hexagon_grid_sprite.width, y + move_y * hexagon_grid_sprite.height);
			end loop;
			--
			--~u := 0;
			--~v := hexagon_grid_sprite.height * map.block (width / hexagon_grid_sprite.width, move_y);
			--
			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
			--~u := 0;
			--~v := hexagon_grid_sprite.height * map.block (move_x, height / hexagon_grid_sprite.height);
			--
			crop (use_sprite, x + move_x * hexagon_grid_sprite.width, y + height - crop_height, 0, 0, hexagon_grid_sprite.width, crop_height);
		end loop;
		--
		--~u := 0;
		--~v := hexagon_grid_sprite.height * map.block (width / hexagon_grid_sprite.width, height / hexagon_grid_sprite.height);
		--
		crop (use_sprite, x + width - crop_width, y + height - crop_height, 0, 0, crop_width, crop_height);
	--~begin
		--~for y in 0 .. window_height / 48
		--~loop
			--~for x in 0 .. window_width / 32
			--~loop
				--~draw ((if fill then hexagon_fill_sprite else hexagon_grid_sprite), x * hexagon_grid_sprite.width, y * hexagon_grid_sprite.height);
			--~end loop;
		--~end loop;
	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;

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

end core;