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
2024-02-22 02:48:25 -05:00
--~crop_u, crop_v, crop_width, crop_height : integer;
2024-02-20 12:32:41 -05:00
begin
if x > u + width
or y > v + height
or x < u - data . width
or y < v - data . height then
return ;
end if ;
--
2024-02-22 02:48:25 -05:00
--~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);
2024-02-20 14:02:50 -05:00
--
--~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);
2024-02-20 15:37:22 -05:00
--~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);
2024-02-22 02:48:25 -05:00
--~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);
2024-02-20 12:32:41 -05:00
--
2024-02-22 02:48:25 -05:00
--~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 ) ;
2024-02-20 12:32:41 -05:00
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-23 18:45:22 -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;
--~crop_offset : constant integer := y - ((y + height) mod base) / 2;
--~middle : constant vector_2 := (width / 2 + x, height / 2 + y);
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 ) ;
--~blabla : constant integer := y + height - ((height - base) / 2) mod base;
--~next : integer;
2024-02-18 08:41:23 -05:00
begin
2024-02-23 18:45:22 -05:00
--~for vertical in 0 .. width / base - 1
--~loop
--~line ((offset_x + vertical * base, y), (0, crop_height));
--~end loop;
--~--
--~for horizontal in 0 .. height / base - 1
--~loop
--~line ((x, offset_y + horizontal * base), (width, 0));
--~--
--~for vertical in 0 .. width / base - 1
--~loop
--~line ((offset_x + vertical * base - base / 2, crop_offset + 2 * base * (horizontal / 2) + base), (0, base));
--~line ((offset_x + vertical * base, crop_offset + 2 * base * (horizontal / 2)), (0, base));
--~end loop;
--~end loop;
--~--
--~for vertical in 0 .. width / base - 1
--~loop
--~line ((offset_x + vertical * base, crop_offset + 2 * base * ((height / base) / 2)), (0, crop_height));
--~end loop;
--~--
--~--
--~--
-- upper crop
--~next := middle.x - base / 2; while next > x loop line ((next, y ), (0, ((height + base) / 2) mod base)); next := next - base; end loop;
--~next := middle.x + base / 2; while next < x + width loop line ((next, y ), (0, ((height + base) / 2) mod base)); next := next + base; end loop;
-- horizontal full
for txen in 0 . . repeat . y loop line ( ( x , y + offset . y + txen * base ) , ( width , 0 ) ) ; end loop ;
for txen in 0 . . repeat . x loop line ( ( x + offset . x + txen * base , y ) , ( 0 , height ) ) ; end loop ;
--~next := middle.y - base / 2; while next > y loop line ((x, next ), (width, 0 )); next := next - base; end loop;
--~next := middle.y + base / 2; while next < y + height loop line ((x, next ), (width, 0 )); next := next + base; end loop;
-- middle side
--~next := middle.x - base / 2; while next > x loop line ((next, (height - base) / 2 + y), (0, base )); next := next - base; end loop;
--~next := middle.x + base / 2; while next < x + width loop line ((next, (height - base) / 2 + y), (0, base )); next := next + base; end loop;
-- lower crop
--~next := (width - base) / 2 + x; while next > x loop line ((next, blabla ), (0, ((height + base) / 2) mod base)); next := next - base; end loop;
--~next := (width + base) / 2 + x; while next < x + width loop line ((next, blabla ), (0, ((height + base) / 2) mod base)); next := next + base; end loop;
--~next := (width - base) / 2 + x; while next > x loop line ((x, next), (width, 0)); next := next - base; end loop;
--~next := (width + base) / 2 + x; while next < width loop line ((x, next), (width, 0)); next := next + base; end loop;
2024-02-17 18:13:17 -05:00
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 ;