Prototype game engine for Heroes of Might & Magic, featuring a gameplay plot-twist...
25개 이상의 토픽을 선택하실 수 없습니다. Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

723 lines
36KB

  1. -- Copyright (c) 2024 - Ognjen 'xolatile' Milan Robovic
  2. --
  3. -- GNU General Public Licence (version 3 or later)
  4. with core;
  5. with ada.strings.unbounded;
  6. use ada.strings.unbounded;
  7. use type core.cursor_code;
  8. package body ui is
  9. ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
  10. type element is (
  11. none,
  12. main_background,
  13. --
  14. corner_upper_left, border_upper, corner_upper_right,
  15. border_left, border_right,
  16. corner_lower_left, border_lower, corner_lower_right,
  17. --
  18. tiny_corner_upper_left, tiny_border_upper, tiny_corner_upper_right,
  19. tiny_border_left, tiny_border_right,
  20. tiny_corner_lower_left, tiny_border_lower, tiny_corner_lower_right,
  21. --
  22. frame_upper_left, frame_upper, frame_upper_right,
  23. frame_left, frame_middle, frame_right,
  24. frame_lower_left, frame_lower, frame_lower_right,
  25. --
  26. icon_upper_left, icon_upper, icon_upper_right,
  27. icon_left, icon_right,
  28. icon_lower_left, icon_lower, icon_lower_right,
  29. --
  30. text_upper_left, text_upper, text_upper_right,
  31. text_left, text_middle, text_right,
  32. text_lower_left, text_lower, text_lower_right,
  33. --
  34. cursor, icon, overicon, icon_selected,
  35. --
  36. fill_bar_left, fill_bar_horizontal, fill_bar_right, fill_horizontal,
  37. tiny_fill_bar_left, tiny_fill_bar_horizontal, tiny_fill_bar_right, tiny_fill_horizontal,
  38. --
  39. scroll_bar_lower, scroll_bar_middle, scroll_bar_upper,
  40. --
  41. title_bar_left, title_bar_middle, title_bar_right,
  42. --
  43. check_box_on, check_box_off
  44. );
  45. ------------------------------------------------------------------------------------------
  46. type rectangle is record
  47. x, y, width, height : integer;
  48. end record;
  49. ------------------------------------------------------------------------------------------
  50. structure_limit : constant natural := 12;
  51. font_tint : array (style) of core.colour := (
  52. main => (127, 127, 127, 255),
  53. fairy => ( 0, 127, 255, 255),
  54. dwarf => (127, 255, 255, 255),
  55. gnoll => (255, 255, 0, 255),
  56. kobold => (255, 127, 255, 255),
  57. goblin => ( 0, 255, 127, 255),
  58. imp => (255, 127, 0, 255)
  59. );
  60. sprite : array (style, element) of core.sprite;
  61. font : array (style) of core.font;
  62. structure_array : array (0 .. structure_limit) of structure;
  63. structure_count : natural := 0;
  64. monospace : core.font;
  65. ------------------------------------------------------------------------------------------
  66. procedure draw (index : in element := none;
  67. x : in integer := 0;
  68. y : in integer := 0;
  69. width : in integer := 0;
  70. height : in integer := 0) is
  71. begin
  72. core.draw (sprite (active, index), x, y, 0, 0, width, height, factor => 1);
  73. end draw;
  74. ------------------------------------------------------------------------------------------
  75. 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
  76. begin
  77. core.draw_horizontally (sprite (active, index), x, y, width, 1, tint);
  78. --
  79. --~if core.cursor_mode = 1 and cursor_inside (x, y, width / core.zoom, sprite (active, index).height / core.zoom) then
  80. --~action.all;
  81. --~core.cursor_mode := 0;
  82. --~end if;
  83. end draw_horizontally;
  84. ------------------------------------------------------------------------------------------
  85. 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
  86. begin
  87. core.draw_vertically (sprite (active, index), x, y, height, 1, tint);
  88. --
  89. --~if core.cursor_mode = 1 and cursor_inside (x, y, sprite (active, index).width / core.zoom, height / core.zoom) then
  90. --~action.all;
  91. --~core.cursor_mode := 0;
  92. --~end if;
  93. end draw_vertically;
  94. ------------------------------------------------------------------------------------------
  95. procedure draw_background (index : in element; x, y, width, height : in integer; action : core.pointer := core.idle_skip'access) is
  96. base_width : integer := sprite (active, index).width;
  97. base_height : integer := sprite (active, index).height;
  98. crop_width : integer := width mod base_width;
  99. crop_height : integer := height mod base_height;
  100. begin
  101. for move_y in 0 .. height / base_height - 1 loop
  102. for move_x in 0 .. width / base_width - 1 loop
  103. draw (index, x + move_x * base_width, y + move_y * base_height);
  104. end loop;
  105. --
  106. if width mod base_width > 0 then
  107. draw (index, x + width - crop_width, y + move_y * base_height, crop_width, base_height);
  108. end if;
  109. end loop;
  110. --
  111. for move_x in 0 .. width / base_width - 1 loop
  112. if height mod base_height > 0 then
  113. draw (index, x + move_x * base_width, y + height - crop_height, base_width, crop_height);
  114. end if;
  115. end loop;
  116. --
  117. if width mod base_width > 0 and height mod base_height > 0 then
  118. draw (index, x + width - crop_width, y + height - crop_height, crop_width, crop_height);
  119. end if;
  120. end draw_background;
  121. ------------------------------------------------------------------------------------------
  122. procedure draw_popup_box is
  123. width : constant integer := 320;
  124. height : constant integer := core.icon;
  125. middle : constant integer := sprite (active, text_middle).width;
  126. offset : constant integer := 16;
  127. begin
  128. draw_background (text_middle, core.cursor.x + middle + offset, core.cursor.y + middle + offset, width - 2 * middle, height - 2 * middle);
  129. --
  130. draw_horizontally (text_upper, core.cursor.x + middle + offset, core.cursor.y + offset, width - 2 * middle);
  131. draw_horizontally (text_lower, core.cursor.x + middle + offset, core.cursor.y + height - middle + offset, width - 2 * middle);
  132. draw_vertically (text_left, core.cursor.x + offset, core.cursor.y + middle + offset, height - 2 * middle);
  133. draw_vertically (text_right, core.cursor.x + width - middle + offset, core.cursor.y + middle + offset, height - 2 * middle);
  134. --
  135. draw (text_upper_left, core.cursor.x + offset, core.cursor.y + offset);
  136. draw (text_upper_right, core.cursor.x + width - middle + offset, core.cursor.y + offset);
  137. draw (text_lower_left, core.cursor.x + offset, core.cursor.y + height - middle + offset);
  138. draw (text_lower_right, core.cursor.x + width - middle + offset, core.cursor.y + height - middle + offset);
  139. --
  140. write (core.read_text_box, core.cursor.x + 4 + offset, core.cursor.y + 6 + offset);
  141. end draw_popup_box;
  142. ------------------------------------------------------------------------------------------
  143. procedure draw_structure (data : in structure) is
  144. offset : constant integer := core.icon / 4;
  145. orients : natural := 0;
  146. --
  147. frame_data : rectangle := (others => 0);
  148. button_data : rectangle := (others => 0);
  149. begin
  150. for index in 0 .. data.gui_n - 1 loop
  151. if data.gui_list (index).kind = gui_orient then
  152. orients := orients + 1;
  153. end if;
  154. end loop;
  155. --
  156. frame_data.width := (if data.resize then 320 else data.width) * (orients + 1) - offset * orients;
  157. frame_data.height := (if data.resize then data.gui_n * (core.icon + 2 * offset) + 2 * core.icon else data.height) / (orients + 1) + offset * orients;
  158. frame_data.x := (if data.center then (core.window_width - frame_data.width) / 2 else data.x);
  159. frame_data.y := (if data.center then (core.window_height - frame_data.height) / 2 else data.y);
  160. button_data.width := frame_data.width / (orients + 1) - 2 * core.icon;
  161. button_data.height := core.icon + 2 * offset;
  162. button_data.x := frame_data.x + core.icon;
  163. button_data.y := frame_data.y + core.icon;
  164. --
  165. draw_tiny_menu (frame_data.x, frame_data.y, frame_data.width, frame_data.height);
  166. draw_title_bar (frame_data.x, frame_data.y, frame_data.width, data.title);
  167. --
  168. for x in 0 .. data.gui_n - 1 loop
  169. case data.gui_list (x).kind is
  170. when gui_button =>
  171. draw_button (text => data.gui_list (x).text,
  172. description => data.gui_list (x).info,
  173. icon => data.gui_list (x).image,
  174. x => button_data.x,
  175. y => button_data.y,
  176. width => button_data.width,
  177. height => button_data.height);
  178. --
  179. button_data.y := button_data.y + button_data.height;
  180. when gui_orient =>
  181. button_data.x := button_data.x + frame_data.width / (orients + 1) - 2 * core.icon + offset;
  182. button_data.y := frame_data.y + core.icon;
  183. when others => null;
  184. end case;
  185. end loop;
  186. --
  187. if orients > 0 then
  188. draw_scroll_bar (frame_data.x + frame_data.width - 2 * core.icon, frame_data.y + core.icon, frame_data.height - 2 * core.icon, 4);
  189. end if;
  190. end draw_structure;
  191. ------------------------------------------------------------------------------------------
  192. procedure configure is
  193. procedure load_ui (index : in style; folder_path : in string) is
  194. begin
  195. font (index) := core.import_font (core.folder & "/ui/" & folder_path & "/font.png", 24, 0);
  196. --
  197. for this in element loop
  198. sprite (index, this) := core.import_sprite (core.folder & "/ui/" & folder_path & "/" & core.lowercase (element'image (this)) & ".png", 1, 1);
  199. end loop;
  200. end load_ui;
  201. begin
  202. monospace := core.import_font (core.folder & "/ui/monospace.png", 15, 0);
  203. --
  204. core.echo (core.comment, "Configuring UI components...");
  205. --
  206. for index in style loop
  207. load_ui (index, core.lowercase (style'image (index)));
  208. end loop;
  209. end configure;
  210. ------------------------------------------------------------------------------------------
  211. procedure synchronize is
  212. use core;
  213. begin
  214. prioritize := false;
  215. --
  216. for index in 0 .. structure_count - 1 loop
  217. if signal_mode = structure_array (index).toggle then
  218. structure_array (index).show := not structure_array (index).show;
  219. end if;
  220. --
  221. if structure_array (index).show then
  222. draw_structure (structure_array (index));
  223. --
  224. prioritize := true;
  225. end if;
  226. end loop;
  227. --
  228. if read_text_box /= "--" then
  229. draw_popup_box;
  230. end if;
  231. --
  232. core.write_text_box ("--");
  233. end synchronize;
  234. ------------------------------------------------------------------------------------------
  235. procedure write (text : in string; x, y : in integer; tint : in core.colour := (others => 255); size : in natural := 0; code : in boolean := false) is
  236. begin
  237. core.write (text, x, y, tint, (if size = 0 then font (active).scale else size), (if code then monospace else font (active)));
  238. end write;
  239. ------------------------------------------------------------------------------------------
  240. procedure draw_icon (data : in core.sprite; text : in string; x, y : in integer; action : core.pointer := core.idle_skip'access) is
  241. begin
  242. draw (icon, x, y);
  243. --
  244. core.draw (data, x, y, factor => 1);
  245. --
  246. if core.cursor_inside (x, y, core.icon / core.zoom, core.icon / core.zoom) then
  247. prioritize := true;
  248. --
  249. draw (icon_selected, x, y);
  250. --
  251. core.write_help_box (text);
  252. --
  253. if core.cursor_mode = core.cursor_left then
  254. action.all;
  255. core.cursor_mode := core.cursor_none;
  256. end if;
  257. end if;
  258. end draw_icon;
  259. ------------------------------------------------------------------------------------------
  260. procedure draw_overicon (data : in core.sprite; text : in string; x, y : in integer; action : core.pointer := core.idle_skip'access) is
  261. begin
  262. core.draw (data, x, y, factor => 1);
  263. --
  264. draw (overicon, x, y);
  265. end draw_overicon;
  266. ------------------------------------------------------------------------------------------
  267. procedure draw_sprite (data : in core.sprite; text : in string; x, y, offset : in integer; action : core.pointer := core.idle_skip'access) is
  268. begin
  269. core.draw (data, x + offset, y + offset, factor => 1);
  270. --
  271. draw_icon_menu (x, y, data.width + 2 * offset, data.height + 2 * offset);
  272. --
  273. if core.cursor_inside (x, y, (data.width + 2 * offset) / core.zoom, (data.height + 2 * offset) / core.zoom) then
  274. prioritize := true;
  275. --
  276. core.write_help_box (text);
  277. --
  278. if core.cursor_mode = core.cursor_left then
  279. action.all;
  280. core.cursor_mode := core.cursor_none;
  281. end if;
  282. end if;
  283. end draw_sprite;
  284. ------------------------------------------------------------------------------------------
  285. procedure draw_text_box (x, y, width, height : in integer) is
  286. middle : constant integer := sprite (active, text_middle).width;
  287. begin
  288. draw_background (text_middle, x + middle, y + middle, width - 2 * middle, height - 2 * middle);
  289. --
  290. draw_horizontally (text_upper, x + middle, y, width - 2 * middle);
  291. draw_horizontally (text_lower, x + middle, y + height - middle, width - 2 * middle);
  292. draw_vertically (text_left, x, y + middle, height - 2 * middle);
  293. draw_vertically (text_right, x + width - middle, y + middle, height - 2 * middle);
  294. --
  295. draw (text_upper_left, x, y);
  296. draw (text_upper_right, x + width - middle, y);
  297. draw (text_lower_left, x, y + height - middle);
  298. draw (text_lower_right, x + width - middle, y + height - middle);
  299. end draw_text_box;
  300. ------------------------------------------------------------------------------------------
  301. procedure draw_help_box (x, y, width, height : in integer; action : core.pointer := core.idle_skip'access) is
  302. offset : constant integer := sprite (active, text_middle).width;
  303. begin
  304. if core.cursor_inside (x, y, width, height) then
  305. prioritize := true;
  306. end if;
  307. --
  308. draw_background (text_middle, x + offset, y + offset, width - 2 * offset, height - 2 * offset);
  309. --
  310. draw_horizontally (text_upper, x + offset, y, width - 2 * offset);
  311. draw_horizontally (text_lower, x + offset, y + height - offset, width - 2 * offset);
  312. draw_vertically (text_left, x, y + offset, height - 2 * offset);
  313. draw_vertically (text_right, x + width - offset, y + offset, height - 2 * offset);
  314. --
  315. draw (text_upper_left, x, y);
  316. draw (text_upper_right, x + width - offset, y);
  317. draw (text_lower_left, x, y + height - offset);
  318. draw (text_lower_right, x + width - offset, y + height - offset);
  319. --
  320. write (core.read_help_box, (core.icon - font (active).scale) / 2 + x + 4, (core.icon - font (active).scale) / 2 + y);
  321. --
  322. core.write_help_box ("--");
  323. end draw_help_box;
  324. ------------------------------------------------------------------------------------------
  325. procedure draw_frame (description : in string; x, y, width, height : in integer; action : core.pointer := core.idle_skip'access) is
  326. offset_x : constant integer := sprite (active, frame_middle).width;
  327. offset_y : constant integer := sprite (active, frame_middle).height;
  328. begin
  329. if height < core.icon or width < core.icon then
  330. return;
  331. end if;
  332. --
  333. draw_background (frame_middle, x + offset_x, y + offset_y, width - 2 * offset_x, height - 2 * offset_y);
  334. --
  335. draw_horizontally (frame_upper, x + offset_x, y, width - 2 * offset_x);
  336. draw_horizontally (frame_lower, x + offset_x, y + height - offset_y, width - 2 * offset_x);
  337. draw_vertically (frame_left, x, y + offset_y, height - 2 * offset_y);
  338. draw_vertically (frame_right, x + width - offset_x, y + offset_y, height - 2 * offset_y);
  339. --
  340. draw (frame_upper_left, x, y);
  341. draw (frame_upper_right, x + width - sprite (active, frame_upper_right).width, y);
  342. draw (frame_lower_left, x, y + height - sprite (active, frame_lower_left).height);
  343. draw (frame_lower_right, x + width - sprite (active, frame_lower_right).width, y + height - sprite (active, frame_lower_right).height);
  344. --
  345. if core.cursor_inside (x, y, width / core.zoom, height / core.zoom) then
  346. prioritize := true;
  347. --
  348. core.write_help_box (description);
  349. --
  350. if core.cursor_mode = core.cursor_left then
  351. action.all;
  352. core.cursor_mode := core.cursor_none;
  353. end if;
  354. end if;
  355. end draw_frame;
  356. ------------------------------------------------------------------------------------------
  357. 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
  358. offset : constant integer := core.icon / 4;
  359. begin
  360. draw_frame (description, x, y, width, height);
  361. draw_icon (icon, description, x + offset, y + offset);
  362. --
  363. write (text,
  364. x + offset + (core.icon - font (active).scale) / 2 + core.icon,
  365. y + offset + (core.icon - font (active).scale) / 2,
  366. (if core.cursor_inside (x, y, width / core.zoom, height / core.zoom) then font_tint (active) else (others => 255)));
  367. --
  368. if core.cursor_inside (x, y, width / core.zoom, height / core.zoom) then
  369. prioritize := true;
  370. --
  371. if core.cursor_mode = core.cursor_left then
  372. action.all;
  373. core.cursor_mode := core.cursor_none;
  374. end if;
  375. end if;
  376. end draw_button;
  377. ------------------------------------------------------------------------------------------
  378. procedure draw_check_box (x, y : in integer; on : in out boolean; text : in string) is
  379. begin
  380. draw ((if on then check_box_on else check_box_off), x, y);
  381. --
  382. write (text, x + sprite (active, check_box_on).width, y);
  383. --
  384. if core.cursor_mode = core.cursor_left
  385. and core.cursor_inside (x, y, sprite (active, check_box_on).width / core.zoom, sprite (active, check_box_on).height / core.zoom) then
  386. on := not on;
  387. core.cursor_mode := core.cursor_none;
  388. end if;
  389. end draw_check_box;
  390. ------------------------------------------------------------------------------------------
  391. procedure draw_title_bar (x, y, width : in integer; title : in string) is
  392. middle_width : constant integer := width - sprite (active, title_bar_left).width - sprite (active, title_bar_right).width;
  393. offset : constant integer := (sprite (active, title_bar_middle).height - font (active).scale) / 2;
  394. begin
  395. if core.cursor_inside (x, y, width / core.zoom, sprite (active, title_bar_left).height / core.zoom) then
  396. prioritize := true;
  397. end if;
  398. --
  399. draw (title_bar_left, x, y - sprite (active, title_bar_left).height);
  400. draw (title_bar_right, x + middle_width + sprite (active, title_bar_left).width, y - sprite (active, title_bar_right).height);
  401. --
  402. draw_horizontally (title_bar_middle, x + sprite (active, title_bar_left).width, y - sprite (active, title_bar_middle).height, middle_width);
  403. --
  404. write (title, x + sprite (active, title_bar_left).width, y - font (active).scale - 4, tint => font_tint (active));
  405. end draw_title_bar;
  406. ------------------------------------------------------------------------------------------
  407. procedure draw_fill_bar (x, y, width : in integer; fill : in float) is
  408. middle_width : constant integer := width - sprite (active, fill_bar_left).width - sprite (active, fill_bar_right).width;
  409. fill_width : constant integer := integer (float (middle_width) * fill);
  410. begin
  411. draw (fill_bar_left, x, y - sprite (active, fill_bar_left).height);
  412. draw (fill_bar_right, x + middle_width + sprite (active, fill_bar_left).width, y - sprite (active, fill_bar_right).height);
  413. --
  414. draw_horizontally (fill_bar_horizontal, x + sprite (active, fill_bar_left).width, y - sprite (active, fill_bar_horizontal).height, middle_width);
  415. draw_horizontally (fill_horizontal, x + sprite (active, fill_bar_left).width, y - sprite (active, fill_bar_horizontal).height, fill_width);
  416. end draw_fill_bar;
  417. ------------------------------------------------------------------------------------------
  418. procedure draw_tiny_fill_bar (x, y, width : in integer; fill : in float; tint : in core.colour) is
  419. middle_width : constant integer := width - sprite (active, tiny_fill_bar_left).width - sprite (active, tiny_fill_bar_right).width;
  420. fill_width : constant integer := integer (float (middle_width) * fill);
  421. begin
  422. draw (tiny_fill_bar_left, x, y - sprite (active, tiny_fill_bar_left).height);
  423. draw (tiny_fill_bar_right, x + middle_width + sprite (active, tiny_fill_bar_left).width, y - sprite (active, tiny_fill_bar_left).height);
  424. --
  425. draw_horizontally (tiny_fill_bar_horizontal, x + sprite (active, tiny_fill_bar_left).width, y - sprite (active, tiny_fill_bar_horizontal).height, middle_width);
  426. --
  427. draw_horizontally (index => tiny_fill_horizontal,
  428. x => x + sprite (active, tiny_fill_bar_left).width,
  429. y => y - sprite (active, tiny_fill_bar_horizontal).height,
  430. width => fill_width,
  431. tint => tint);
  432. end draw_tiny_fill_bar;
  433. ------------------------------------------------------------------------------------------
  434. procedure draw_scroll_bar (x, y, height, offset : in integer) is
  435. middle_height : constant integer := height - sprite (active, scroll_bar_upper).height - sprite (active, scroll_bar_lower).height;
  436. begin
  437. draw (scroll_bar_upper, x, y);
  438. draw (scroll_bar_lower, x, y + middle_height + sprite (active, scroll_bar_upper).height);
  439. --
  440. draw_vertically (scroll_bar_middle, x, y + sprite (active, scroll_bar_upper).height, middle_height);
  441. end draw_scroll_bar;
  442. ------------------------------------------------------------------------------------------
  443. procedure draw_menu (x, y, width, height : in integer) is
  444. offset : constant integer := sprite (active, none).width;
  445. begin
  446. if core.cursor_inside (x, y, width / core.zoom, height / core.zoom) then
  447. prioritize := true;
  448. end if;
  449. --
  450. declare upper : constant integer := width - sprite (active, corner_upper_left).width - sprite (active, corner_upper_right).width;
  451. lower : constant integer := width - sprite (active, corner_lower_left).width - sprite (active, corner_lower_right).width;
  452. left : constant integer := height - sprite (active, corner_upper_left).height - sprite (active, corner_lower_left).height;
  453. right : constant integer := height - sprite (active, corner_upper_right).height - sprite (active, corner_lower_right).height;
  454. begin
  455. draw_horizontally (border_upper, x + sprite (active, corner_upper_left).width, y, upper, action => core.move_camera_up'access);
  456. 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);
  457. draw_vertically (border_left, x, y + sprite (active, corner_upper_left).height, left, action => core.move_camera_left'access);
  458. 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);
  459. end;
  460. --
  461. draw (corner_upper_left, x, y);
  462. draw (corner_upper_right, x + width - sprite (active, corner_upper_right).width, y);
  463. draw (corner_lower_left, x, y + height - sprite (active, corner_lower_left).height);
  464. draw (corner_lower_right, x + width - sprite (active, corner_lower_right).width, y + height - sprite (active, corner_lower_right).height);
  465. end draw_menu;
  466. ------------------------------------------------------------------------------------------
  467. procedure draw_tiny_menu (x, y, width, height : in integer) is
  468. offset : constant integer := sprite (active, none).width;
  469. begin
  470. if core.cursor_inside (x, y, width / core.zoom, height / core.zoom) then
  471. prioritize := true;
  472. end if;
  473. --
  474. draw_background (main_background, x + offset, y + offset, width - 2 * offset, height - 2 * offset);
  475. --
  476. declare upper : constant integer := width - sprite (active, tiny_corner_upper_left).width - sprite (active, tiny_corner_upper_right).width;
  477. lower : constant integer := width - sprite (active, tiny_corner_lower_left).width - sprite (active, tiny_corner_lower_right).width;
  478. left : constant integer := height - sprite (active, tiny_corner_upper_left).height - sprite (active, tiny_corner_lower_left).height;
  479. right : constant integer := height - sprite (active, tiny_corner_upper_right).height - sprite (active, tiny_corner_lower_right).height;
  480. begin
  481. draw_horizontally (tiny_border_upper, x + sprite (active, tiny_corner_upper_left).width, y, upper);
  482. draw_horizontally (tiny_border_lower, x + sprite (active, tiny_corner_lower_left).width, y + height - sprite (active, tiny_border_lower).height, lower);
  483. draw_vertically (tiny_border_left, x, y + sprite (active, tiny_corner_upper_left).height, left);
  484. draw_vertically (tiny_border_right, x + width - sprite (active, tiny_border_right).width, y + sprite (active, tiny_corner_upper_right).height, right);
  485. end;
  486. --
  487. draw (tiny_corner_upper_left, x, y);
  488. draw (tiny_corner_upper_right, x + width - sprite (active, tiny_corner_upper_right).width, y);
  489. draw (tiny_corner_lower_left, x, y + height - sprite (active, tiny_corner_lower_left).height);
  490. draw (tiny_corner_lower_right, x + width - sprite (active, tiny_corner_lower_right).width, y + height - sprite (active, tiny_corner_lower_right).height);
  491. end draw_tiny_menu;
  492. ------------------------------------------------------------------------------------------
  493. procedure draw_icon_menu (x, y, width, height : in integer) is
  494. offset_x : constant integer := sprite (active, icon_upper_left).width;
  495. offset_y : constant integer := sprite (active, icon_upper_left).height;
  496. begin
  497. if core.cursor_inside (x, y, width / core.zoom, height / core.zoom) then
  498. prioritize := true;
  499. end if;
  500. --
  501. if height < 2 * sprite (active, icon_upper_left).height
  502. or width < 2 * sprite (active, icon_upper_left).width then
  503. return;
  504. end if;
  505. --
  506. draw_horizontally (icon_upper, x + offset_x, y, width - 2 * offset_x);
  507. draw_horizontally (icon_lower, x + offset_x, y + height - offset_y, width - 2 * offset_x);
  508. draw_vertically (icon_left, x, y + offset_y, height - 2 * offset_y);
  509. draw_vertically (icon_right, x + width - offset_x, y + offset_y, height - 2 * offset_y);
  510. --
  511. draw (icon_upper_left, x, y);
  512. draw (icon_upper_right, x + width - sprite (active, icon_upper_right).width, y);
  513. draw (icon_lower_left, x, y + height - sprite (active, icon_lower_left).height);
  514. draw (icon_lower_right, x + width - sprite (active, icon_lower_right).width, y + height - sprite (active, icon_lower_right).height);
  515. end draw_icon_menu;
  516. ------------------------------------------------------------------------------------------
  517. procedure draw_state_box (x, y : in integer) is
  518. begin
  519. ui.write ("Cursor X:" & core.cursor.x'image, x, y + 0);
  520. ui.write ("Cursor Y:" & core.cursor.y'image, x, y + 32);
  521. ui.write ("Cursor Mode:" & core.cursor_mode'image, x, y + 64);
  522. ui.write ("Camera X:" & core.camera.x'image, x, y + 96);
  523. ui.write ("Camera Y:" & core.camera.y'image, x, y + 128);
  524. ui.write ("Global Time:" & core.global_time'image, x, y + 160);
  525. ui.write ("Gameplay Time:" & core.gameplay_time'image, x, y + 192);
  526. ui.write ("Animation Time:" & core.animation_time'image, x, y + 224);
  527. ui.write ("Framerate:" & core.framerate'image, x, y + 256);
  528. end draw_state_box;
  529. ------------------------------------------------------------------------------------------
  530. procedure add_structure (data : in structure) is
  531. begin
  532. structure_array (structure_count) := data;
  533. structure_array (structure_count).gui_list := new gui_array (0 .. structure_array (structure_count).gui_n - 1);
  534. structure_array (structure_count).gui_n := 0;
  535. --
  536. core.increment (structure_count);
  537. end add_structure;
  538. ------------------------------------------------------------------------------------------
  539. procedure add_structure_button (icon : in core.sprite; name : in core.short_string; text : in core.long_string := "") is
  540. begin
  541. structure_array (structure_count - 1).gui_list (structure_array (structure_count - 1).gui_n).kind := gui_button;
  542. structure_array (structure_count - 1).gui_list (structure_array (structure_count - 1).gui_n).text := name;
  543. structure_array (structure_count - 1).gui_list (structure_array (structure_count - 1).gui_n).info := text;
  544. structure_array (structure_count - 1).gui_list (structure_array (structure_count - 1).gui_n).number := 0;
  545. structure_array (structure_count - 1).gui_list (structure_array (structure_count - 1).gui_n).image := icon;
  546. --
  547. core.increment (structure_array (structure_count - 1).gui_n);
  548. end add_structure_button;
  549. ------------------------------------------------------------------------------------------
  550. procedure add_structure_orient is
  551. begin
  552. structure_array (structure_count - 1).gui_list (structure_array (structure_count - 1).gui_n).kind := gui_orient;
  553. --
  554. core.increment (structure_array (structure_count - 1).gui_n);
  555. end add_structure_orient;
  556. ------------------------------------------------------------------------------------------
  557. procedure write_ada_code (text : in core.string_box_data; x, y : in integer) is
  558. word : unbounded_string := to_unbounded_string ("");
  559. --
  560. buffer : character := ' ';
  561. width : constant integer := 9;
  562. height : constant integer := 15;
  563. length : natural := 1;
  564. offset : core.vector := (x, y);
  565. subset : natural := 0;
  566. begin
  567. loop
  568. buffer := ada.strings.unbounded.element (text.text, length);
  569. offset.x := offset.x + width;
  570. --
  571. exit when buffer = character'val (0);
  572. --
  573. case buffer is
  574. when character'val (9) => offset.x := offset.x + 2 * width;
  575. when character'val (10) => offset.y := offset.y + 1 * height; offset.x := x;
  576. when ':' | ';' | '.' | ',' | '=' | '<' | '>' =>
  577. ui.write (buffer & "", offset.x, offset.y, (63, 127, 255, 255), height, code => true);
  578. when '+' | '*' | '/' | '|' | '&' =>
  579. ui.write (buffer & "", offset.x, offset.y, (63, 63, 255, 255), height, code => true);
  580. when '(' | ')' | ''' =>
  581. ui.write (buffer & "", offset.x, offset.y, (63, 255, 255, 255), height, code => true);
  582. when '"' =>
  583. ui.write (buffer & "", offset.x, offset.y, (127, 63, 127, 255), height, code => true);
  584. offset.x := offset.x + width;
  585. loop
  586. core.increment (length);
  587. buffer := ada.strings.unbounded.element (text.text, length);
  588. ui.write (buffer & "", offset.x, offset.y, (127, 63, 127, 255), height, code => true);
  589. offset.x := offset.x + width;
  590. exit when buffer = '"';
  591. end loop;
  592. offset.x := offset.x - width;
  593. when '-' =>
  594. if ada.strings.unbounded.element (text.text, length + 1) = '-' then
  595. ui.write (buffer & "", offset.x, offset.y, (127, 127, 127, 255), height, code => true);
  596. offset.x := offset.x + width;
  597. loop
  598. core.increment (length);
  599. buffer := ada.strings.unbounded.element (text.text, length);
  600. ui.write (buffer & "", offset.x, offset.y, (127, 127, 127, 255), height, code => true);
  601. offset.x := offset.x + width;
  602. exit when buffer = character'val (10);
  603. end loop;
  604. core.decrement (length);
  605. else
  606. ui.write (buffer & "", offset.x, offset.y, (63, 63, 255, 255), height, code => true);
  607. end if;
  608. when '0' .. '9' =>
  609. loop
  610. ui.write (buffer & "", offset.x, offset.y, (127, 63, 255, 255), height, code => true);
  611. core.increment (length);
  612. buffer := ada.strings.unbounded.element (text.text, length);
  613. exit when buffer = ' ' or buffer = ';' or buffer = ')' or buffer = ',';
  614. offset.x := offset.x + width;
  615. end loop;
  616. core.decrement (length);
  617. when 'a' .. 'z' | 'A' .. 'Z' =>
  618. word := to_unbounded_string (buffer & "");
  619. subset := 1;
  620. loop
  621. buffer := ada.strings.unbounded.element (text.text, length + subset);
  622. exit when buffer = ' ' or buffer = '.' or buffer = '(' or buffer = ')' or buffer = ',' or buffer = ';' or buffer = '''
  623. or buffer = character'val (9) or buffer = character'val (10);
  624. word := word & to_unbounded_string (buffer & "");
  625. core.increment (subset);
  626. end loop;
  627. if word = "type" or word = "begin" or word = "end" or word = "when" or word = "others" or word = "procedure" or word = "function"
  628. or word = "package" or word = "body" or word = "if" or word = "then" or word = "else" or word = "elsif" or word = "case" or word = "is"
  629. or word = "and" or word = "or" or word = "xor" or word = "exit" or word = "constant" or word = "access" or word = "range"
  630. or word = "subtype" or word = "array" or word = "in" or word = "out" or word = "return" or word = "for" or word = "with"
  631. or word = "loop" or word = "while" or word = "of" or word = "null" or word = "record" or word = "use" or word = "mod" or word = "new"
  632. or word = "aliased" then
  633. ui.write (to_string (word), offset.x, offset.y, (255, 255, 0, 255), height, code => true);
  634. else
  635. ui.write (to_string (word), offset.x, offset.y, (others => 255), height, code => true);
  636. end if;
  637. offset.x := offset.x + (subset - 1) * width;
  638. length := length + subset - 1;
  639. when others =>
  640. ui.write (buffer & "", offset.x, offset.y, (others => 255), height, code => true);
  641. end case;
  642. --
  643. core.increment (length);
  644. end loop;
  645. end write_ada_code;
  646. ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
  647. end ui;