245 lines
10 KiB
Ada
245 lines
10 KiB
Ada
with core;
|
|
|
|
use core;
|
|
|
|
package body core is
|
|
|
|
------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure configure is
|
|
begin
|
|
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
|
|
render_string (c_string ("Cursor X :" & integer'image (cursor_x)), x, y + 0, 16#CCCCCC#, false);
|
|
render_string (c_string ("Cursor Y :" & integer'image (cursor_y)), x, y + 32, 16#CCCCCC#, false);
|
|
render_string (c_string ("Cursor Mode :" & integer'image (cursor_mode)), x, y + 64, 16#CCCCCC#, false);
|
|
render_string (c_string ("Signal Code :" & signal_code'image (signal_code'val (signal_mode))), x, y + 96, 16#CCCCCC#, false);
|
|
render_string (c_string ("Camera X :" & integer'image (camera.x)), x, y + 128, 16#CCCCCC#, false);
|
|
render_string (c_string ("Camera Y :" & integer'image (camera.y)), x, y + 160, 16#CCCCCC#, false);
|
|
render_string (c_string ("Global Time :" & integer'image (global_time)), x, y + 192, 16#CCCCCC#, false);
|
|
render_string (c_string ("Gameplay Time :" & integer'image (gameplay_time)), x, y + 224, 16#CCCCCC#, false);
|
|
render_string (c_string ("Animation Time :" & integer'image (animation_time)), x, y + 256, 16#CCCCCC#, false);
|
|
render_string (c_string ("Framerate :" & integer'image (framerate)), x, y + 288, 16#CCCCCC#, false);
|
|
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 sigmoid (value : in boolean) return integer is
|
|
begin
|
|
return (if value then -1 else 1);
|
|
end sigmoid;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
function c_string (ada_string : string) return string is
|
|
begin
|
|
return (ada_string & character'val (0));
|
|
end c_string;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
function load_sprite (file_path : in string; frames, states : in integer) return sprite is
|
|
this : sprite;
|
|
begin
|
|
this.index := import_sprite (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 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 write (text : in string; x, y : in integer; colour : in integer := 16#CCCCCC#) is
|
|
begin
|
|
render_string (c_string (text), x, y, colour, false);
|
|
end write;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
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_x : constant integer := x + base / 2 + (width mod base) / 2;
|
|
offset_y : constant integer := y + base / 2 + (height mod base) / 2;
|
|
line_h : constant integer := height / base - 1;
|
|
line_v1 : constant integer := width / base;
|
|
line_v2 : constant integer := width / base - 1;
|
|
crop_height : constant integer := ((height + base) / 2) mod base;
|
|
full_vector : integer;
|
|
begin
|
|
for vertical in 0 .. line_v2
|
|
loop
|
|
render_vector (offset_x + vertical * base, y, offset_x + vertical * base, y + crop_height);
|
|
--~render_vector (offset_x + vertical * base - base / 2, y, offset_x + vertical * base - base / 2, y + crop_height);
|
|
end loop;
|
|
--
|
|
for horizontal in 0 .. line_h
|
|
loop
|
|
render_vector (x, offset_y + horizontal * base, x + width, offset_y + horizontal * base);
|
|
--
|
|
for vertical in 0 .. line_v1
|
|
loop
|
|
full_vector := y + 2 * base * (horizontal / 2) - ((y + height) mod base) / 2;
|
|
--
|
|
render_vector (offset_x + vertical * base - base / 2, full_vector + base, offset_x + vertical * base - base / 2, full_vector + 2 * base);
|
|
end loop;
|
|
if horizontal > 1 then
|
|
for vertical in 0 .. line_v2
|
|
loop
|
|
full_vector := y + 2 * base * (horizontal / 2) - ((y + height) mod base) / 2;
|
|
--
|
|
render_vector (offset_x + vertical * base, full_vector, offset_x + vertical * base, full_vector + base);
|
|
end loop;
|
|
end if;
|
|
end loop;
|
|
for vertical in 0 .. width / base - 1
|
|
loop
|
|
full_vector := y + 2 * base * ((height / base) / 2) - ((y + height) mod base) / 2;
|
|
--
|
|
render_vector (offset_x + vertical * base, full_vector, offset_x + vertical * base, full_vector + crop_height);
|
|
end loop;
|
|
end draw_squared_grid;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
procedure draw_hexagon_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_hexagon_grid;
|
|
|
|
------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
|
|
|
|
end core;
|