xhads/source/ui.adb

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

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,
		tiny_fill_bar_left,                 tiny_fill_bar_horizontal,           tiny_fill_bar_right,                tiny_fill_horizontal,
		--
		scroll_bar_lower,                   scroll_bar_middle,                  scroll_bar_upper,
		--
		title_bar_left,                     title_bar_middle,                   title_bar_right,
		separator_left,                     separator_middle,                   separator_right,
		--
		check_box_on,                       check_box_off,
		--
		end_turn_button
	);

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

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

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

	font_tint : array (style) of core.colour := (
		main   => (127, 127, 127, 255),
		fairy  => (  0, 127, 255, 255),
		dwarf  => (127, 255, 255, 255),
		gnoll  => (255, 255,   0, 255),
		kobold => (255, 127, 255, 255),
		goblin => (  0, 255, 127, 255),
		imp    => (255, 127,   0, 255)
	);

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

	monospace  : core.font;

	console_message_limit : constant natural := 6;
	console_message_count :          natural := 0;
	--
	console_message_array : array (0 .. console_message_limit - 1) of core.unstring;

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

	procedure draw (index  : in element      := none;
	                x      : in integer      := 0;
	                y      : in integer      := 0;
	                width  : in integer      := 0;
	                height : in integer      := 0);

	procedure draw_horizontally (index : in element; x, y, width  : in integer; action : core.pointer := core.idle_skip'access; tint : in core.colour := (others => 255));
	procedure draw_vertically   (index : in element; x, y, height : in integer; action : core.pointer := core.idle_skip'access; tint : in core.colour := (others => 255));

	procedure draw_background (index : in element; x, y, width, height : in integer; action : core.pointer := core.idle_skip'access);

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

	procedure configure is
		procedure load_ui (index : in style; folder_path : in string) is
		begin
			font (index) := core.import_font (core.folder & "/ui/" & folder_path & "/font.png", 24, 0);
			--
			for this in element loop
				sprite (index, this) := core.import_sprite (core.folder & "/ui/" & folder_path & "/" & core.lowercase (element'image (this)) & ".png", 1, 1);
			end loop;
		end load_ui;
	begin
		monospace := core.import_font (core.folder & "/ui/monospace.png", monoheight, 0);
		--
		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
	begin
		prioritize := false;
		--
		draw (cursor, core.cursor.x, core.cursor.y);
	end synchronize;

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

	procedure echo (message : in string) is
	begin
		console_message_array (console_message_count) := core.unbound (message);
		--
		console_message_count := (console_message_count + 1) mod console_message_limit;
	end echo;

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

	procedure write (text : in string; x, y : in integer; tint : in core.colour := (others => 255); size : in natural := font (active).scale; code : in boolean := false) is
	begin
		core.write (text, x, y, tint, (if code then monoheight else size), (if code then monospace else font (active)));
	end write;

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

	procedure draw_separator (x, y, width : in integer) is
		limit : constant integer := width - sprite (active, separator_left).width - sprite (active, separator_right).width;
	begin
		draw (separator_left,  x, y);
		draw (separator_right, x + limit + sprite (active, separator_left).width, y);
		--
		draw_horizontally (separator_middle, x + sprite (active, separator_left).width, y, limit);
	end draw_separator;

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

	procedure draw_icon (data : in core.sprite; text : in string; x, y : in integer; action : core.pointer := core.idle_skip'access) is
	begin
		draw (icon, x, y);
		--
		core.draw (data, x, y, factor => 1);
		--
		if core.cursor_inside (x, y, core.icon, core.icon) then
			prioritize := true;
			--
			draw (icon_selected, x, y);
			--
			core.write_help_box (text);
			--
			if core.cursor_mode = core.cursor_left then
				action.all;
				core.cursor_mode := core.cursor_none;
			end if;
		end if;
	end draw_icon;

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

	procedure draw_icon_and_text (data : in core.sprite; text : in string; x, y, width : in integer; action : core.pointer := core.idle_skip'access) is
	begin
		draw_icon_menu (x, y, width, core.icon);
		--
		core.draw (data, x, y, factor => 1);
		write     (text, x + core.icon + 10, y + 10, code => true);
		--
		if core.cursor_inside (x, y, core.icon, core.icon) then
			prioritize := true;
			--
			if core.cursor_mode = core.cursor_left then
				action.all;
				core.cursor_mode := core.cursor_none;
			end if;
		end if;
	end draw_icon_and_text;

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

	procedure draw_overicon (data : in core.sprite; text : in string; x, y : in integer; action : core.pointer := core.idle_skip'access) is
	begin
		core.draw (data, x, y, factor => 1);
		--
		draw (overicon, x, y);
		--
		if core.cursor_inside (x, y, core.icon, core.icon) then
			prioritize := true;
			--
			core.write_help_box (text);
			--
			if core.cursor_mode = core.cursor_left then
				action.all;
				core.cursor_mode := core.cursor_none;
			end if;
		end if;
	end draw_overicon;

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

	procedure draw_text_in_overicon (text : in string; x, y : in integer; action : core.pointer := core.idle_skip'access) is
	begin
		draw (overicon, x, y);
		--
		write (text, x - 2, y + (core.icon - monoheight) / 2, code => true);
		--
		if core.cursor_inside (x, y, core.icon, core.icon) then
			prioritize := true;
			--
			core.write_help_box (text);
			--
			if core.cursor_mode = core.cursor_left then
				action.all;
				core.cursor_mode := core.cursor_none;
			end if;
		end if;
	end draw_text_in_overicon;

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

	procedure draw_sprite (data : in core.sprite; text : in string; x, y, offset : in integer; action : core.pointer := core.idle_skip'access) is
	begin
		core.draw (data, x + offset, y + offset, factor => 1);
		--
		draw_icon_menu (x, y, data.width + 2 * offset, data.height + 2 * offset);
		--
		if core.cursor_inside (x, y, data.width + 2 * offset, data.height + 2 * offset) then
			prioritize := true;
			--
			core.write_help_box (text);
			--
			if core.cursor_mode = core.cursor_right then
				action.all;
			end if;
		end if;
	end draw_sprite;

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

	procedure draw_text_box (x, y, width, height : in integer) is
		middle : constant integer := sprite (active, text_middle).width;
	begin
		draw_background (text_middle, x + middle, y + middle, width - 2 * middle, height - 2 * middle);
		--
		draw_horizontally (text_upper, x + middle,         y,                   width  - 2 * middle);
		draw_horizontally (text_lower, x + middle,         y + height - middle, width  - 2 * middle);
		draw_vertically   (text_left,  x,                  y + middle,          height - 2 * middle);
		draw_vertically   (text_right, x + width - middle, y + middle,          height - 2 * middle);
		--
		draw (text_upper_left,  x,                  y);
		draw (text_upper_right, x + width - middle, y);
		draw (text_lower_left,  x,                  y + height - middle);
		draw (text_lower_right, x + width - middle, y + height - middle);
	end draw_text_box;

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

	procedure draw_help_box (x, y, width, height : in integer; action : core.pointer := core.idle_skip'access) is
		offset : constant integer := sprite (active, text_middle).width;
	begin
		if core.cursor_inside (x, y, width, height) then
			prioritize := true;
		end if;
		--
		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);
		--
		ui.write (core.read_help_box, (core.icon - font (active).scale) / 2 + x + 4, (core.icon - font (active).scale) / 2 + y);
		--
		core.write_help_box ("--");
	end draw_help_box;

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

	procedure draw_frame (x, y, width, height : in integer) 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);
		--
		if core.cursor_inside (x, y, width, height) then
			prioritize := true;
		end if;
	end draw_frame;

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

	procedure draw_button (text, description : in string; icon : in core.sprite; x, y, width, height : in integer; action : core.pointer := core.idle_skip'access) is
		offset  : constant integer := core.icon / 4;
	begin
		draw_frame (x, y, width, height);
		draw_icon  (icon, description, x + offset, y + offset);
		--
		ui.write (text,
		          x + offset + (core.icon - font (active).scale) / 2 + core.icon,
		          y + offset + (core.icon - font (active).scale) / 2,
		          (if core.cursor_inside (x, y, width, height) then font_tint (active) else (others => 255)));
		--
		if core.cursor_inside (x, y, width, height) then
			prioritize := true;
			--
			if core.cursor_mode = core.cursor_left then
				action.all;
				core.cursor_mode := core.cursor_none;
			end if;
		end if;
	end draw_button;

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

	procedure draw_text (text : in string; x, y, width, height : in integer := 0; offset, border : in natural := 0; tint : in core.colour := (others => 255)) is
		new_width  : constant natural := (if width  < core.base then monowidth  * core.string_width  (text) else width);
		new_height : constant natural := (if height < core.base then monoheight * core.string_height (text) else height);
	begin
		draw_text_box (x, y, new_width + 2 * border, new_height + 2 * border);
		write         (text, x + border + offset, y + border + offset, tint, code => true);
	end draw_text;

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

	procedure draw_check_box (x, y : in integer; on : in out boolean; text : in string) is
	begin
		draw ((if on then check_box_on else check_box_off), x, y);
		--
		ui.write (text, x + sprite (active, check_box_on).width, y);
		--
		if  core.cursor_mode = core.cursor_left
		and core.cursor_inside (x, y, sprite (active, check_box_on).width, sprite (active, check_box_on).height) then
			on               := not on;
			core.cursor_mode := core.cursor_none;
		end if;
	end draw_check_box;

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

	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;
		offset       : constant integer := (sprite (active, title_bar_middle).height - font (active).scale) / 2;
	begin
		if core.cursor_inside (x, y, width, sprite (active, title_bar_left).height) then
			prioritize := true;
		end if;
		--
		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);
		--
		ui.write (title, x + sprite (active, title_bar_left).width, y - font (active).scale - 4, tint => font_tint (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_tiny_fill_bar (x, y, width : in integer; fill : in float; tint : in core.colour) is
		middle_width : constant integer := width - sprite (active, tiny_fill_bar_left).width - sprite (active, tiny_fill_bar_right).width;
		fill_width   : constant integer := integer (float (middle_width) * fill);
	begin
		draw (tiny_fill_bar_left,  x,                                                            y - sprite (active, tiny_fill_bar_left).height);
		draw (tiny_fill_bar_right, x + middle_width + sprite (active, tiny_fill_bar_left).width, y - sprite (active, tiny_fill_bar_left).height);
		--
		draw_horizontally (tiny_fill_bar_horizontal, x + sprite (active, tiny_fill_bar_left).width, y - sprite (active, tiny_fill_bar_horizontal).height, middle_width);
		--
		draw_horizontally (index => tiny_fill_horizontal,
		                   x     => x + sprite (active, tiny_fill_bar_left).width,
		                   y     => y - sprite (active, tiny_fill_bar_horizontal).height,
		                   width => fill_width,
		                   tint  => tint);
	end draw_tiny_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
		if core.cursor_inside (x, y, width, height) then
			prioritize := true;
		end if;
		--
		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);
			draw_horizontally (border_lower, x + sprite (active, corner_lower_left).width,    y + height - sprite (active, border_lower).height, lower);
			draw_vertically   (border_left,  x,                                               y + sprite (active, corner_upper_left).height,     left);
			draw_vertically   (border_right, x + width - sprite (active, border_right).width, y + sprite (active, corner_upper_right).height,    right);
		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
		if core.cursor_inside (x, y, width, height) then
			prioritize := true;
		end if;
		--
		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 (x, y, width, height : in integer; text : in string := "--"; action : in core.pointer := core.idle_skip'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);
		--
		if core.cursor_inside (x, y, width, height) then
			prioritize := true;
			--
			core.write_help_box (text);
			--
			if core.cursor_mode = core.cursor_right then
				action.all;
			end if;
		end if;
	end draw_icon_menu;

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

	procedure draw_end_turn_button (x, y : in integer) is
	begin
		draw (end_turn_button, x, y);
		--
		if core.cursor_inside (x, y, sprite (active, end_turn_button).width, sprite (active, end_turn_button).height) then
			if core.cursor_mode = core.cursor_left then
				core.end_turn    := true;
				core.cursor_mode := core.cursor_none;
				--
				echo ("-- Turn --");
			end if;
			--
			core.write_help_box ("End your turn, it's time for other players to try to do something...");
		end if;
	end draw_end_turn_button;

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

	procedure draw_console_box (x, y, width, height : in integer) is
		offset                : constant integer := 8;
		font_width            : constant integer := monowidth;
		font_height           : constant integer := monoheight;
		characters_per_width  : constant integer := width  / font_width;
		characters_per_height : constant integer := height / font_height;
	begin
		draw_text_box (x, y, width, height);
		--
		for index in 0 .. console_message_limit - 1 loop
			write (text => core.bound (console_message_array ((index + console_message_count) mod console_message_limit)),
			       x    => x + offset,
			       y    => y + offset + index * font_height,
			       code => true);
		end loop;
	end draw_console_box;

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

	procedure iterate_style is
	begin
		active := style'val ((style'pos (active) + 1) mod style_count);
	end iterate_style;

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

	--~procedure write_ada_code (text : in core.string_box_data; x, y : in integer) is
		--~word : core.unstring := core.unbound ("");
		--~--
		--~buffer :          character   := ' ';
		--~width  : constant integer     := 9;
		--~height : constant integer     := 15;
		--~length :          natural     := 1;
		--~offset :          core.vector := (x, y);
		--~subset :          natural     := 0;
	--~begin
		--~loop
			--~buffer   := (core.bound (text.text)) (length .. length);
			--~offset.x := offset.x + width;
			--~--
			--~exit when buffer = core.terminator;
			--~--
			--~case buffer is
				--~when core.tabulator => offset.x := offset.x + 2 * width;
				--~when core.line_feed => offset.y := offset.y + 1 * height; offset.x := x;
				--~when ':' | ';' | '.' | ',' | '=' | '<' | '>' =>
					--~ui.write (buffer & "", offset.x, offset.y, (63, 127, 255, 255), height, code => true);
				--~when '+' | '*' | '/' | '|' | '&' =>
					--~ui.write (buffer & "", offset.x, offset.y, (63, 63, 255, 255), height, code => true);
				--~when '(' | ')' | ''' =>
					--~ui.write (buffer & "", offset.x, offset.y, (63, 255, 255, 255), height, code => true);
				--~when '"' =>
					--~ui.write (buffer & "", offset.x, offset.y, (127, 63, 127, 255), height, code => true);
					--~offset.x := offset.x + width;
					--~loop
						--~core.increment (length);
						--~buffer := ada.strings.unbounded.element (text.text, length);
						--~ui.write (buffer & "", offset.x, offset.y, (127, 63, 127, 255), height, code => true);
						--~offset.x := offset.x + width;
						--~exit when buffer = '"';
					--~end loop;
						--~offset.x := offset.x - width;
				--~when '-' =>
					--~if ada.strings.unbounded.element (text.text, length + 1) = '-' then
						--~ui.write (buffer & "", offset.x, offset.y, (127, 127, 127, 255), height, code => true);
						--~offset.x := offset.x + width;
						--~loop
							--~core.increment (length);
							--~buffer := ada.strings.unbounded.element (text.text, length);
							--~ui.write (buffer & "", offset.x, offset.y, (127, 127, 127, 255), height, code => true);
							--~offset.x := offset.x + width;
							--~exit when buffer = core.line_feed;
						--~end loop;
						--~core.decrement (length);
					--~else
						--~ui.write (buffer & "", offset.x, offset.y, (63, 63, 255, 255), height, code => true);
					--~end if;
				--~when '0' .. '9' =>
					--~loop
						--~ui.write (buffer & "", offset.x, offset.y, (127, 63, 255, 255), height, code => true);
						--~core.increment (length);
						--~buffer := ada.strings.unbounded.element (text.text, length);
						--~exit when buffer = ' ' or buffer = ';' or buffer = ')' or buffer = ',';
						--~offset.x := offset.x + width;
					--~end loop;
					--~core.decrement (length);
				--~when 'a' .. 'z' | 'A' .. 'Z' =>
					--~word := ada.strings.unbounded.to_unbounded_string (buffer & "");
					--~subset := 1;
					--~loop
						--~buffer := ada.strings.unbounded.element (text.text, length + subset);
						--~exit when buffer = ' ' or buffer = '.' or buffer = '(' or buffer = ')' or buffer = ',' or buffer = ';' or buffer = '''
							--~or buffer = core.tabulator or buffer = core.line_feed;
						--~word := word & ada.strings.unbounded.to_unbounded_string (buffer & "");
						--~core.increment (subset);
					--~end loop;
					--~if word = "type" or word = "begin" or word = "end" or word = "when" or word = "others" or word = "procedure" or word = "function"
					--~or word = "package" or word = "body" or word = "if" or word = "then" or word = "else" or word = "elsif" or word = "case" or word = "is"
					--~or word = "and" or word = "or" or word = "xor" or word = "exit" or word = "constant" or word = "access" or word = "range"
					--~or word = "subtype" or word = "array" or word = "in" or word = "out" or word = "return" or word = "for" or word = "with"
					--~or word = "loop" or word = "while" or word = "of" or word = "null" or word = "record" or word = "use" or word = "mod" or word = "new"
					--~or word = "aliased" or word = "all" then
						--~ui.write (ada.strings.unbounded.to_string (word), offset.x, offset.y, (255, 255, 0, 255), height, code => true);
					--~else
						--~ui.write (ada.strings.unbounded.to_string (word), offset.x, offset.y, (others => 255), height, code => true);
					--~end if;
					--~offset.x := offset.x + (subset - 1) * width;
					--~length := length + subset - 1;
				--~when others =>
					--~ui.write (buffer & "", offset.x, offset.y, (others => 255), height, code => true);
			--~end case;
			--~--
			--~core.increment (length);
		--~end loop;
	--~end write_ada_code;

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

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

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

	procedure draw_horizontally (index : in element; x, y, width : in integer; action : core.pointer := core.idle_skip'access; tint : in core.colour := (others => 255)) is
	begin
		core.draw_horizontally (sprite (active, index), x, y, width, 1, tint);
	end draw_horizontally;

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

	procedure draw_vertically (index : in element; x, y, height : in integer; action : core.pointer := core.idle_skip'access; tint : in core.colour := (others => 255)) is
	begin
		core.draw_vertically (sprite (active, index), x, y, height, 1, tint);
	end draw_vertically;

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

	procedure draw_background (index : in element; x, y, width, height : in integer; action : core.pointer := core.idle_skip'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;

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

end ui;