-- 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; -- 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_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;