2024-02-15 21:03:09 -05:00
with core ;
use core ;
package body core is
------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
2024-02-16 05:52:11 -05:00
procedure configure is
begin
engine_configure ;
--
2024-02-16 06:34:45 -05:00
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 ) ;
2024-02-16 05:52:11 -05:00
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 ;
------------------------------------------------------------------------------------------
2024-02-16 06:24:49 -05:00
procedure draw_state_box ( x , y : in integer ) is
begin
2024-02-19 18:01:52 -05:00
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# ) ;
2024-02-16 06:24:49 -05:00
end draw_state_box ;
------------------------------------------------------------------------------------------
2024-02-15 21:03:09 -05:00
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 ;
------------------------------------------------------------------------------------------
2024-02-20 10:26:49 -05:00
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 ;
------------------------------------------------------------------------------------------
2024-02-15 21:03:09 -05:00
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 ;
------------------------------------------------------------------------------------------
2024-02-20 12:32:41 -05:00
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 ;
--
--~if x < u + width - data.width then crop_width := data.width; else crop_width := data.width - (x + data.width) mod (width + u); end if;
--~if x < u + width - data.width then crop_width := data.width; else crop_width := data.width - (x + data.width) mod (width + u); end if;
crop_width := data . width - ( if x < u + width - data . width then 0 else ( x + data . width ) mod ( width + u ) ) ;
crop_height := data . height - ( if y < v + height - data . height then 0 else ( y + data . height ) mod ( height + v ) ) ;
crop_u := 0 ;
crop_v := 0 ;
--~if y + data.height < v + height then crop_height := (if y + data.height < height then data.height else data.height - (y + data.height) mod height); end if;
--~if x + data.width > u then crop_u := (x + data.width) mod u; end if;
--~if y + data.height > v then crop_v := (y + data.height) mod v; end if;
--
render_sprite ( data . index , x , y , crop_u , crop_v , crop_width , crop_height ) ;
end view ;
------------------------------------------------------------------------------------------
2024-02-15 21:03:09 -05:00
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 ;
------------------------------------------------------------------------------------------
2024-02-19 14:21:24 -05:00
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 ;
------------------------------------------------------------------------------------------
2024-02-16 14:58:54 -05:00
procedure write ( text : in string ; x , y : in integer ; colour : in integer := 16 # CCCCCC # ) is
2024-02-15 21:03:09 -05:00
begin
2024-02-16 14:58:54 -05:00
render_string ( c_string ( text ) , x , y , colour , false ) ;
2024-02-15 21:03:09 -05:00
end write ;
------------------------------------------------------------------------------------------
2024-02-19 19:17:43 -05:00
procedure debug ( text : in string ) is
begin
2024-02-19 20:46:07 -05:00
put_line ( "> " & text ) ;
2024-02-19 19:17:43 -05:00
end debug ;
------------------------------------------------------------------------------------------
2024-02-15 21:03:09 -05:00
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 ;
2024-02-17 18:13:17 -05:00
------------------------------------------------------------------------------------------
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
2024-02-18 08:41:23 -05:00
offset_x : constant integer := x + base / 2 + ( width mod base ) / 2 ;
offset_y : constant integer := y + base / 2 + ( height mod base ) / 2 ;
crop_height : constant integer := ( ( height + base ) / 2 ) mod base ;
2024-02-19 15:15:49 -05:00
crop_offset : constant integer := y - ( ( y + height ) mod base ) / 2 ;
2024-02-18 08:41:23 -05:00
begin
2024-02-19 15:15:49 -05:00
for vertical in 0 . . width / base - 1
2024-02-18 08:41:23 -05:00
loop
2024-02-19 14:21:24 -05:00
line ( ( offset_x + vertical * base , y ) , ( 0 , crop_height ) ) ;
2024-02-18 08:41:23 -05:00
end loop ;
--
2024-02-19 15:15:49 -05:00
for horizontal in 0 . . height / base - 1
2024-02-17 18:13:17 -05:00
loop
2024-02-19 14:21:24 -05:00
line ( ( x , offset_y + horizontal * base ) , ( width , 0 ) ) ;
2024-02-17 18:13:17 -05:00
--
2024-02-19 16:20:38 -05:00
for vertical in 0 . . width / base - 1
2024-02-17 18:13:17 -05:00
loop
2024-02-19 15:15:49 -05:00
line ( ( offset_x + vertical * base - base / 2 , crop_offset + 2 * base * ( horizontal / 2 ) + base ) , ( 0 , base ) ) ;
2024-02-19 16:20:38 -05:00
line ( ( offset_x + vertical * base , crop_offset + 2 * base * ( horizontal / 2 ) ) , ( 0 , base ) ) ;
2024-02-17 18:13:17 -05:00
end loop ;
2024-02-18 07:19:28 -05:00
end loop ;
2024-02-19 14:10:00 -05:00
--
2024-02-18 07:19:28 -05:00
for vertical in 0 . . width / base - 1
loop
2024-02-19 15:15:49 -05:00
line ( ( offset_x + vertical * base , crop_offset + 2 * base * ( ( height / base ) / 2 ) ) , ( 0 , crop_height ) ) ;
2024-02-17 18:13:17 -05:00
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 ;
2024-02-15 21:03:09 -05:00
------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
end core ;