xolatile/xabina
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Minor refactoring in progress...

Browse Source
This commit is contained in:
Ognjen Milan Robovic 2023-10-11 16:25:59 -04:00
parent 9750d2709c
commit 8d9f40c3e0
1 changed files with 148 additions and 110 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

258
xabina.adb
View File

@ -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 <termios.h> 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;