From d675ce7467d05e961131e68ddad1fef062fee586 Mon Sep 17 00:00:00 2001 From: xolatile Date: Sat, 25 May 2024 01:48:03 -0400 Subject: [PATCH] Minor refactorings, moving procedures to world and quality revisions... --- source/core.adb | 5 -- source/core.ads | 4 -- source/main.adb | 202 ++++++++++++++++++++++++------------------------------- source/ui.adb | 8 +-- source/world.adb | 44 ++++++++++++ source/world.ads | 5 ++ 6 files changed, 142 insertions(+), 126 deletions(-) diff --git a/source/core.adb b/source/core.adb index 37064d9..218577f 100644 --- a/source/core.adb +++ b/source/core.adb @@ -417,11 +417,6 @@ package body core is procedure idle_skip is null; - procedure move_camera_up is begin core.camera.y := core.camera.y - 1; end move_camera_up; - procedure move_camera_down is begin core.camera.y := core.camera.y + 1; end move_camera_down; - procedure move_camera_left is begin core.camera.x := core.camera.x - 1; end move_camera_left; - procedure move_camera_right is begin core.camera.x := core.camera.x + 1; end move_camera_right; - ------------------------------------------------------------------------------------------ procedure toggle_fullscreen is diff --git a/source/core.ads b/source/core.ads index e3b2111..4607e68 100644 --- a/source/core.ads +++ b/source/core.ads @@ -187,10 +187,6 @@ package core is procedure decrement (value : in out integer); procedure idle_skip; - procedure move_camera_up; - procedure move_camera_down; - procedure move_camera_left; - procedure move_camera_right; procedure toggle_fullscreen; diff --git a/source/main.adb b/source/main.adb index 96fdee1..5cc80fd 100644 --- a/source/main.adb +++ b/source/main.adb @@ -4,7 +4,6 @@ pragma ada_2012; ---~with core, ui, effect, attribute, skill, resource, faction, might, magic, equipment, unit, construction, chad, deity, world, ai; with core, ui, effect, attribute, skill, resource, faction, deity, material, magic, equipment, unit, construction, chad, world; with ada.strings.unbounded; @@ -18,114 +17,26 @@ procedure main is ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------ - side_panel : integer := 0; - preview_width : integer := 0; - preview_height : integer := 0; - text_box_height : integer := 0; - - player : chad.value := ( - index => chad.ada, - state => core.idle, - x => 0, - y => 0, - health => (30, 40), - mana => (20, 30), - stamina => (10, 20), - attributes => attribute.default, - skills => skill.default, - resources => ((101, 240), (103, 240), (107, 240), (109, 240), (113, 240), (127, 240)), - equipments => (equipment.chest => equipment.elven_armour, - equipment.head => equipment.elven_helmet, - equipment.hands => equipment.leather_gauntlets, - equipment.feet => equipment.leather_greaves, - equipment.main_hand => equipment.jade_sword, - others => equipment.none), - item_count => 0, - items => (others => equipment.none) - ); - - ------------------------------------------------------------------------------------------ - type view is ( map_preview_panel, status_preview_panel, text_box_panel ); - view_icon : array (view) of core.sprite := (others => (others => 0)); - view_list : array (view) of boolean := (others => true); + ------------------------------------------------------------------------------------------ - view_text : array (view) of core.long_string := ( - "Toggle map preview panel. ", - "Toggle status preview panel. ", - "Toggle text box panel. " - ); - - procedure swap_map_preview_panel is begin view_list (map_preview_panel) := not view_list (map_preview_panel); end swap_map_preview_panel; - procedure swap_status_preview_panel is begin view_list (status_preview_panel) := not view_list (status_preview_panel); end swap_status_preview_panel; - procedure swap_text_box_panel is begin view_list (text_box_panel) := not view_list (text_box_panel); end swap_text_box_panel; - - view_show : array (view) of access procedure := ( - swap_map_preview_panel'access, - swap_status_preview_panel'access, - swap_text_box_panel'access - ); - - game_title : core.sprite; - game_preview : array (world.biome) of core.sprite; - - switch : natural := 0; - choose : world.biome := world.grass; + procedure swap_map_preview_panel; + procedure swap_status_preview_panel; + procedure swap_text_box_panel; + procedure ui_main_style; + procedure zoom_in; + procedure zoom_out; ------------------------------------------------------------------------------------------ - procedure check_move_camera_up is - begin - core.decrement (world.map.chads (1).y); - world.map.chads (1).y := core.clip (world.map.chads (1).y, 0, world.map.height - 1); - if world.map.clips (world.map.chads (1).x, world.map.chads (1).y) then - core.increment (world.map.chads (1).y); - end if; - end check_move_camera_up; - - procedure check_move_camera_down is - begin - core.increment (world.map.chads (1).y); - world.map.chads (1).y := core.clip (world.map.chads (1).y, 0, world.map.height - 1); - if world.map.clips (world.map.chads (1).x, world.map.chads (1).y) then - core.decrement (world.map.chads (1).y); - end if; - end check_move_camera_down; - - procedure check_move_camera_left is - begin - core.decrement (world.map.chads (1).x); - world.map.chads (1).x := core.clip (world.map.chads (1).x, 0, world.map.width - 1); - if world.map.clips (world.map.chads (1).x, world.map.chads (1).y) then - core.increment (world.map.chads (1).x); - end if; - end check_move_camera_left; - - procedure check_move_camera_right is - begin - core.increment (world.map.chads (1).x); - world.map.chads (1).x := core.clip (world.map.chads (1).x, 0, world.map.width - 1); - if world.map.clips (world.map.chads (1).x, world.map.chads (1).y) then - core.decrement (world.map.chads (1).x); - end if; - end check_move_camera_right; - - procedure ui_main_style is - begin - ui.active := ui.style'val ((ui.style'pos (ui.active) + 1) mod ui.style_count); - end ui_main_style; - - procedure zoom_in is begin core.zoom := 2; end zoom_in; - procedure zoom_out is begin core.zoom := 1; end zoom_out; - signal_list : constant array (core.signal_code) of access procedure := ( - core.signal_up => check_move_camera_up'access, - core.signal_down => check_move_camera_down'access, - core.signal_left => check_move_camera_left'access, - core.signal_right => check_move_camera_right'access, + core.signal_up => world.player_up'access, + core.signal_down => world.player_down'access, + core.signal_left => world.player_left'access, + core.signal_right => world.player_right'access, core.signal_v => ui_main_style'access, core.signal_kp_add => zoom_in'access, core.signal_kp_subtract => zoom_out'access, @@ -140,19 +51,26 @@ procedure main is others => core.idle_skip'access ); - ------------------------------------------------------------------------------------------ + view_show : array (view) of access procedure := ( + swap_map_preview_panel'access, + swap_status_preview_panel'access, + swap_text_box_panel'access + ); - procedure main_menu is - begin - core.draw (game_preview (world.ash), core.center_x (game_preview (world.ash).width * 2), core.center_y (game_preview (world.ash).height * 2), factor => 2); - core.draw (game_title, core.center_x (game_title.width * 2), core.center_y (game_title.height * 2), factor => 2); - -- - ui.write ("Main Menu", 0, 0); - -- - ui.draw_check_box (0, 32, view_list (map_preview_panel), "map_preview_panel"); - ui.draw_check_box (0, 64, view_list (status_preview_panel), "status_preview_panel"); - ui.draw_check_box (0, 96, view_list (text_box_panel), "text_box_panel"); - end main_menu; + view_icon : array (view) of core.sprite := (others => (others => 0)); + view_list : array (view) of boolean := (others => true); + + view_text : array (view) of core.long_string := ( + "Toggle map preview panel. ", + "Toggle status preview panel. ", + "Toggle text box panel. " + ); + + game_title : core.sprite; + game_preview : array (world.biome) of core.sprite; + + switch : natural := 0; + choose : world.biome := world.grass; view_source_code : natural := 25; @@ -195,6 +113,64 @@ procedure main is to_unbounded_string (core.folder & "/source/world.ads") ); + side_panel : integer := 0; + preview_width : integer := 0; + preview_height : integer := 0; + text_box_height : integer := 0; + + player : chad.value := ( + index => chad.ada, + state => core.idle, + x => 0, + y => 0, + health => (30, 40), + mana => (20, 30), + stamina => (10, 20), + attributes => attribute.default, + skills => skill.default, + resources => ((101, 240), (103, 240), (107, 240), (109, 240), (113, 240), (127, 240)), + equipments => (equipment.chest => equipment.elven_armour, + equipment.head => equipment.elven_helmet, + equipment.hands => equipment.leather_gauntlets, + equipment.feet => equipment.leather_greaves, + equipment.main_hand => equipment.jade_sword, + others => equipment.none), + item_count => 0, + items => (others => equipment.none) + ); + + ------------------------------------------------------------------------------------------ + + procedure swap_map_preview_panel is begin view_list (map_preview_panel) := not view_list (map_preview_panel); end swap_map_preview_panel; + procedure swap_status_preview_panel is begin view_list (status_preview_panel) := not view_list (status_preview_panel); end swap_status_preview_panel; + procedure swap_text_box_panel is begin view_list (text_box_panel) := not view_list (text_box_panel); end swap_text_box_panel; + + ------------------------------------------------------------------------------------------ + + procedure ui_main_style is + begin + ui.active := ui.style'val ((ui.style'pos (ui.active) + 1) mod ui.style_count); + end ui_main_style; + + ------------------------------------------------------------------------------------------ + + procedure zoom_in is begin core.zoom := 2; end zoom_in; + procedure zoom_out is begin core.zoom := 1; end zoom_out; + + ------------------------------------------------------------------------------------------ + + procedure main_menu is + begin + core.draw (game_preview (world.ash), core.center_x (game_preview (world.ash).width * 2), core.center_y (game_preview (world.ash).height * 2), factor => 2); + core.draw (game_title, core.center_x (game_title.width * 2), core.center_y (game_title.height * 2), factor => 2); + -- + ui.write ("Main Menu", 0, 0); + -- + ui.draw_check_box (0, 32, view_list (map_preview_panel), "map_preview_panel"); + ui.draw_check_box (0, 64, view_list (status_preview_panel), "status_preview_panel"); + ui.draw_check_box (0, 96, view_list (text_box_panel), "text_box_panel"); + end main_menu; + ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------ begin @@ -328,7 +304,7 @@ begin view_show (index)); end loop; -- - resource.draw_points (world.map.chads (1).resources, (preview_width - 5 * core.icon * resource.count) / 2, (if view_list (map_preview_panel) then core.icon else 0)); + resource.draw_points (world.map.chads (1).resources, (preview_width - 5 * core.icon * resource.count) / 2, core.base); -- signal_list (core.signal_mode).all; -- diff --git a/source/ui.adb b/source/ui.adb index 1db99dd..39542fe 100644 --- a/source/ui.adb +++ b/source/ui.adb @@ -511,10 +511,10 @@ package body ui is 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); + 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); diff --git a/source/world.adb b/source/world.adb index a3f7eb1..0025d09 100644 --- a/source/world.adb +++ b/source/world.adb @@ -475,6 +475,50 @@ package body world is end loop; end reveal_map; + ------------------------------------------------------------------------------------------ + + procedure player_up is + begin + core.decrement (map.chads (1).y); + map.chads (1).y := core.clip (map.chads (1).y, 0, map.height - 1); + if map.clips (map.chads (1).x, map.chads (1).y) then + core.increment (map.chads (1).y); + end if; + end player_up; + + ------------------------------------------------------------------------------------------ + + procedure player_down is + begin + core.increment (map.chads (1).y); + map.chads (1).y := core.clip (map.chads (1).y, 0, map.height - 1); + if map.clips (map.chads (1).x, map.chads (1).y) then + core.decrement (map.chads (1).y); + end if; + end player_down; + + ------------------------------------------------------------------------------------------ + + procedure player_left is + begin + core.decrement (map.chads (1).x); + map.chads (1).x := core.clip (map.chads (1).x, 0, map.width - 1); + if map.clips (map.chads (1).x, map.chads (1).y) then + core.increment (map.chads (1).x); + end if; + end player_left; + + ------------------------------------------------------------------------------------------ + + procedure player_right is + begin + core.increment (map.chads (1).x); + map.chads (1).x := core.clip (map.chads (1).x, 0, map.width - 1); + if map.clips (map.chads (1).x, map.chads (1).y) then + core.decrement (map.chads (1).x); + end if; + end player_right; + ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------ end world; diff --git a/source/world.ads b/source/world.ads index 7ec5c9b..7ef8856 100644 --- a/source/world.ads +++ b/source/world.ads @@ -138,6 +138,11 @@ package world is procedure resource_cheat_6; procedure reveal_map; + procedure player_up; + procedure player_down; + procedure player_left; + procedure player_right; + ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------ end world;