I am starting to be proud of this...
This commit is contained in:
parent
09ff673b61
commit
73a56f8f38
@ -16,13 +16,13 @@ package body action is
|
||||
|
||||
------------------------------------------------------------------------------------------
|
||||
|
||||
procedure bind (symbol : character := core.CANCEL;
|
||||
procedure bind (symbol : character := core.cancel;
|
||||
mimimi : procedure_pointer := game_idle'access) is
|
||||
begin
|
||||
list (character'pos (symbol)) := mimimi;
|
||||
end bind;
|
||||
|
||||
procedure unbind (symbol : character := core.CANCEL) is
|
||||
procedure unbind (symbol : character := core.cancel) is
|
||||
begin
|
||||
list (character'pos (symbol)) := game_idle'access;
|
||||
end unbind;
|
||||
|
||||
@ -12,23 +12,40 @@
|
||||
|
||||
with ada.text_io;
|
||||
|
||||
with core;
|
||||
|
||||
package body screen is
|
||||
package core is
|
||||
|
||||
------------------------------------------------------------------------------------------
|
||||
|
||||
procedure delete is begin ada.text_io.put (core.ESCAPE & "[2J"); end delete;
|
||||
procedure offset is begin ada.text_io.put (core.ESCAPE & "[H"); end offset;
|
||||
procedure hide_cursor is begin ada.text_io.put (core.ESCAPE & "[?25l"); end hide_cursor;
|
||||
procedure show_cursor is begin ada.text_io.put (core.ESCAPE & "[?25h"); end show_cursor;
|
||||
procedure new_line is begin ada.text_io.put (core.CARRIAGE_RETURN & core.LINE_FEED); end new_line;
|
||||
procedure delete is
|
||||
begin
|
||||
ada.text_io.put (escape & "[2J");
|
||||
end delete;
|
||||
|
||||
procedure offset is
|
||||
begin
|
||||
ada.text_io.put (escape & "[H");
|
||||
end offset;
|
||||
|
||||
procedure hide_cursor is
|
||||
begin
|
||||
ada.text_io.put (escape & "[?25l");
|
||||
end hide_cursor;
|
||||
|
||||
procedure show_cursor is
|
||||
begin
|
||||
ada.text_io.put (escape & "[?25h");
|
||||
end show_cursor;
|
||||
|
||||
procedure new_line is
|
||||
begin
|
||||
ada.text_io.put (carriage_return & line_feed);
|
||||
end new_line;
|
||||
|
||||
procedure render_character (symbol : character := ' ';
|
||||
colour : character := core.colour.white;
|
||||
effect : character := core.effect.normal;
|
||||
y : height := 0;
|
||||
x : width := 0) is
|
||||
colour : character := colour.white;
|
||||
effect : character := effect.normal;
|
||||
y : height := 0;
|
||||
x : width := 0) is
|
||||
begin
|
||||
symbol_matrix (y, x) := symbol;
|
||||
colour_matrix (y, x) := colour;
|
||||
@ -36,7 +53,7 @@ package body screen is
|
||||
end render_character;
|
||||
|
||||
procedure render_buffer is
|
||||
format : string (1 .. 12) := core.ESCAPE & "[E;3CmS" & core.ESCAPE & "[0m";
|
||||
format : string (1 .. 12) := escape & "[E;3CmS" & escape & "[0m";
|
||||
begin
|
||||
offset;
|
||||
for y in height
|
||||
@ -54,4 +71,4 @@ package body screen is
|
||||
|
||||
------------------------------------------------------------------------------------------
|
||||
|
||||
end screen;
|
||||
end core;
|
||||
82
main.adb
82
main.adb
@ -12,88 +12,10 @@
|
||||
|
||||
with ada.text_io;
|
||||
|
||||
with core, action, screen, item, magic, ammunition, weapon, armour, plant, animal, monster, player;
|
||||
with core, action, screen, map, item, magic, ammunition, weapon, armour, plant, animal, monster, player;
|
||||
|
||||
function main return integer is
|
||||
|
||||
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_mark is mod 72;
|
||||
type map_width is mod 120;
|
||||
type map_height is mod 40;
|
||||
|
||||
type map_constant_type is new core.entity_constant_type with
|
||||
record
|
||||
collide : boolean := false;
|
||||
condition_limit : natural := 0;
|
||||
end record;
|
||||
|
||||
type map_variable_type is new core.entity_variable_type with
|
||||
record
|
||||
entity : core.entity_list := core.ENTITY_NULL;
|
||||
identifier : natural := 0;
|
||||
end record;
|
||||
|
||||
type map_matrical_type is
|
||||
record
|
||||
map : map_list := MAP_STONE_FLOOR;
|
||||
condition : natural := 0;
|
||||
end record;
|
||||
|
||||
type map_constant_list is array (map_list) of map_constant_type;
|
||||
type map_variable_list is array (map_mark) of map_variable_type;
|
||||
type map_matrical_list is array (map_height, map_width) of map_matrical_type;
|
||||
|
||||
------------------------------------------------------------------------------------------
|
||||
|
||||
map_constant_data : constant map_constant_list := (
|
||||
(core.ENTITY_MAP, "Stone Wall ", '#', core.colour.grey, core.effect.bold, true, 59),
|
||||
(core.ENTITY_MAP, "Wooden Wall ", '#', core.colour.yellow, core.effect.normal, false, 23),
|
||||
(core.ENTITY_MAP, "Stone Floor ", '.', core.colour.grey, core.effect.bold, true, 47),
|
||||
(core.ENTITY_MAP, "Wooden Floor ", '.', core.colour.yellow, core.effect.normal, false, 11),
|
||||
(core.ENTITY_MAP, "Water (shallow) ", '~', core.colour.blue, core.effect.normal, false, 0),
|
||||
(core.ENTITY_MAP, "Water (deep) ", '~', core.colour.blue, core.effect.bold, true, 0),
|
||||
(core.ENTITY_MAP, "Swamp (shallow) ", '~', core.colour.green, core.effect.normal, false, 0),
|
||||
(core.ENTITY_MAP, "Swamp (deep) ", '~', core.colour.green, core.effect.bold, true, 0)
|
||||
);
|
||||
|
||||
map_variable_data : map_variable_list;
|
||||
map_matrical_data : map_matrical_list;
|
||||
|
||||
------------------------------------------------------------------------------------------
|
||||
|
||||
procedure generate_map is
|
||||
begin
|
||||
for y in map_height
|
||||
loop
|
||||
for x in map_width
|
||||
loop
|
||||
map_matrical_data (y, x) := (MAP_WOODEN_FLOOR, map_constant_data (MAP_WOODEN_FLOOR).condition_limit);
|
||||
end loop;
|
||||
end loop;
|
||||
end generate_map;
|
||||
|
||||
procedure render_map is
|
||||
symbol : character := ' ';
|
||||
colour : character := core.colour.white;
|
||||
effect : character := core.effect.normal;
|
||||
begin
|
||||
for y in screen.height
|
||||
loop
|
||||
for x in screen.width
|
||||
loop
|
||||
symbol := map_constant_data (map_matrical_data (map_height (y), map_width (x)).map).symbol;
|
||||
colour := map_constant_data (map_matrical_data (map_height (y), map_width (x)).map).colour;
|
||||
effect := map_constant_data (map_matrical_data (map_height (y), map_width (x)).map).effect;
|
||||
screen.render_character (symbol, colour, effect, y, x);
|
||||
end loop;
|
||||
end loop;
|
||||
end render_map;
|
||||
|
||||
------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
|
||||
-- Player
|
||||
------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
|
||||
@ -251,7 +173,7 @@ begin
|
||||
------------------------------------------------------------------------------------------
|
||||
|
||||
loop
|
||||
action.signal := core.CANCEL;
|
||||
action.signal := core.cancel;
|
||||
render_map;
|
||||
player.render;
|
||||
screen.render_buffer;
|
||||
|
||||
@ -10,39 +10,40 @@
|
||||
-- write a new program in Ada, a tiny game. Work in progress, it's messy and ugly for now...
|
||||
------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
with core;
|
||||
with core, screen;
|
||||
|
||||
package screen is
|
||||
package body map is
|
||||
|
||||
------------------------------------------------------------------------------------------
|
||||
|
||||
type width is mod 120;
|
||||
type height is mod 40;
|
||||
procedure generate is
|
||||
begin
|
||||
for y in height
|
||||
loop
|
||||
for x in width
|
||||
loop
|
||||
map_matrical_data (y, x) := (MAP_WOODEN_FLOOR, map_constant_data (MAP_WOODEN_FLOOR).condition_limit);
|
||||
end loop;
|
||||
end loop;
|
||||
end generate;
|
||||
|
||||
type matrix is array (height, width) of character;
|
||||
procedure render is
|
||||
symbol : character := ' ';
|
||||
colour : character := core.colour.white;
|
||||
effect : character := core.effect.normal;
|
||||
begin
|
||||
for y in screen.height
|
||||
loop
|
||||
for x in screen.width
|
||||
loop
|
||||
symbol := map_constant_data (map_matrical_data (map_height (y), map_width (x)).map).symbol;
|
||||
colour := map_constant_data (map_matrical_data (map_height (y), map_width (x)).map).colour;
|
||||
effect := map_constant_data (map_matrical_data (map_height (y), map_width (x)).map).effect;
|
||||
screen.render_character (symbol, colour, effect, y, x);
|
||||
end loop;
|
||||
end loop;
|
||||
end render;
|
||||
|
||||
------------------------------------------------------------------------------------------
|
||||
|
||||
symbol_matrix : matrix := (others => (others => core.CANCEL));
|
||||
colour_matrix : matrix := (others => (others => core.colour.white));
|
||||
effect_matrix : matrix := (others => (others => core.effect.normal));
|
||||
|
||||
------------------------------------------------------------------------------------------
|
||||
|
||||
procedure delete;
|
||||
procedure offset;
|
||||
procedure hide_cursor;
|
||||
procedure show_cursor;
|
||||
procedure new_line;
|
||||
|
||||
procedure render_character (symbol : character := ' ';
|
||||
colour : character := core.colour.white;
|
||||
effect : character := core.effect.normal;
|
||||
y : height := 0;
|
||||
x : width := 0);
|
||||
|
||||
procedure render_buffer;
|
||||
|
||||
------------------------------------------------------------------------------------------
|
||||
|
||||
end screen;
|
||||
end map;
|
||||
23
player.adb
23
player.adb
@ -23,10 +23,25 @@ package body player is
|
||||
screen.render_character ('@', core.colour.cyan, core.effect.bold, screen.height (data.y), screen.width (data.x));
|
||||
end render;
|
||||
|
||||
procedure move_up is begin player.data.y := player.data.y - 1; end move_up;
|
||||
procedure move_down is begin player.data.y := player.data.y + 1; end move_down;
|
||||
procedure move_left is begin player.data.x := player.data.x - 1; end move_left;
|
||||
procedure move_right is begin player.data.x := player.data.x + 1; end move_right;
|
||||
procedure move_up is
|
||||
begin
|
||||
player.data.y := player.data.y - 1;
|
||||
end move_up;
|
||||
|
||||
procedure move_down is
|
||||
begin
|
||||
player.data.y := player.data.y + 1;
|
||||
end move_down;
|
||||
|
||||
procedure move_left is
|
||||
begin
|
||||
player.data.x := player.data.x - 1;
|
||||
end move_left;
|
||||
|
||||
procedure move_right is
|
||||
begin
|
||||
player.data.x := player.data.x + 1;
|
||||
end move_right;
|
||||
|
||||
------------------------------------------------------------------------------------------
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user