xhads/source/core.adb

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

with ray;

package body core is

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

	type terminal_colour is (
		grey,                   red,                    green,                  yellow,                 blue,                   pink,
		cyan,                   white
	);

	type terminal_effect is (
		normal,                 bold,                   italic,                 underline,              blink,                  invert
	);

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

	type texture_data_array is array (natural range <>) of ray.texture;
	type sound_data_array   is array (natural range <>) of ray.sound;
	type font_data_array    is array (natural range <>) of ray.font;

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

	texture_count : integer := 0;
	sound_count   : integer := 0;
	font_count    : integer := 0;

	texture_array : access texture_data_array;
	sound_array   : access sound_data_array;
	font_array    : access font_data_array;

	game_icon : ray.image;

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

	procedure terminal (colour : in terminal_colour := white;
	                    effect : in terminal_effect := normal) is
		format : string := character'val (27) & "[" & character'val (terminal_effect'pos (effect) + 48) & ";3" & character'val (terminal_colour'pos (colour) + 48) & "m";
	begin
		put (format);
	end terminal;

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

	function "=" (a, b : in signal_code) return boolean is begin return natural (signal_code'pos (a))  = natural (signal_code'pos (b)); end "=";
	function "=" (a, b : in cursor_code) return boolean is begin return natural (cursor_code'pos (a))  = natural (cursor_code'pos (b)); end "=";
	function "/" (a, b : in signal_code) return boolean is begin return natural (signal_code'pos (a)) /= natural (signal_code'pos (b)); end "/";
	function "/" (a, b : in cursor_code) return boolean is begin return natural (cursor_code'pos (a)) /= natural (cursor_code'pos (b)); end "/";

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

	function "+" (data : in point; modifier : in natural) return point is
		this : point := data;
	begin
		this.value := (if (this.value + modifier) > this.limit then this.limit else (this.value + modifier));
		--
		return this;
	end "+";

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

	function "-" (data : in point; modifier : in natural) return point is
		this : point := data;
	begin
		this.value := (if (this.value - modifier) <= 0 then 0 else (this.value - modifier));
		--
		return this;
	end "-";

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

	function "*" (data : in point; modifier : in natural) return point is
		this : point := data;
	begin
		this.value := (if (this.value * modifier) > this.limit then this.limit else (this.value * modifier));
		--
		return this;
	end "*";

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

	function "/" (data : in point; modifier : in natural) return point is
		this : point := data;
	begin
		this.value := (if (this.value / modifier) <= 0 then 0 else (this.value / modifier));
		--
		return this;
	end "/";

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

	function "+" (data : in string)   return unstring is begin return core.unbound (data); end "+";
	function "-" (data : in unstring) return string   is begin return core.bound   (data); end "-";

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

	procedure echo (status : in echo_status;
	                text   : in string) is
	begin
		if not echo_mark (status) then
			return;
		end if;
		--
		put ("[");
		case status is
			when failure => terminal (red,    bold); put ("Failure"); terminal;
			when warning => terminal (yellow, bold); put ("Warning"); terminal;
			when success => terminal (green,  bold); put ("Success"); terminal;
			when comment => terminal (grey,   bold); put ("Comment"); terminal;
			when import  => terminal (cyan,   bold); put ("  <--  "); terminal;
			when export  => terminal (blue,   bold); put ("  -->  "); terminal;
		end case;
		put ("] ");
		--
		put_line (text);
	end echo;

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

	procedure echo_when (condition : in boolean; status : in echo_status; text : in string) is
	begin
		if condition then
			echo (status, text);
		end if;
	end echo_when;

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

	procedure dash is
	begin
		terminal (grey, bold);
		put ("------------------------------------------------------------------------------------------");
		put ("------------------------------------------------------------------------------------------");
		terminal;
		new_line;
	end dash;

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

	procedure semi_dash is
	begin
		terminal (grey, bold);
		put ("                                             ");
		put ("------------------------------------------------------------------------------------------");
		terminal;
		new_line;
	end semi_dash;

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

	function time return float is
	begin
		return float (ray.get_time);
	end time;

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

	function compress (data : in address; size : in integer; used : out integer) return address is
	begin
		return address (ray.compress (ray.pointer (data), size, used));
	end compress;

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

	function decompress (data : in address; size : in integer; used : out integer) return address is
	begin
		return address (ray.decompress (ray.pointer (data), size, used));
	end decompress;

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

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

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

	function random (minimum, maximum : in integer) return integer is
	begin
		return ray.get_random (minimum, maximum);
	end random;

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

	procedure clip (value : in out integer; minimum, maximum : in integer) is
	begin
		if value < minimum then value := minimum; end if;
		if value > maximum then value := maximum; end if;
	end clip;

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

	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 window_width  return integer is begin return ray.get_screen_width;  end window_width;
	function window_height return integer is begin return ray.get_screen_height; end window_height;

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

	function center_x (object : in integer) return integer is begin return (window_width  - object) / 2; end center_x;
	function center_y (object : in integer) return integer is begin return (window_height - object) / 2; end center_y;

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

	function cursor_inside (x, y, width, height : in integer) return boolean is
	begin
		return cursor.x > x and cursor.x < x + width * zoom and cursor.y > y and cursor.y < y + height * zoom;
	end cursor_inside;

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

	function import_sprite (file_path : in string; frames, states : in integer) return sprite is
		this : sprite;
	begin
		texture_array (texture_count) := ray.load_texture (c_string (file_path));
		--
		texture_count := texture_count + 1;
		this.index    := texture_count - 1;
		this.width    := texture_array (this.index).width / frames;
		this.height   := texture_array (this.index).height / states;
		this.frames   := frames;
		this.states   := states;
		--
		if this.width = 0 or this.height = 0 then
			echo (warning, "Sprite not imported: " & file_path);
		end if;
		--
		return this;
	end import_sprite;

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

	function import_font (file_path : in string; scale, space : in integer) return font is
		this : font;
	begin
		font_array (font_count) := ray.load_font (c_string (file_path));
		--
		font_count := font_count + 1;
		this.index := font_count - 1;
		this.scale := scale;
		this.space := space;
		--
		return this;
	end import_font;

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

	function import_song (file_path : in string) return song is
		this : song;
	begin
		sound_array (sound_count) := ray.load_sound (c_string (file_path));
		--
		sound_count := sound_count + 1;
		this.index  := sound_count - 1;
		--
		return this;
	end import_song;

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

	procedure import_text (data : in out string_box_data; file_path : in string) is
	begin
		data.text := to_unbounded_string (to_ada (ray.load_text (c_string (file_path)).all)) & character'val (0);
	end import_text;

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

	procedure create_image (width, height : in integer) is
	begin
		global_image := ray.image_colour (width, height, (0, 0, 0, 255));
	end create_image;

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

	procedure draw_pixel (x, y : in integer; tint : in colour) is
		new_tint : ray.colour := (ray.colour_range (tint.r), ray.colour_range (tint.g), ray.colour_range (tint.b), ray.colour_range (tint.a));
	begin
		ray.image_pixel (global_image, x, y, new_tint);
	end draw_pixel;

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

	procedure render_image (data : in sprite; x, y, u, v, width, height : in integer) is
		temporary : ray.image;
	begin
		temporary := ray.image_import (texture_array (data.index));
		--
		ray.image_render (data => global_image,
		                  copy => temporary,
		                  from => (float (u), float (v), float (width), float (height)),
		                  to   => (float (x), float (y), float (width), float (height)));
		--
		ray.image_delete (temporary);
	end render_image;

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

	procedure export_image (file_path : in string) is
		ignore : integer;
	begin
		ignore := ray.image_export (global_image, c_string (file_path));
		--
		ray.image_delete (global_image);
	end export_image;

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

	procedure draw (data   : in sprite    := (others => 0);
	                x      : in integer   := 0;
	                y      : in integer   := 0;
	                u      : in integer   := 0;
	                v      : in integer   := 0;
	                width  : in integer   := 0;
	                height : in integer   := 0;
	                ignore : in boolean   := false;
	                state  : in animation := idle;
	                factor : in integer   := zoom;
	                tint   : in colour    := (others => 255)) is
		new_width  : constant float := float ((if width  = 0 then data.width  else width));
		new_height : constant float := float ((if height = 0 then data.height else height));
		--
		new_tint : ray.colour := (ray.colour_range (tint.r), ray.colour_range (tint.g), ray.colour_range (tint.b), ray.colour_range (tint.a));
	begin
		ray.draw_texture (data => texture_array (data.index),
		                  uv   => (x      => float (if ignore then u else (animation_time        mod data.frames) * data.width),
		                           y      => float (if ignore then v else (animation'pos (state) mod data.states) * data.height),
		                           width  => new_width,
		                           height => new_height),
		                  view => (x      => float (x),
		                           y      => float (y),
		                           width  => new_width  * float (factor),
		                           height => new_height * float (factor)),
		                  tint => new_tint);
	end draw;

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

	procedure draw_horizontally (data : in sprite; x, y, width, factor : in integer; tint : in colour := (others => 255)) is
	begin
		for move in 0 .. width / data.width - 1 loop
			draw (data, x + move * data.width, y, tint => tint, factor => factor);
		end loop;
		--
		if width mod data.width > 0 then
			draw (data, x + (width / data.width) * data.width, y, 0, 0, width mod data.width, data.height, tint => tint, factor => factor);
		end if;
	end draw_horizontally;

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

	procedure draw_vertically (data : in sprite; x, y, height, factor : in integer; tint : in colour := (others => 255)) is
	begin
		for move in 0 .. height / data.height - 1 loop
			draw (data, x, y + move * data.height, tint => tint, factor => factor);
		end loop;
		--
		if height mod data.height > 0 then
			draw (data, x, y + (height / data.height) * data.height, 0, 0, data.width, height mod data.height, tint => tint, factor => factor);
		end if;
	end draw_vertically;

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

	procedure write (text : in string  := "";
	                 x    : in integer := 0;
	                 y    : in integer := 0;
	                 tint : in colour  := (others => 255);
	                 size : in integer := 0;
	                 data : in font    := (others => 0)) is
		new_tint : ray.colour := (ray.colour_range (tint.r), ray.colour_range (tint.g), ray.colour_range (tint.b), ray.colour_range (tint.a));
	begin
		ray.draw_text (data  => font_array (data.index),
		               text  => c_string (text),
		               view  => (float (x), float (y)),
		               scale => (if size = 0 then float (font_array (data.index).base) else float (size)),
		               space => float (font_array (data.index).pad),
		               tint  => new_tint);
	end write;

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

	procedure play (index : in integer) is begin ray.play_sound (sound_array (index)); end play;
	procedure stop (index : in integer) is begin ray.stop_sound (sound_array (index)); end stop;

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

	procedure overlay is
	begin
		ray.draw_rectangle (0, 0, window_width, window_height, (0, 0, 0, 127));
	end overlay;

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

	function read_help_box return string is begin return to_string (help_box.text); end read_help_box;
	function read_text_box return string is begin return to_string (text_box.text); end read_text_box;

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

	procedure write_help_box (text : in string) is begin help_box.text := to_unbounded_string (text); end write_help_box;
	procedure write_text_box (text : in string) is begin text_box.text := to_unbounded_string (text); end write_text_box;

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

	procedure save_point (here : in io.file_type; data : in point) is
	begin
		core.io.write (here, data.value);
		core.io.write (here, data.limit);
	end save_point;

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

	procedure load_point (here : in core.io.file_type; data : out point) is
	begin
		core.io.read (here, data.value);
		core.io.read (here, data.limit);
	end load_point;

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

	procedure increment (value : in out integer; super : in natural := 1) is begin value := value + super; end increment;
	procedure decrement (value : in out integer; super : in natural := 1) is begin value := value - super; end decrement;

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

	procedure idle_skip is null;

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

	procedure toggle_fullscreen is
	begin
		ray.toggle_fullscreen;
	end toggle_fullscreen;

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

	procedure initialize is
	begin
		echo (comment, "Initializing core components...");
		--
		engine_active := true;
		texture_array := new texture_data_array (0 .. 1600);
		sound_array   := new sound_data_array   (0 ..    4);
		font_array    := new font_data_array    (0 ..   16);
		--
		echo (comment, "-- Setting trace log level to none (ignoring all default Raylib logs).");
		ray.set_trace_log_level (ray.log_none);
		--
		ray.set_window_flags (ray.flag_window_resizable);
		--
		echo (comment, "-- Initializing Raylib window data...");
		echo (comment, "-- -- Window title  : Xorana");
		echo (comment, "-- -- Window width  : 1800");
		echo (comment, "-- -- Window height : 900");
		--
		ray.open_window (1800, 900, c_string ("Xorana"));
		ray.hide_cursor;
		--
		ray.set_window_minimal_size (640, 480);
		ray.set_window_maximal_size (3840, 2160);
		--
		echo (comment, "-- Initializing Raylib audio device data...");
		--~ray.open_audio_device;
		--
		game_icon := ray.load_image (c_string (folder & "/ui/game_icon.png"));
		--
		ray.window_icon (game_icon);
		--
		--ray.randomization  (19970725);
		ray.set_target_fps (60);
		--
		echo (success, "Initialized core components.");
	end initialize;

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

	procedure deinitialize is
	begin
		echo (comment, "Deinitializing core components...");
		--
		engine_active := false;
		--
		echo (comment, "-- -- Unloading Raylib" & texture_count'image & " textures.");
		echo (comment, "-- -- Unloading Raylib" & sound_count'image   & " sounds.");
		echo (comment, "-- -- Unloading Raylib" & font_count'image    & " fonts.");
		--
		for index in 0 .. texture_count - 1 loop ray.unload_texture (texture_array (index)); end loop;
		for index in 0 .. sound_count   - 1 loop ray.unload_sound   (sound_array   (index)); end loop;
		for index in 0 .. font_count    - 1 loop ray.unload_font    (font_array    (index)); end loop;
		--
		echo (comment, "-- Deinitializing Raylib audio device data...");
		--~ray.close_audio_device;
		--
		ray.unload_image (game_icon);
		--
		echo (comment, "-- Deinitializing Raylib window data...");
		ray.close_window;
		ray.show_cursor;
		--
		echo (success, "Deinitialized core components.");
	end deinitialize;

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

	procedure synchronize is
		signal : integer := signal_code'pos (signal_none);
	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);
		framerate      := integer (ray.get_fps);
		signal         := ray.get_key_pressed;
		cursor.x       := ray.get_mouse_x;
		cursor.y       := ray.get_mouse_y;
		wheel          := wheel + ray.mouse_wheel_move;
		end_turn       := false;
		--
		ray.end_drawing;
		--
		if ray.exit_key_is_pressed then
			engine_active := false;
		end if;
		--
		if ray.mouse_button_is_pressed  (ray.mouse_button_left)   then cursor_mode := cursor_left;   end if;
		if ray.mouse_button_is_pressed  (ray.mouse_button_right)  then cursor_mode := cursor_right;  end if;
		if ray.mouse_button_is_pressed  (ray.mouse_button_middle) then cursor_mode := cursor_middle; end if;
		if ray.mouse_button_is_released (ray.mouse_button_left)   then cursor_mode := cursor_none;   end if;
		if ray.mouse_button_is_released (ray.mouse_button_right)  then cursor_mode := cursor_none;   end if;
		if ray.mouse_button_is_released (ray.mouse_button_middle) then cursor_mode := cursor_none;   end if;
		--
		case signal is
			when  48 ..  57 => signal_mode := signal_code'val (signal -  48 + signal_code'pos (signal_0));
			when  65 ..  90 => signal_mode := signal_code'val (signal -  65 + signal_code'pos (signal_a));
			when 290 .. 301 => signal_mode := signal_code'val (signal - 290 + signal_code'pos (signal_f1));
			when 320 .. 329 => signal_mode := signal_code'val (signal - 320 + signal_code'pos (signal_kp_0));
			--
			when   0    => signal_mode := signal_none;
			when  32    => signal_mode := signal_space;
			when  96    => signal_mode := signal_grave;
			when 340    => signal_mode := signal_left_shift;
			when 341    => signal_mode := signal_left_control;
			when 333    => signal_mode := signal_kp_subtract;
			when 334    => signal_mode := signal_kp_add;
			when 256    => signal_mode := signal_escape;
			when 257    => signal_mode := signal_enter;
			when 258    => signal_mode := signal_tab;
			when 259    => signal_mode := signal_backspace;
			when 262    => signal_mode := signal_right;
			when 263    => signal_mode := signal_left;
			when 264    => signal_mode := signal_down;
			when 265    => signal_mode := signal_up;
			when others => signal_mode := signal_none;
		end case;
		--
		ray.begin_drawing;
		--
		ray.clear_background ((0, 0, 0, 255));
	end synchronize;

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

end core;