xhads/source/ui.adb

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

with core;

package body ui is

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

	type element is (
		none,
		main_background,
		--
		corner_upper_left,                  border_upper,                       corner_upper_right,
		border_left,                                                            border_right,
		corner_lower_left,                  border_lower,                       corner_lower_right,
		--
		tiny_corner_upper_left,             tiny_border_upper,                  tiny_corner_upper_right,
		tiny_border_left,                                                       tiny_border_right,
		tiny_corner_lower_left,             tiny_border_lower,                  tiny_corner_lower_right,
		--
		frame_upper_left,                   frame_upper,                        frame_upper_right,
		frame_left,                         frame_middle,                       frame_right,
		frame_lower_left,                   frame_lower,                        frame_lower_right,
		--
		icon_upper_left,                    icon_upper,                         icon_upper_right,
		icon_left,                                                              icon_right,
		icon_lower_left,                    icon_lower,                         icon_lower_right,
		--
		text_upper_left,                    text_upper,                         text_upper_right,
		text_left,                          text_middle,                        text_right,
		text_lower_left,                    text_lower,                         text_lower_right,
		--
		cursor,                             icon,                               overicon,                           icon_selected,
		--
		fill_bar_left,                      fill_bar_horizontal,                fill_bar_right,                     fill_horizontal,
		--
		scroll_bar_lower,                   scroll_bar_middle,                  scroll_bar_upper,
		--
		title_bar_left,                     title_bar_middle,                   title_bar_right
	);

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

	type rectangle is record
		x, y, width, height : integer;
	end record;

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

	structure_limit : constant natural := 12;

	sprite : array (style, element) of core.sprite;
	font   : array (style)          of core.font;

	structure_array : array (0 .. structure_limit) of structure;

	structure_count : natural := 0;

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

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

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

	procedure draw (index  : in element      := none;
	                x      : in integer      := 0;
	                y      : in integer      := 0;
	                width  : in integer      := 0;
	                height : in integer      := 0) is
		save_zoom : natural := core.zoom;
	begin
		core.zoom := 1;
		core.draw (sprite (active, index), x, y, 0, 0, width, height);
		core.zoom := save_zoom;
	end draw;

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

	procedure draw_horizontally (index : in element; x, y, width : in integer; action : core.pointer := core.idle'access) is
		step : constant integer := sprite (active, index).width;
	begin
		for move in 0 .. width / step - 1 loop
			draw (index, x + move * step,y);
		end loop;
		--
		if width mod step > 0 then
			draw (index, x + (width / step) * step, y, width mod step, sprite (active, index).height);
		end if;
		--
		--~if core.cursor_mode = 1 and cursor_inside (x, y, width, sprite (active, index).height) then
			--~action.all;
			--~core.cursor_mode := 0;
		--~end if;
	end draw_horizontally;

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

	procedure draw_vertically (index : in element; x, y, height : in integer; action : core.pointer := core.idle'access) is
		step : constant integer := sprite (active, index).height;
	begin
		for move in 0 .. height / step - 1 loop
			draw (index, x, y + move * step);
		end loop;
		--
		if height mod step > 0 then
			draw (index, x, y + (height / step) * step, sprite (active, index).width, height mod step);
		end if;
		--
		--~if core.cursor_mode = 1 and cursor_inside (x, y, sprite (active, index).width, height) then
			--~action.all;
			--~core.cursor_mode := 0;
		--~end if;
	end draw_vertically;

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

	procedure draw_background (index : in element; x, y, width, height : in integer; action : core.pointer := core.idle'access) is
		base_width  : integer := sprite (active, index).width;
		base_height : integer := sprite (active, index).height;
		crop_width  : integer := width  mod base_width;
		crop_height : integer := height mod base_height;
	begin
		for move_y in 0 .. height / base_height - 1 loop
			for move_x in 0 .. width / base_width - 1 loop
				draw (index, x + move_x * base_width, y + move_y * base_height);
			end loop;
			--
			if width mod base_width > 0 then
				draw (index, x + width - crop_width, y + move_y * base_height, crop_width, base_height);
			end if;
		end loop;
		--
		for move_x in 0 .. width / base_width - 1 loop
			if height mod base_height > 0 then
				draw (index, x + move_x * base_width, y + height - crop_height, base_width, crop_height);
			end if;
		end loop;
		--
		if width mod base_width > 0 and height mod base_height > 0 then
			draw (index, x + width - crop_width, y + height - crop_height, crop_width, crop_height);
		end if;
	end draw_background;

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

	procedure draw_structure (data : in structure) is
		offset  : constant integer := core.icon / 4;
		orients :          natural := 0;
		--
		frame_data  : rectangle := (others => 0);
		button_data : rectangle := (others => 0);
	begin
		for index in 0 .. data.gui_n - 1 loop
			if data.gui_list (index).kind = gui_orient then
				orients := orients + 1;
			end if;
		end loop;
		--
		frame_data.width   := (if data.resize then 320 else data.width) * (orients + 1) - offset * orients;
		frame_data.height  := (if data.resize then data.gui_n * (core.icon + 2 * offset) + 2 * core.icon else data.height) / (orients + 1) + offset * orients;
		frame_data.x       := (if data.center then (core.window_width  - frame_data.width)  / 2 else data.x);
		frame_data.y       := (if data.center then (core.window_height - frame_data.height) / 2 else data.y);
		button_data.width  := frame_data.width / (orients + 1) - 2 * core.icon;
		button_data.height := core.icon + 2 * offset;
		button_data.x      := frame_data.x + core.icon;
		button_data.y      := frame_data.y + core.icon;
		--
		draw_tiny_menu (frame_data.x, frame_data.y, frame_data.width, frame_data.height);
		draw_title_bar (frame_data.x, frame_data.y, frame_data.width, data.title);
		--
		for x in 0 .. data.gui_n - 1 loop
			case data.gui_list (x).kind is
				when gui_button =>
					draw_frame (data.gui_list (x).info, button_data.x, button_data.y, button_data.width, button_data.height);
					draw_icon  (data.gui_list (x).image, data.gui_list (x).info, button_data.x + offset, button_data.y + offset);
					write      (data.gui_list (x).text,  button_data.x + offset + core.icon, button_data.y + offset + 2);
					--
					button_data.y := button_data.y + button_data.height;
				when gui_orient =>
					button_data.x := button_data.x + frame_data.width / (orients + 1) - 2 * core.icon + offset;
					button_data.y := frame_data.y + core.icon;
				when others => null;
			end case;
		end loop;
		--
		if orients > 0 then
			draw_scroll_bar (frame_data.x + frame_data.width - 2 * core.icon, frame_data.y + core.icon, frame_data.height - 2 * core.icon, 4);
		end if;
	end draw_structure;

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

	procedure configure is
		procedure load_ui (index : in style; folder_path : in string) is
		begin
			font (index) := core.import_font ("./sprite/ui/" & folder_path & "/font.png", 24, 0);
			--
			for this in element loop
				sprite (index, this) := core.import_sprite ("./sprite/ui/" & folder_path & "/" & core.lowercase (element'image (this)) & ".png", 1, 1);
			end loop;
		end load_ui;
	begin
		core.echo (core.comment, "Configuring UI components...");
		--
		for index in style loop
			load_ui (index, core.lowercase (style'image (index)));
		end loop;
	end configure;

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

	procedure synchronize is
		use core;
	begin
		for index in 0 .. structure_count - 1 loop
			if signal_mode = structure_array (index).toggle then
				structure_array (index).show := not structure_array (index).show;
			end if;
			--
			if structure_array (index).show then
				draw_structure (structure_array (index));
			end if;
		end loop;
	end synchronize;

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

	procedure write (text : in string; x, y : in integer) is
	begin
		core.write (text, x, y, font (active));
	end write;

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

	procedure draw_icon (data : in core.sprite; description : in string; x, y : in integer; action : core.pointer := core.idle'access) is
		save_zoom : natural := core.zoom;
	begin
		draw (icon, x, y);
		--
		core.zoom := 1;
		core.draw (data, x, y);
		core.zoom := save_zoom;
		--
		if cursor_inside (x, y, core.icon, core.icon) then
			draw (icon_selected, x, y);
			--
			core.write_text_box (description);
			--
			if core.cursor_mode = 1 then
				action.all;
				core.cursor_mode := 0;
			end if;
		end if;
	end draw_icon;

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

	procedure draw_overicon (data : in core.sprite; description : in string; x, y : in integer; action : core.pointer := core.idle'access) is
		save_zoom : natural := core.zoom;
	begin
		core.zoom := 1;
		core.draw (data, x, y);
		core.zoom := save_zoom;
		--
		draw (overicon, x, y);
	end draw_overicon;

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

	procedure draw_text_box (text : in string) is
		width  : constant integer := 144;
		height : constant integer := 72;
		x      : constant integer := (core.window_width  - width)  / 2;
		y      : constant integer := (core.window_height - height) / 2;
		offset : constant integer := sprite (active, text_middle).width;
	begin
		draw_background (text_middle, x + offset, y + offset, width - 2 * offset, height - 2 * offset);
		--
		draw_horizontally (text_upper, x + offset,         y,                   width  - 2 * offset);
		draw_horizontally (text_lower, x + offset,         y + height - offset, width  - 2 * offset);
		draw_vertically   (text_left,  x,                  y + offset,          height - 2 * offset);
		draw_vertically   (text_right, x + width - offset, y + offset,          height - 2 * offset);
		--
		draw (text_upper_left,  x,                  y);
		draw (text_upper_right, x + width - offset, y);
		draw (text_lower_left,  x,                  y + height - offset);
		draw (text_lower_right, x + width - offset, y + height - offset);
		--
		write (text, x, y);
	end draw_text_box;

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

	procedure draw_help_box (x, y, width, height : in integer; action : core.pointer := core.idle'access) is
		offset : constant integer := sprite (active, text_middle).width;
	begin
		draw_background (text_middle, x + offset, y + offset, width - 2 * offset, height - 2 * offset);
		--
		draw_horizontally (text_upper, x + offset,         y,                   width  - 2 * offset);
		draw_horizontally (text_lower, x + offset,         y + height - offset, width  - 2 * offset);
		draw_vertically   (text_left,  x,                  y + offset,          height - 2 * offset);
		draw_vertically   (text_right, x + width - offset, y + offset,          height - 2 * offset);
		--
		draw (text_upper_left,  x,                  y);
		draw (text_upper_right, x + width - offset, y);
		draw (text_lower_left,  x,                  y + height - offset);
		draw (text_lower_right, x + width - offset, y + height - offset);
		--
		core.write (core.read_text_box, x, y, font (active));
	end draw_help_box;

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

	procedure draw_frame (description : in string; x, y, width, height : in integer; action : core.pointer := core.idle'access) is
		offset_x : constant integer := sprite (active, frame_middle).width;
		offset_y : constant integer := sprite (active, frame_middle).height;
	begin
		if height < core.icon or width < core.icon then
			return;
		end if;
		--
		draw_background (frame_middle, x + offset_x, y + offset_y, width - 2 * offset_x, height - 2 * offset_y);
		--
		draw_horizontally (frame_upper, x + offset_x,         y,                     width  - 2 * offset_x);
		draw_horizontally (frame_lower, x + offset_x,         y + height - offset_y, width  - 2 * offset_x);
		draw_vertically   (frame_left,  x,                    y + offset_y,          height - 2 * offset_y);
		draw_vertically   (frame_right, x + width - offset_x, y + offset_y,          height - 2 * offset_y);
		--
		draw (frame_upper_left,  x,                                                    y);
		draw (frame_upper_right, x + width - sprite (active, frame_upper_right).width, y);
		draw (frame_lower_left,  x,                                                    y + height - sprite (active, frame_lower_left).height);
		draw (frame_lower_right, x + width - sprite (active, frame_lower_right).width, y + height - sprite (active, frame_lower_right).height);
	end draw_frame;

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

	procedure draw_title_bar (x, y, width : in integer; title : in string) is
		middle_width : constant integer := width - sprite (active, title_bar_left).width - sprite (active, title_bar_right).width;
	begin
		draw (title_bar_left,  x,                                                        y - sprite (active, title_bar_left).height);
		draw (title_bar_right, x + middle_width + sprite (active, title_bar_left).width, y - sprite (active, title_bar_right).height);
		--
		draw_horizontally (title_bar_middle, x + sprite (active, title_bar_left).width, y - sprite (active, title_bar_middle).height, middle_width);
		--
		core.write (title, x + sprite (active, title_bar_left).width / 2 + 20, y - sprite (active, title_bar_middle).height / 2 - 6, font (active));
	end draw_title_bar;

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

	procedure draw_fill_bar (x, y, width : in integer; fill : in float) is
		middle_width : constant integer := width - sprite (active, fill_bar_left).width - sprite (active, fill_bar_right).width;
		fill_width   : constant integer := integer (float (middle_width) * fill);
	begin
		draw (fill_bar_left,  x,                                                       y - sprite (active, fill_bar_left).height);
		draw (fill_bar_right, x + middle_width + sprite (active, fill_bar_left).width, y - sprite (active, fill_bar_right).height);
		--
		draw_horizontally (fill_bar_horizontal, x + sprite (active, fill_bar_left).width, y - sprite (active, fill_bar_horizontal).height, middle_width);
		draw_horizontally (fill_horizontal,     x + sprite (active, fill_bar_left).width, y - sprite (active, fill_bar_horizontal).height, fill_width);
	end draw_fill_bar;

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

	procedure draw_scroll_bar (x, y, height, offset : in integer) is
		middle_height : constant integer := height - sprite (active, scroll_bar_upper).height - sprite (active, scroll_bar_lower).height;
	begin
		draw (scroll_bar_upper, x, y);
		draw (scroll_bar_lower, x, y + middle_height + sprite (active, scroll_bar_upper).height);
		--
		draw_vertically (scroll_bar_middle, x, y + sprite (active, scroll_bar_upper).height, middle_height);
	end draw_scroll_bar;

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

	procedure draw_menu (x, y, width, height : in integer) is
		offset : constant integer := sprite (active, none).width;
	begin
		declare upper : constant integer := width  - sprite (active, corner_upper_left).width   - sprite (active, corner_upper_right).width;
		        lower : constant integer := width  - sprite (active, corner_lower_left).width   - sprite (active, corner_lower_right).width;
		        left  : constant integer := height - sprite (active, corner_upper_left).height  - sprite (active, corner_lower_left).height;
		        right : constant integer := height - sprite (active, corner_upper_right).height - sprite (active, corner_lower_right).height;
		begin
			draw_horizontally (border_upper, x + sprite (active, corner_upper_left).width,    y,                                                 upper, action => core.move_camera_up'access);
			draw_horizontally (border_lower, x + sprite (active, corner_lower_left).width,    y + height - sprite (active, border_lower).height, lower, action => core.move_camera_down'access);
			draw_vertically   (border_left,  x,                                               y + sprite (active, corner_upper_left).height,     left,  action => core.move_camera_left'access);
			draw_vertically   (border_right, x + width - sprite (active, border_right).width, y + sprite (active, corner_upper_right).height,    right, action => core.move_camera_right'access);
		end;
		--
		draw (corner_upper_left,  x,                                                     y);
		draw (corner_upper_right, x + width - sprite (active, corner_upper_right).width, y);
		draw (corner_lower_left,  x,                                                     y + height - sprite (active, corner_lower_left).height);
		draw (corner_lower_right, x + width - sprite (active, corner_lower_right).width, y + height - sprite (active, corner_lower_right).height);
	end draw_menu;

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

	procedure draw_tiny_menu (x, y, width, height : in integer) is
		offset : constant integer := sprite (active, none).width;
	begin
		draw_background (main_background, x + offset, y + offset, width - 2 * offset, height - 2 * offset);
		--
		declare upper : constant integer := width  - sprite (active, tiny_corner_upper_left).width   - sprite (active, tiny_corner_upper_right).width;
		        lower : constant integer := width  - sprite (active, tiny_corner_lower_left).width   - sprite (active, tiny_corner_lower_right).width;
		        left  : constant integer := height - sprite (active, tiny_corner_upper_left).height  - sprite (active, tiny_corner_lower_left).height;
		        right : constant integer := height - sprite (active, tiny_corner_upper_right).height - sprite (active, tiny_corner_lower_right).height;
		begin
			draw_horizontally (tiny_border_upper, x + sprite (active, tiny_corner_upper_left).width,    y,                                                      upper);
			draw_horizontally (tiny_border_lower, x + sprite (active, tiny_corner_lower_left).width,    y + height - sprite (active, tiny_border_lower).height, lower);
			draw_vertically   (tiny_border_left,  x,                                                    y + sprite (active, tiny_corner_upper_left).height,     left);
			draw_vertically   (tiny_border_right, x + width - sprite (active, tiny_border_right).width, y + sprite (active, tiny_corner_upper_right).height,    right);
		end;
		--
		draw (tiny_corner_upper_left,  x,                                                          y);
		draw (tiny_corner_upper_right, x + width - sprite (active, tiny_corner_upper_right).width, y);
		draw (tiny_corner_lower_left,  x,                                                          y + height - sprite (active, tiny_corner_lower_left).height);
		draw (tiny_corner_lower_right, x + width - sprite (active, tiny_corner_lower_right).width, y + height - sprite (active, tiny_corner_lower_right).height);
	end draw_tiny_menu;

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

	procedure draw_icon_menu (description : in string; x, y, width, height : in integer; action : core.pointer := core.idle'access) is
		offset_x : constant integer := sprite (active, icon_upper_left).width;
		offset_y : constant integer := sprite (active, icon_upper_left).height;
	begin
		if height < 2 * sprite (active, icon_upper_left).height
		or width  < 2 * sprite (active, icon_upper_left).width then
			return;
		end if;
		--
		draw_horizontally (icon_upper, x + offset_x,         y,                     width  - 2 * offset_x);
		draw_horizontally (icon_lower, x + offset_x,         y + height - offset_y, width  - 2 * offset_x);
		draw_vertically   (icon_left,  x,                    y + offset_y,          height - 2 * offset_y);
		draw_vertically   (icon_right, x + width - offset_x, y + offset_y,          height - 2 * offset_y);
		--
		draw (icon_upper_left,  x,                                                   y);
		draw (icon_upper_right, x + width - sprite (active, icon_upper_right).width, y);
		draw (icon_lower_left,  x,                                                   y + height - sprite (active, icon_lower_left).height);
		draw (icon_lower_right, x + width - sprite (active, icon_lower_right).width, y + height - sprite (active, icon_lower_right).height);
	end draw_icon_menu;

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

	procedure draw_state_box (x, y : in integer) is
	begin
		ui.write ("Cursor X:"       & core.cursor.x'image,       x, y +   0);
		ui.write ("Cursor Y:"       & core.cursor.y'image,       x, y +  32);
		ui.write ("Cursor Mode:"    & core.cursor_mode'image,    x, y +  64);
		ui.write ("Camera X:"       & core.camera.x'image,       x, y +  96);
		ui.write ("Camera Y:"       & core.camera.y'image,       x, y + 128);
		ui.write ("Global Time:"    & core.global_time'image,    x, y + 160);
		ui.write ("Gameplay Time:"  & core.gameplay_time'image,  x, y + 192);
		ui.write ("Animation Time:" & core.animation_time'image, x, y + 224);
		ui.write ("Framerate:"      & core.framerate'image,      x, y + 256);
	end draw_state_box;

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

	procedure add_structure (data : in structure) is
	begin
		structure_array (structure_count)          := data;
		structure_array (structure_count).gui_list := new gui_array (0 .. structure_array (structure_count).gui_n - 1);
		structure_array (structure_count).gui_n    := 0;
		--
		core.increment (structure_count);
	end add_structure;

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

	procedure add_structure_button (icon : in core.sprite; text : in core.short_string; description : in core.long_string := "") is
	begin
		structure_array (structure_count - 1).gui_list (structure_array (structure_count - 1).gui_n).kind   := gui_button;
		structure_array (structure_count - 1).gui_list (structure_array (structure_count - 1).gui_n).text   := text;
		structure_array (structure_count - 1).gui_list (structure_array (structure_count - 1).gui_n).info   := description;
		structure_array (structure_count - 1).gui_list (structure_array (structure_count - 1).gui_n).number := 0;
		structure_array (structure_count - 1).gui_list (structure_array (structure_count - 1).gui_n).image  := icon;
		--
		core.increment (structure_array (structure_count - 1).gui_n);
	end add_structure_button;

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

	procedure add_structure_orient is
	begin
		structure_array (structure_count - 1).gui_list (structure_array (structure_count - 1).gui_n).kind := gui_orient;
		--
		core.increment (structure_array (structure_count - 1).gui_n);
	end add_structure_orient;

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

end ui;