From 8d9f40c3e0d6fca0b198306989683d430d111497 Mon Sep 17 00:00:00 2001 From: xolatile Date: Wed, 11 Oct 2023 16:25:59 -0400 Subject: [PATCH] Minor refactoring in progress... --- xabina.adb | 258 +++++++++++++++++++++++++++++++++++-------------------------- 1 file changed, 148 insertions(+), 110 deletions(-) diff --git a/xabina.adb b/xabina.adb index f1f92de..1a33988 100644 --- a/xabina.adb +++ b/xabina.adb @@ -44,6 +44,80 @@ function xabina return integer is LINE_FEED : constant character := character'val (13); ESCAPE : constant character := character'val (27); + ------------------------------------------------------------------------------------------ + + procedure action_idle; + + type procedure_pointer is access procedure; + type ascii_range is mod 2 ** 8; + type action_data is array (ascii_range) of procedure_pointer; + + type screen_width is mod 120; + type screen_height is mod 40; + + type screen_type is array (screen_height, screen_width) of character; + + ------------------------------------------------------------------------------------------ + + active : boolean := true; + signal : character := ' '; + + action_list : action_data := (others => action_idle'access); + + screen_symbol : screen_type := (others => (others => CANCEL)); + screen_colour : screen_type := (others => (others => COLOUR_WHITE)); + screen_effect : screen_type := (others => (others => EFFECT_NORMAL)); + + ------------------------------------------------------------------------------------------ + + procedure bind (symbol : character := CANCEL; + action : procedure_pointer := action_idle'access) is + begin + action_list (character'pos (symbol)) := action; + end bind; + + procedure unbind (symbol : character := CANCEL) is + begin + action_list (character'pos (symbol)) := action_idle'access; + end unbind; + + procedure action_idle is begin null; end action_idle; + procedure action_exit is begin active := false; end action_exit; + + procedure render_screen_delete is begin put (ESCAPE & "[2J"); end render_screen_delete; + procedure render_screen_offset is begin put (ESCAPE & "[H"); end render_screen_offset; + procedure render_cursor_hide is begin put (ESCAPE & "[?25l"); end render_cursor_hide; + procedure render_cursor_show is begin put (ESCAPE & "[?25h"); end render_cursor_show; + procedure render_realignment is begin put (CARRIAGE_RETURN & LINE_FEED); end render_realignment; + + procedure render_character (symbol : character := ' '; + colour : character := COLOUR_WHITE; + effect : character := EFFECT_NORMAL; + y : screen_height := 0; + x : screen_width := 0) is + begin + screen_symbol (y, x) := symbol; + screen_colour (y, x) := colour; + screen_effect (y, x) := effect; + end render_character; + + procedure render_screen is + format : string (1 .. 12) := ESCAPE & "[E;3CmS" & ESCAPE & "[0m"; + begin + render_screen_offset; + for y in screen_height + loop + for x in screen_width + loop + format (8) := screen_symbol (y, x); + format (6) := screen_colour (y, x); + format (3) := screen_effect (y, x); + put (format); + end loop; + render_realignment; + end loop; + end render_screen; + ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------ -- Entity ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------ @@ -53,6 +127,8 @@ function xabina return integer is ENTITY_SCROLL, ENTITY_POTION, ENTITY_CONSUMABLE, ENTITY_NOTE, ENTITY_PLANT, ENTITY_ANIMAL, ENTITY_GOBLIN, ENTITY_PLAYER ); + ------------------------------------------------------------------------------------------ + type entity_constant_type is tagged record entity : entity_list := ENTITY_NULL; -- Entity identifier. @@ -73,17 +149,18 @@ function xabina return integer is ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------ ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------ --- Map: --- -- Map data is only constant, not variable, since X and Y coordinates are determined by player, camera or global position. +-- Map ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------ + type map_list is ( + MAP_STONE_WALL, MAP_WOODEN_WALL, MAP_STONE_FLOOR, MAP_WOODEN_FLOOR, MAP_WATER_SHALLOW, MAP_WATER_DEEP, MAP_SWAMP_SHALLOW, MAP_SWAMP_DEEP + ); + + ------------------------------------------------------------------------------------------ + type map_width is mod 120; type map_height is mod 40; - type map_list is ( - STONE_WALL, WOODEN_WALL, STONE_FLOOR, WOODEN_FLOOR, WATER_SHALLOW, WATER_DEEP, SWAMP_SHALLOW, SWAMP_DEEP - ); - type map_constant_type is new entity_constant_type with record collide : boolean := false; @@ -92,6 +169,8 @@ function xabina return integer is type map_constant_list is array (map_list) of map_constant_type; type map_variable_list is array (map_height, map_width) of map_list; + ------------------------------------------------------------------------------------------ + map_constant_data : constant map_constant_list := ( (ENTITY_MAP, to_unbounded_string ("Stone Wall"), '#', COLOUR_GREY, EFFECT_BOLD, true), (ENTITY_MAP, to_unbounded_string ("Wooden Wall"), '#', COLOUR_YELLOW, EFFECT_NORMAL, true), @@ -105,17 +184,36 @@ function xabina return integer is map_variable_data : map_variable_list; + ------------------------------------------------------------------------------------------ + procedure generate_map is begin for y in map_height loop for x in map_width loop - map_variable_data (y, x) := WOODEN_FLOOR; + map_variable_data (y, x) := MAP_STONE_FLOOR; end loop; end loop; end generate_map; + procedure render_map is + symbol : character := ' '; + colour : character := COLOUR_WHITE; + effect : character := EFFECT_NORMAL; + begin + for y in screen_height + loop + for x in screen_width + loop + symbol := map_constant_data (map_variable_data (map_height (y), map_width (x))).symbol; + colour := map_constant_data (map_variable_data (map_height (y), map_width (x))).colour; + effect := map_constant_data (map_variable_data (map_height (y), map_width (x))).effect; + render_character (symbol, colour, effect, y, x); + end loop; + end loop; + end render_map; + ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------ -- Item ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------ @@ -130,6 +228,8 @@ function xabina return integer is PAPERS, PAPERWEIGHT ); + ------------------------------------------------------------------------------------------ + type item_mark is mod 72; type item_constant_type is new entity_constant_type with @@ -146,6 +246,8 @@ function xabina return integer is type item_constant_list is array (item_list) of item_constant_type; type item_variable_list is array (item_mark) of item_variable_type; + ------------------------------------------------------------------------------------------ + item_constant_data : constant item_constant_list := ( (ENTITY_ITEM, to_unbounded_string ("Wood"), '+', COLOUR_YELLOW, EFFECT_NORMAL, 2, 2), (ENTITY_ITEM, to_unbounded_string ("Bark"), '+', COLOUR_YELLOW, EFFECT_NORMAL, 1, 2), @@ -210,6 +312,8 @@ function xabina return integer is IGNITE, ILLUMINATE, BLADECHARM, BATTLECRY ); + ------------------------------------------------------------------------------------------ + type magic_mark is mod 72; type magic_constant_type is new entity_constant_type with @@ -231,6 +335,8 @@ function xabina return integer is type magic_constant_list is array (magic_list) of magic_constant_type; type magic_variable_list is array (magic_mark) of magic_variable_type; + ------------------------------------------------------------------------------------------ + magic_constant_data : constant magic_constant_list := ( (ENTITY_MAGIC, to_unbounded_string ("Ignite"), '*', COLOUR_YELLOW, EFFECT_ITALIC, false, -3, 0, 0, -1, 7, 1), (ENTITY_MAGIC, to_unbounded_string ("Illuminate"), '*', COLOUR_YELLOW, EFFECT_ITALIC, false, 0, 0, 0, -1, 13, 1), @@ -248,6 +354,8 @@ function xabina return integer is ARROWS, BOLTS, SLINGSHOTS, JARIDS ); + ------------------------------------------------------------------------------------------ + type ammunition_mark is mod 72; type ammunition_constant_type is new entity_constant_type with @@ -269,6 +377,8 @@ function xabina return integer is type ammunition_constant_list is array (ammunition_list) of ammunition_constant_type; type ammunition_variable_list is array (ammunition_mark) of ammunition_variable_type; + ------------------------------------------------------------------------------------------ + ammunition_constant_data : constant ammunition_constant_list := ( (ENTITY_AMMUNITION, to_unbounded_string ("Arrows"), '^', COLOUR_RED, EFFECT_NORMAL, 11, 13, false, 23, 7, 67), (ENTITY_AMMUNITION, to_unbounded_string ("Bolts"), '^', COLOUR_RED, EFFECT_NORMAL, 13, 23, false, 29, 5, 67), @@ -288,6 +398,8 @@ function xabina return integer is BRASS_SWORD, BRASS_GREATSWORD, BRASS_AXE, BRASS_BATTLEAXE, BRASS_SPEAR, BRASS_SHIELD, BRASS_MACE, BRASS_HAMMER ); + ------------------------------------------------------------------------------------------ + type weapon_mark is mod 72; type weapon_constant_type is new entity_constant_type with @@ -309,6 +421,8 @@ function xabina return integer is type weapon_constant_list is array (weapon_list) of weapon_constant_type; type weapon_variable_list is array (weapon_mark) of weapon_variable_type; + ------------------------------------------------------------------------------------------ + weapon_constant_data : constant weapon_constant_list := ( (ENTITY_WEAPON, to_unbounded_string ("Iron Sword"), 'l', COLOUR_RED, EFFECT_NORMAL, true, 11, 31, 7, 2, 1), (ENTITY_WEAPON, to_unbounded_string ("Iron Greatsword"), 'L', COLOUR_RED, EFFECT_BOLD, false, 23, 67, 11, 3, 2), @@ -346,6 +460,8 @@ function xabina return integer is IRON_HELMET, IRON_CHESTPLATE, IRON_GAUNTLETS, IRON_GREAVES, IRON_CUISSE, IRON_FAULD, IRON_GARDBRACE, IRON_REREBRACE ); + ------------------------------------------------------------------------------------------ + type armour_mark is mod 72; type armour_constant_type is new entity_constant_type with @@ -364,6 +480,8 @@ function xabina return integer is type armour_constant_list is array (armour_list) of armour_constant_type; type armour_variable_list is array (armour_mark) of armour_variable_type; + ------------------------------------------------------------------------------------------ + armour_constant_data : constant armour_constant_list := ( (ENTITY_ARMOUR, to_unbounded_string ("Iron Helmet"), 'm', COLOUR_YELLOW, EFFECT_NORMAL, 11, 31, 7), (ENTITY_ARMOUR, to_unbounded_string ("Iron Chestplate"), 'M', COLOUR_YELLOW, EFFECT_BOLD, 23, 67, 11), @@ -402,6 +520,8 @@ function xabina return integer is BUSH, THORNY_BUSH, TALL_GRASS, REED ); + ------------------------------------------------------------------------------------------ + type plant_mark is mod 72; type plant_constant_type is new entity_constant_type with @@ -417,6 +537,8 @@ function xabina return integer is type plant_constant_list is array (plant_list) of plant_constant_type; type plant_variable_list is array (plant_mark) of plant_variable_type; + ------------------------------------------------------------------------------------------ + plant_constant_data : constant plant_constant_list := ( (ENTITY_PLANT, to_unbounded_string ("Oak Tree"), 'T', COLOUR_GREEN, EFFECT_BOLD, 11), (ENTITY_PLANT, to_unbounded_string ("Pine Tree"), 'T', COLOUR_GREEN, EFFECT_BOLD, 23), @@ -450,6 +572,8 @@ function xabina return integer is GOBLIN_SLAVE, GOBLIN_WORKER, GOBLIN_WARRIOR, GOBLIN_BOAR_RIDER, GOBLIN_SHAMAN, GOBLIN_CHIEF, GOBLIN_KING, GOBLIN_OGRE ); + ------------------------------------------------------------------------------------------ + type goblin_constant_type is new entity_constant_type with record health_limit : natural := 0; @@ -481,124 +605,34 @@ function xabina return integer is stamina : natural := 0; end record; + ------------------------------------------------------------------------------------------ + player : player_data; + ------------------------------------------------------------------------------------------ + + procedure render_player is + begin + render_character ('@', COLOUR_CYAN, EFFECT_BOLD, screen_height (player.y), screen_width (player.x)); + end render_player; + ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------ -- Gameplay ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------ - procedure action_idle; - - type procedure_pointer is access procedure; - type ascii_range is mod 2 ** 8; - type action_data is array (ascii_range) of procedure_pointer; - - active : boolean := true; - signal : character := ' '; - - action_list : action_data := (others => action_idle'access); - - procedure bind (symbol : character := CANCEL; - action : procedure_pointer := action_idle'access) is - begin - action_list (character'pos (symbol)) := action; - end bind; - - procedure unbind (symbol : character := CANCEL) is - begin - action_list (character'pos (symbol)) := action_idle'access; - end unbind; - - procedure action_idle is begin null; end action_idle; - procedure action_exit is begin active := false; end action_exit; procedure action_move_up is begin player.y := player.y - 1; end action_move_up; procedure action_move_down is begin player.y := player.y + 1; end action_move_down; procedure action_move_left is begin player.x := player.x - 1; end action_move_left; procedure action_move_right is begin player.x := player.x + 1; end action_move_right; ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------ --- Render --- -- Currently constant, gonna use either my xurses library or C bindings. ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- - - type screen_width is mod 120; - type screen_height is mod 40; - - type screen_type is array (screen_height, screen_width) of character; - - screen_symbol : screen_type := (others => (others => CANCEL)); - screen_colour : screen_type := (others => (others => COLOUR_WHITE)); - screen_effect : screen_type := (others => (others => EFFECT_NORMAL)); - - procedure render_screen_delete is begin put (ESCAPE & "[2J"); end render_screen_delete; - procedure render_screen_offset is begin put (ESCAPE & "[H"); end render_screen_offset; - procedure render_cursor_hide is begin put (ESCAPE & "[?25l"); end render_cursor_hide; - procedure render_cursor_show is begin put (ESCAPE & "[?25h"); end render_cursor_show; - procedure render_realignment is begin put (CARRIAGE_RETURN & LINE_FEED); end render_realignment; - - procedure render_character (symbol : character := ' '; - colour : character := COLOUR_WHITE; - effect : character := EFFECT_NORMAL) is - format : string (1 .. 12) := ESCAPE & "[E;3CmS" & ESCAPE & "[0m"; - begin - format (8) := symbol; - format (6) := colour; - format (3) := effect; - put (format); - end render_character; - - procedure render_screen is - begin - render_screen_offset; - for y in screen_height - loop - for x in screen_width - loop - render_character (screen_symbol (y, x), screen_colour (y, x), screen_effect (y, x)); - end loop; - render_realignment; - end loop; - end render_screen; - - procedure insert_character (symbol : character := ' '; - colour : character := COLOUR_WHITE; - effect : character := EFFECT_NORMAL; - y : screen_height := 0; - x : screen_width := 0) is - begin - screen_symbol (y, x) := symbol; - screen_colour (y, x) := colour; - screen_effect (y, x) := effect; - end insert_character; - - procedure insert_map is - symbol : character := ' '; - colour : character := COLOUR_WHITE; - effect : character := EFFECT_NORMAL; - begin - for y in screen_height - loop - for x in screen_width - loop - symbol := map_constant_data (map_variable_data (map_height (y), map_width (x))).symbol; - colour := map_constant_data (map_variable_data (map_height (y), map_width (x))).colour; - effect := map_constant_data (map_variable_data (map_height (y), map_width (x))).effect; - insert_character (symbol, colour, effect, y, x); - end loop; - end loop; - end insert_map; - - procedure insert_player is - begin - insert_character ('@', COLOUR_CYAN, EFFECT_BOLD, screen_height (player.y), screen_width (player.x)); - end insert_player; - ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- -- Main ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------ begin + ------------------------------------------------------------------------------------------ + bind ('q', action_exit'access); bind ('w', action_move_up'access); bind ('s', action_move_down'access); @@ -611,16 +645,20 @@ begin generate_map; + ------------------------------------------------------------------------------------------ + loop exit when active = false; signal := CANCEL; - insert_map; - insert_player; + render_map; + render_player; render_screen; get_immediate (signal); action_list (character'pos (signal)).all; end loop; + ------------------------------------------------------------------------------------------ + render_cursor_show; return 0;