-- Copyright (c) 2024 - Ognjen 'xolatile' Milan Robovic -- -- GNU General Public Licence (version 3 or later) with core, ui; 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, -- 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 ); ------------------------------------------------------------------------------------------ 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; ------------------------------------------------------------------------------------------ procedure select_text_box (text : in string; x, y, width, height : in integer) is begin if core.cursor.x > x and core.cursor.x < x + width and core.cursor.y > y and core.cursor.y < y + height then core.write_text_box (text); end if; end select_text_box; ------------------------------------------------------------------------------------------ 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.x > x and core.cursor.x < x + width and core.cursor.y > y and core.cursor.y < y + sprite (active, index).height and core.cursor_mode = 1 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.x > x and core.cursor.x < x + sprite (active, index).width and core.cursor.y > y and core.cursor.y < y + height and core.cursor_mode = 1 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 out structure) is new_width : constant integer := (if data.resize then 640 else data.width); new_height : constant integer := (if data.resize then 480 else data.height); new_x : constant integer := (if data.center then (core.window_width - new_width) / 2 else data.x); new_y : constant integer := (if data.center then (core.window_height - new_height) / 2 else data.y); begin draw_tiny_menu (new_x, new_y, new_width, new_height); draw_title_bar (new_x, new_y, new_width, data.title); 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 begin for index in 0 .. structure_limit loop exit when index = structure_count; -- if core.signal_mode = core.signal_code'pos (structure_array (index).toggle) then structure_array (index).show := (if structure_array (index).show then false else true); 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 select_text_box (description, x, y, core.icon, core.icon); -- draw (icon, x, y); -- core.zoom := 1; core.draw (data, x, y); core.zoom := save_zoom; -- if core.cursor.x > x and core.cursor.x < x + core.icon and core.cursor.y > y and core.cursor.y < y + core.icon and core.cursor_mode = 1 then action.all; core.cursor_mode := 0; 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 select_text_box (description, x, y, core.icon, core.icon); -- 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)); -- select_text_box ("", x, y, width, height); 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); -- select_text_box (description, x, y, width, 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 + 16, y - sprite (active, title_bar_middle).height / 2 - 8, font (active)); -- select_text_box (title, x, y - sprite (active, title_bar_middle).height, width, sprite (active, title_bar_middle).height); 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); -- select_text_box ("", x, y, width, sprite (active, fill_bar_horizontal).height); end draw_fill_bar; ------------------------------------------------------------------------------------------ procedure draw_scroll_bar (x, y, height : in integer; 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); -- select_text_box ("", x, y, width, 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); -- select_text_box ("", x, y, width, 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); -- select_text_box (description, x, y, width, height); end draw_icon_menu; ------------------------------------------------------------------------------------------ procedure draw_state_box (x, y : in integer) is -- TODO: Delete this at some point. 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 -- TODO: This is dumb, tho less error-prone... begin structure_array (structure_count) := data; -- structure_count := structure_count + 1; end add_structure; ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------ end ui;