379 lines
16 KiB
Ada
379 lines
16 KiB
Ada
with core;
|
|
|
|
use core;
|
|
|
|
package body core is
|
|
|
|
------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure terminal (colour : in terminal_colour := white; effect : in terminal_effect := normal) is
|
|
format : string := character'val (27) & "[" & character'val (terminal_effect'pos (effect) + 48) & ";3" & character'val (terminal_colour'pos (colour) + 48) & "m";
|
|
begin
|
|
put (format);
|
|
end terminal;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
procedure echo (status : in echo_status; message : in string) is
|
|
begin
|
|
put ("[");
|
|
--
|
|
case status is
|
|
when failure => terminal (red, bold); put ("Failure"); terminal;
|
|
when warning => terminal (yellow, bold); put ("Warning"); terminal;
|
|
when success => terminal (green, bold); put ("Success"); terminal;
|
|
when comment => terminal (grey, bold); put ("Comment"); terminal;
|
|
end case;
|
|
--
|
|
put_line ("] " & message);
|
|
end echo;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
procedure dash is
|
|
begin
|
|
terminal (grey, bold);
|
|
put ("------------------------------------------------------------------------------------------");
|
|
put ("------------------------------------------------------------------------------------------");
|
|
terminal;
|
|
new_line;
|
|
end dash;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
procedure semi_dash is
|
|
begin
|
|
terminal (grey, bold);
|
|
put (" ");
|
|
put ("------------------------------------------------------------------------------------------");
|
|
terminal;
|
|
new_line;
|
|
end semi_dash;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
procedure configure is
|
|
begin
|
|
echo (comment, "Configuring core game engine components...");
|
|
--
|
|
engine_configure;
|
|
--
|
|
hexagon_grid_sprite := load_sprite ("./sprite/ui/hexagon_grid_tile.png", 1, 1);
|
|
hexagon_fill_sprite := load_sprite ("./sprite/ui/hexagon_fill_tile.png", 1, 1);
|
|
end configure;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
procedure synchronize is
|
|
begin
|
|
global_time := global_time + 1;
|
|
--
|
|
global_time := global_time mod (gameplay_framerate * animation_framerate);
|
|
gameplay_time := global_time mod (gameplay_framerate);
|
|
animation_time := global_time / (gameplay_framerate / animation_framerate);
|
|
--
|
|
engine_synchronize;
|
|
end synchronize;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
procedure draw_state_box (x, y : in integer) is
|
|
begin
|
|
write ("Cursor X :" & integer'image (cursor_x), x, y + 0, 16#CCCCCC#);
|
|
write ("Cursor Y :" & integer'image (cursor_y), x, y + 32, 16#CCCCCC#);
|
|
write ("Cursor Mode :" & integer'image (cursor_mode), x, y + 64, 16#CCCCCC#);
|
|
write ("Signal Code :" & signal_code'image (signal_code'val (signal_mode)), x, y + 96, 16#CCCCCC#);
|
|
write ("Camera X :" & integer'image (camera.x), x, y + 128, 16#CCCCCC#);
|
|
write ("Camera Y :" & integer'image (camera.y), x, y + 160, 16#CCCCCC#);
|
|
write ("Global Time :" & integer'image (global_time), x, y + 192, 16#CCCCCC#);
|
|
write ("Gameplay Time :" & integer'image (gameplay_time), x, y + 224, 16#CCCCCC#);
|
|
write ("Animation Time :" & integer'image (animation_time), x, y + 256, 16#CCCCCC#);
|
|
write ("Framerate :" & integer'image (framerate), x, y + 288, 16#CCCCCC#);
|
|
end draw_state_box;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
function flip_coin return integer is
|
|
begin
|
|
return (random_integer (0, 1));
|
|
end flip_coin;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
function roll_dice return integer is
|
|
begin
|
|
return (random_integer (1, 6));
|
|
end roll_dice;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
function by_chance (chance : in integer) return integer is
|
|
begin
|
|
return (random_integer (0, 100) mod chance);
|
|
end by_chance;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
function c_string (ada_string : string) return string is
|
|
begin
|
|
return (ada_string & character'val (0));
|
|
end c_string;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
function clip (value, minimum, maximum : in integer) return integer is
|
|
begin
|
|
if value < minimum then return minimum; end if;
|
|
if value > maximum then return maximum; end if;
|
|
return value;
|
|
end clip;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
function load_sprite (file_path : in string; frames, states : in integer) return sprite is
|
|
this : sprite;
|
|
begin
|
|
this.index := import_texture (c_string (file_path));
|
|
this.width := sprite_width (this.index) / states;
|
|
this.height := sprite_height (this.index) / frames;
|
|
this.frames := frames;
|
|
this.states := states;
|
|
--
|
|
return this;
|
|
end load_sprite;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
procedure crop (data : in sprite; x, y, u, v, width, height : in integer) is
|
|
begin
|
|
render_sprite (data.index, x, y, u, v, width, height);
|
|
end crop;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
procedure view (data : in sprite; x, y, u, v, width, height : in integer) is
|
|
--~crop_u, crop_v, crop_width, crop_height : integer;
|
|
begin
|
|
if x > u + width
|
|
or y > v + height
|
|
or x < u - data.width
|
|
or y < v - data.height then
|
|
return;
|
|
end if;
|
|
--
|
|
--~crop_width := data.width - (if x + data.width > u + width then (x + data.width) mod (u + width) else 0);
|
|
--~crop_height := data.height - (if y + data.height > v + height then (y + data.height) mod (v + height) else 0);
|
|
--
|
|
--~crop_u := (if x < u then data.width - u mod (x + data.width) else 0);
|
|
--~crop_v := (if y < v then data.height - v mod (y + data.height) else 0);
|
|
--~crop_u := (if x < u and x < u - data.width then data.width - (x + data.width) mod u else 0);
|
|
--~crop_v := (if y < v and y < v - data.height then data.height - (y + data.height) mod v else 0);
|
|
--~crop_u := data.width - (if x < u then (x + data.width) mod u else 0);
|
|
--~crop_v := data.height - (if y < v then (y + data.height) mod v else 0);
|
|
--~crop_u := data.width - (if x < u then u mod x else 0);
|
|
--~crop_v := data.height - (if y < v then v mod y else 0);
|
|
--
|
|
--~render_sprite (data.index, x, y, crop_u, crop_v, crop_width, crop_height);
|
|
render_sprite (data.index, x, y, 0, 0, data.width, data.height);
|
|
end view;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
procedure draw (data : in sprite; x, y : in integer) is
|
|
begin
|
|
render_sprite (data.index, x, y, 0, 0, data.width, data.height);
|
|
end draw;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
procedure move (data : in sprite; x, y, frame, state : in integer) is
|
|
begin
|
|
render_sprite (data.index, x, y, state * data.width, (animation_time mod frame) * data.height, data.width, data.height);
|
|
end move;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
procedure line (origin, offset : in vector_2) is
|
|
begin
|
|
render_vector (origin.x, origin.y, origin.x + offset.x, origin.y + offset.y);
|
|
end line;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
procedure write (text : in string; x, y : in integer; colour : in integer := 16#A37A28#) is
|
|
begin
|
|
render_string (c_string (text), x, y, colour, 0);
|
|
end write;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
procedure debug (text : in string) is
|
|
begin
|
|
put_line ("> " & text);
|
|
end debug;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
procedure hexagonal_grid (x, y, width, height : in integer; fill : in boolean) is
|
|
crop_width : constant integer := width mod hexagon_grid_sprite.width;
|
|
crop_height : constant integer := height mod hexagon_grid_sprite.height;
|
|
use_sprite : constant sprite := (if fill then hexagon_fill_sprite else hexagon_grid_sprite);
|
|
begin
|
|
for move_y in 0 .. height / hexagon_grid_sprite.height - 1
|
|
loop
|
|
for move_x in 0 .. width / hexagon_grid_sprite.width - 1
|
|
loop
|
|
draw (use_sprite, x + move_x * hexagon_grid_sprite.width, y + move_y * hexagon_grid_sprite.height);
|
|
end loop;
|
|
--
|
|
crop (use_sprite, x + width - crop_width, y + move_y * hexagon_grid_sprite.height, 0, 0, crop_width, hexagon_grid_sprite.height);
|
|
end loop;
|
|
--
|
|
for move_x in 0 .. width / hexagon_grid_sprite.width - 1
|
|
loop
|
|
crop (use_sprite, x + move_x * hexagon_grid_sprite.width, y + height - crop_height, 0, 0, hexagon_grid_sprite.width, crop_height);
|
|
end loop;
|
|
--
|
|
crop (use_sprite, x + width - crop_width, y + height - crop_height, 0, 0, crop_width, crop_height);
|
|
end hexagonal_grid;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
function lowercase (text : in string) return string is
|
|
result : string (1 .. text'length);
|
|
begin
|
|
for index in text'range
|
|
loop
|
|
if text (index) in 'A' .. 'Z' then
|
|
result (index) := character'val (character'pos (text (index)) + 32);
|
|
else
|
|
result (index) := text (index);
|
|
end if;
|
|
end loop;
|
|
--
|
|
return result;
|
|
end lowercase;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
function uppercase (text : in string) return string is
|
|
result : string (1 .. text'length);
|
|
begin
|
|
for index in text'range
|
|
loop
|
|
if text (index) in 'a' .. 'z' then
|
|
result (index) := character'val (character'pos (text (index)) - 32);
|
|
else
|
|
result (index) := text (index);
|
|
end if;
|
|
end loop;
|
|
--
|
|
return result;
|
|
end uppercase;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
procedure draw_central_grid (x, y, width, height : in integer) is
|
|
begin
|
|
render_vector (width / 2 + x, y, width / 2 + x, height + y);
|
|
render_vector ( x, height / 2 + y, width + x, height / 2 + y);
|
|
end draw_central_grid;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
procedure draw_squared_grid (x, y, width, height : in integer) is
|
|
offset : constant vector_2 := (((width - base) / 2) mod base, ((height - base) / 2) mod base);
|
|
repeat : constant vector_2 := (2 * (((width - base) / 2) / base) + 1, 2 * (((height - base) / 2) / base) + 1);
|
|
begin
|
|
for next in 0 .. repeat.y
|
|
loop
|
|
line ((x, y + offset.y + next * base), (width, 0));
|
|
end loop;
|
|
--
|
|
if repeat.y mod 4 = 1 then
|
|
for next in 0 .. repeat.x - 1 loop line ((x + offset.x + base / 2 + next * base, y ), (0, offset.y)); end loop;
|
|
for next in 0 .. repeat.x - 1 loop line ((x + offset.x + base / 2 + next * base, y + height - offset.y), (0, offset.y)); end loop;
|
|
--
|
|
for step in 0 .. repeat.y / 2 - 1 loop
|
|
for next in 0 .. repeat.x - 1 loop line ((x + offset.x + base / 2 + next * base, y + base + offset.y + 2 * step * base), (0, base)); end loop;
|
|
end loop;
|
|
for step in 0 .. repeat.y / 2 loop
|
|
for next in 0 .. repeat.x loop line ((x + offset.x + next * base, y + offset.y + 2 * step * base), (0, base)); end loop;
|
|
end loop;
|
|
else
|
|
for next in 0 .. repeat.x - 1 loop line ((x + offset.x + next * base, y ), (0, offset.y)); end loop;
|
|
for next in 0 .. repeat.x - 1 loop line ((x + offset.x + next * base, y + height - offset.y), (0, offset.y)); end loop;
|
|
--
|
|
for step in 0 .. repeat.y / 2 - 1 loop
|
|
for next in 0 .. repeat.x loop line ((x + offset.x + next * base, y + base + offset.y + 2 * step * base), (0, base)); end loop;
|
|
end loop;
|
|
for step in 0 .. repeat.y / 2 loop
|
|
for next in 0 .. repeat.x - 1 loop line ((x + offset.x + base / 2 + next * base, y + offset.y + 2 * step * base), (0, base)); end loop;
|
|
end loop;
|
|
end if;
|
|
end draw_squared_grid;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
procedure draw_hexagon_grid (x, y, width, height : in integer) is
|
|
offset : constant vector_2 := (((width - base) / 2) mod base, ((height - base) / 2) mod base);
|
|
repeat : constant vector_2 := (2 * (((width - base) / 2) / base) + 1, 2 * (((height - base) / 2) / base) + 1);
|
|
begin
|
|
for step in 0 .. repeat.y
|
|
loop
|
|
if step mod 2 = 1 then
|
|
for next in 0 .. repeat.x - 1
|
|
loop
|
|
line ((x + offset.x + base / 2 + next * base, y + offset.y + step * base + base / 4), (-base / 2, -base / 2));
|
|
line ((x + offset.x + base / 2 + next * base, y + offset.y + step * base + base / 4), ( base / 2, -base / 2));
|
|
end loop;
|
|
else
|
|
for next in 0 .. repeat.x - 1
|
|
loop
|
|
line ((x + offset.x + base / 2 + next * base, y + offset.y + step * base - base / 4), (-base / 2, base / 2));
|
|
line ((x + offset.x + base / 2 + next * base, y + offset.y + step * base - base / 4), ( base / 2, base / 2));
|
|
end loop;
|
|
end if;
|
|
end loop;
|
|
--
|
|
if repeat.y mod 4 = 1 then
|
|
for next in 0 .. repeat.x - 1 loop line ((x + offset.x + base / 2 + next * base, y ), (0, offset.y - base / 4)); end loop;
|
|
for next in 0 .. repeat.x - 1 loop line ((x + offset.x + base / 2 + next * base, y + base / 4 + height - offset.y), (0, offset.y - base / 4)); end loop;
|
|
--
|
|
for step in 0 .. repeat.y / 2 - 1 loop
|
|
for next in 0 .. repeat.x - 1 loop line ((x + offset.x + base / 2 + next * base, y + 5 * base / 4 + offset.y + 2 * step * base), (0, base / 2)); end loop;
|
|
end loop;
|
|
for step in 0 .. repeat.y / 2 loop
|
|
for next in 0 .. repeat.x loop line ((x + offset.x + next * base, y + base / 4 + offset.y + 2 * step * base), (0, base / 2)); end loop;
|
|
end loop;
|
|
else
|
|
for next in 0 .. repeat.x - 1 loop line ((x + offset.x + next * base, y ), (0, offset.y)); end loop;
|
|
for next in 0 .. repeat.x - 1 loop line ((x + offset.x + next * base, y + height - offset.y), (0, offset.y)); end loop;
|
|
--
|
|
for step in 0 .. repeat.y / 2 - 1 loop
|
|
for next in 0 .. repeat.x loop line ((x + offset.x + next * base, y + 5 * base / 4 + offset.y + 2 * step * base), (0, base / 2)); end loop;
|
|
end loop;
|
|
for step in 0 .. repeat.y / 2 loop
|
|
for next in 0 .. repeat.x - 1 loop line ((x + offset.x + base / 2 + next * base, y + base / 4 + offset.y + 2 * step * base), (0, base / 2)); end loop;
|
|
end loop;
|
|
end if;
|
|
end draw_hexagon_grid;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
function read_text_box return string is
|
|
begin
|
|
return to_string (text_box.data);
|
|
end read_text_box;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
procedure write_text_box (text : in string) is
|
|
begin
|
|
text_box.data := to_unbounded_string (text);
|
|
end write_text_box;
|
|
|
|
------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
|
|
|
|
end core;
|