xhads/source/core.adb

167 lines
6.1 KiB
Ada

with core;
use core;
package body core is
------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
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) is
begin
null;
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);
--~u, v : integer;
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
--~u := hexagon_grid_sprite.width * codex'pos (map.terrain) * 4;
--~v := hexagon_grid_sprite.height * map.block (move_x, move_y);
--
draw (use_sprite, x + move_x * hexagon_grid_sprite.width, y + move_y * hexagon_grid_sprite.height);
end loop;
--
--~u := 0;
--~v := hexagon_grid_sprite.height * map.block (width / hexagon_grid_sprite.width, move_y);
--
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
--~u := 0;
--~v := hexagon_grid_sprite.height * map.block (move_x, height / hexagon_grid_sprite.height);
--
crop (use_sprite, x + move_x * hexagon_grid_sprite.width, y + height - crop_height, 0, 0, hexagon_grid_sprite.width, crop_height);
end loop;
--
--~u := 0;
--~v := hexagon_grid_sprite.height * map.block (width / hexagon_grid_sprite.width, height / hexagon_grid_sprite.height);
--
crop (use_sprite, x + width - crop_width, y + height - crop_height, 0, 0, crop_width, crop_height);
--~begin
--~for y in 0 .. window_height / 48
--~loop
--~for x in 0 .. window_width / 32
--~loop
--~draw ((if fill then hexagon_fill_sprite else hexagon_grid_sprite), x * hexagon_grid_sprite.width, y * hexagon_grid_sprite.height);
--~end loop;
--~end loop;
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;
------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
end core;