Cleaned up Ray specification...
This commit is contained in:
parent
c31d319a93
commit
e5b06431bd
@ -77,21 +77,21 @@ package body core is
|
||||
|
||||
function flip_coin return integer is
|
||||
begin
|
||||
return (random_integer (0, 1));
|
||||
return (random (0, 1));
|
||||
end flip_coin;
|
||||
|
||||
------------------------------------------------------------------------------------------
|
||||
|
||||
function roll_dice return integer is
|
||||
begin
|
||||
return (random_integer (1, 6));
|
||||
return (random (1, 6));
|
||||
end roll_dice;
|
||||
|
||||
------------------------------------------------------------------------------------------
|
||||
|
||||
function by_chance (chance : in integer) return integer is
|
||||
begin
|
||||
return (random_integer (0, 100) mod chance);
|
||||
return (random (0, 100) mod chance);
|
||||
end by_chance;
|
||||
|
||||
------------------------------------------------------------------------------------------
|
||||
@ -103,10 +103,10 @@ package body core is
|
||||
|
||||
------------------------------------------------------------------------------------------
|
||||
|
||||
function random_integer (minimum, maximum : in integer) return integer is
|
||||
function random (minimum, maximum : in integer) return integer is
|
||||
begin
|
||||
return ray.get_random (minimum, maximum);
|
||||
end random_integer;
|
||||
end random;
|
||||
|
||||
------------------------------------------------------------------------------------------
|
||||
|
||||
@ -399,28 +399,20 @@ package body core is
|
||||
|
||||
procedure render_sprite (sprite, x, y, u, v, width, height : in integer) is
|
||||
begin
|
||||
--~draw_image (data => texture_array (sprite),
|
||||
--~uv => (float (u), float (v), float (width), float (height)),
|
||||
--~view => (float (x), float (y)),
|
||||
--~tint => (255, 255, 255, 255));
|
||||
ray.megadraw (data => texture_array (sprite),
|
||||
uv => (float (u), float (v), float (width), float (height)),
|
||||
view => (float (x), float (y), float (width) * zoom, float (height) * zoom),
|
||||
origin => (0.0, 0.0),
|
||||
rotate => 0.0,
|
||||
tint => (255, 255, 255, 255));
|
||||
ray.draw_texture (data => texture_array (sprite),
|
||||
uv => (float (u), float (v), float (width), float (height)),
|
||||
view => (float (x), float (y), float (width) * zoom, float (height) * zoom));
|
||||
end render_sprite;
|
||||
|
||||
------------------------------------------------------------------------------------------
|
||||
|
||||
procedure render_string (text : in string; x, y : in integer; colour : in colour_range; index, size, pad : in integer) is
|
||||
begin
|
||||
ray.draw_text (data => font_array (index),
|
||||
text => c_string (text),
|
||||
view => (float ((32 - size) / 2 + x), float ((32 - size) / 2 + y)),
|
||||
size => float (size),
|
||||
pad => float (pad),
|
||||
tint => (255, 255, 255, 255));
|
||||
ray.draw_text (data => font_array (index),
|
||||
text => c_string (text),
|
||||
view => (float ((32 - size) / 2 + x), float ((32 - size) / 2 + y)),
|
||||
scale => float (size),
|
||||
space => float (pad));
|
||||
end render_string;
|
||||
|
||||
------------------------------------------------------------------------------------------
|
||||
|
@ -117,7 +117,7 @@ package core is
|
||||
function by_chance (chance : in integer) return integer;
|
||||
function c_string (ada_string : in string) return string;
|
||||
|
||||
function random_integer (minimum, maximum : in integer) return integer;
|
||||
function random (minimum, maximum : in integer) return integer;
|
||||
|
||||
function clip (value, minimum, maximum : in integer) return integer;
|
||||
|
||||
|
155
source/ray.ads
155
source/ray.ads
@ -2,18 +2,20 @@
|
||||
--
|
||||
-- GNU General Public Licence (version 3 or later)
|
||||
|
||||
with interfaces.c;
|
||||
use interfaces.c;
|
||||
with interfaces.c, system;
|
||||
use interfaces.c, system;
|
||||
|
||||
package ray is
|
||||
|
||||
------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
type color_range is range 0 .. 2 ** 8 - 1;
|
||||
type logical is new boolean;
|
||||
type pointer is access all system.address;
|
||||
|
||||
for logical'size use 32;
|
||||
for color_range'size use 8;
|
||||
type colour_range is range 0 .. 2 ** 8 - 1;
|
||||
type logical is new boolean;
|
||||
|
||||
for logical'size use 32;
|
||||
for colour_range'size use 8;
|
||||
|
||||
type trace_log_level is (
|
||||
log_all, log_trace, log_debug, log_info, log_warning, log_error,
|
||||
@ -25,76 +27,83 @@ package ray is
|
||||
mouse_button_back
|
||||
) with convention => c;
|
||||
|
||||
type vessel is record x, y : float; end record with convention => c_pass_by_copy;
|
||||
type color is record r, g, b, a : color_range; end record with convention => c_pass_by_copy;
|
||||
type rectangle is record x ,y, width, height : float; end record with convention => c_pass_by_copy;
|
||||
type texture is record id : natural; width, height, mipmaps, format : integer; end record with convention => c_pass_by_copy;
|
||||
type font is record base, count, pad : integer; data : texture; r : access rectangle; non : access natural; end record with convention => c_pass_by_copy;
|
||||
type stream is record buffer, processor : access natural; rate, size, channels : natural; end record with convention => c_pass_by_copy;
|
||||
type sound is record data : stream; frame : natural; end record with convention => c_pass_by_copy;
|
||||
--
|
||||
procedure open_window (width, height : integer; title : string) with import => true, convention => c, external_name => "InitWindow";
|
||||
procedure close_window with import => true, convention => c, external_name => "CloseWindow";
|
||||
--
|
||||
type vector is record x, y : float; end record with convention => c_pass_by_copy;
|
||||
type colour is record r, g, b, a : colour_range; end record with convention => c_pass_by_copy;
|
||||
type rectangle is record x ,y, width, height : float; end record with convention => c_pass_by_copy;
|
||||
type texture is record id : natural; width, height, mipmaps, format : integer; end record with convention => c_pass_by_copy;
|
||||
type font is record base, count, pad : integer; data : texture; squares : pointer; glyphs : pointer; end record with convention => c_pass_by_copy;
|
||||
type stream is record buffer, processor : pointer; rate, size, channels : natural; end record with convention => c_pass_by_copy;
|
||||
type sound is record data : stream; frame : natural; end record with convention => c_pass_by_copy;
|
||||
|
||||
no_texture : texture;
|
||||
no_font : font;
|
||||
no_sound : sound;
|
||||
|
||||
procedure open_window (width, height : in integer; title : in string) with import => true, convention => c, external_name => "InitWindow";
|
||||
procedure close_window with import => true, convention => c, external_name => "CloseWindow";
|
||||
|
||||
procedure open_audio_device with import => true, convention => c, external_name => "InitAudioDevice";
|
||||
procedure close_audio_device with import => true, convention => c, external_name => "CloseAudioDevice";
|
||||
--
|
||||
procedure set_exit_key (key : integer) with import => true, convention => c, external_name => "SetExitKey";
|
||||
function exit_key_is_pressed return logical with import => true, convention => c, external_name => "WindowShouldClose";
|
||||
function get_key_pressed return integer with import => true, convention => c, external_name => "GetKeyPressed";
|
||||
function mouse_button_is_pressed (button : mouse_button) return logical with import => true, convention => c, external_name => "IsMouseButtonPressed";
|
||||
function mouse_button_is_released (button : mouse_button) return logical with import => true, convention => c, external_name => "IsMouseButtonReleased";
|
||||
function get_mouse_x return integer with import => true, convention => c, external_name => "GetMouseX";
|
||||
function get_mouse_y return integer with import => true, convention => c, external_name => "GetMouseY";
|
||||
function get_mouse_vessel return vessel with import => true, convention => c, external_name => "GetMousePosition";
|
||||
function get_screen_width return integer with import => true, convention => c, external_name => "GetScreenWidth";
|
||||
function get_screen_height return integer with import => true, convention => c, external_name => "GetScreenHeight";
|
||||
--
|
||||
procedure clear_background (tint : color) with import => true, convention => c, external_name => "ClearBackground";
|
||||
procedure begin_drawing with import => true, convention => c, external_name => "BeginDrawing";
|
||||
procedure end_drawing with import => true, convention => c, external_name => "EndDrawing";
|
||||
--
|
||||
procedure set_target_fps (fps : integer) with import => true, convention => c, external_name => "SetTargetFPS";
|
||||
function get_fps return integer with import => true, convention => c, external_name => "GetFPS";
|
||||
procedure randomization (seed : natural) with import => true, convention => c, external_name => "SetRandomSeed";
|
||||
function get_random (minimum, maximum : integer) return integer with import => true, convention => c, external_name => "GetRandomValue";
|
||||
--
|
||||
procedure take_screenshot (path : string := "screenshot.png") with import => true, convention => c, external_name => "TakeScreenshot";
|
||||
--
|
||||
procedure set_trace_log_level (level : trace_log_level) with import => true, convention => c, external_name => "SetTraceLogLevel";
|
||||
--
|
||||
function load_texture (path : string) return texture with import => true, convention => c, external_name => "LoadTexture";
|
||||
function load_sound (path : string) return sound with import => true, convention => c, external_name => "LoadSound";
|
||||
function load_font (path : string) return font with import => true, convention => c, external_name => "LoadFont";
|
||||
--
|
||||
procedure unload_texture (data : texture) with import => true, convention => c, external_name => "UnloadTexture";
|
||||
procedure unload_sound (data : sound) with import => true, convention => c, external_name => "UnloadSound";
|
||||
procedure unload_font (data : font) with import => true, convention => c, external_name => "UnloadFont";
|
||||
--
|
||||
procedure draw_line (x0, y0, x1, y1 : integer; tint : color) with import => true, convention => c, external_name => "DrawLine";
|
||||
--
|
||||
procedure draw_rectangle (x, y, width, height : integer; tint : color) with import => true, convention => c, external_name => "DrawRectangle";
|
||||
--
|
||||
procedure draw_image (data : texture; uv : rectangle; view : vessel; tint : color) with import => true, convention => c, external_name => "DrawTextureRec";
|
||||
--
|
||||
procedure draw_text (data : font; text : string; view : vessel; size, pad : float; tint : color) with import => true, convention => c, external_name => "DrawTextEx";
|
||||
--
|
||||
procedure play_sound (data : sound) with import => true, convention => c, external_name => "PlaySound";
|
||||
procedure stop_sound (data : sound) with import => true, convention => c, external_name => "StopSound";
|
||||
procedure pause_sound (data : sound) with import => true, convention => c, external_name => "PauseSound";
|
||||
procedure resume_sound (data : sound) with import => true, convention => c, external_name => "ResumeSound";
|
||||
|
||||
procedure megadraw (
|
||||
data : texture;
|
||||
uv : rectangle;
|
||||
view : rectangle;
|
||||
origin : vessel;
|
||||
rotate : float;
|
||||
tint : color
|
||||
) with
|
||||
import => true,
|
||||
convention => c,
|
||||
external_name => "DrawTexturePro";
|
||||
procedure set_exit_key (key : in integer) with import => true, convention => c, external_name => "SetExitKey";
|
||||
function exit_key_is_pressed return logical with import => true, convention => c, external_name => "WindowShouldClose";
|
||||
function get_key_pressed return integer with import => true, convention => c, external_name => "GetKeyPressed";
|
||||
function mouse_button_is_pressed (button : in mouse_button) return logical with import => true, convention => c, external_name => "IsMouseButtonPressed";
|
||||
function mouse_button_is_released (button : in mouse_button) return logical with import => true, convention => c, external_name => "IsMouseButtonReleased";
|
||||
function get_mouse_x return integer with import => true, convention => c, external_name => "GetMouseX";
|
||||
function get_mouse_y return integer with import => true, convention => c, external_name => "GetMouseY";
|
||||
function get_mouse_vector return vector with import => true, convention => c, external_name => "GetMousePosition";
|
||||
function get_screen_width return integer with import => true, convention => c, external_name => "GetScreenWidth";
|
||||
function get_screen_height return integer with import => true, convention => c, external_name => "GetScreenHeight";
|
||||
|
||||
procedure clear_background (tint : in colour) with import => true, convention => c, external_name => "ClearBackground";
|
||||
procedure begin_drawing with import => true, convention => c, external_name => "BeginDrawing";
|
||||
procedure end_drawing with import => true, convention => c, external_name => "EndDrawing";
|
||||
|
||||
procedure set_target_fps (fps : in integer) with import => true, convention => c, external_name => "SetTargetFPS";
|
||||
function get_fps return integer with import => true, convention => c, external_name => "GetFPS";
|
||||
procedure randomization (seed : in natural) with import => true, convention => c, external_name => "SetRandomSeed";
|
||||
function get_random (minimum, maximum : in integer) return integer with import => true, convention => c, external_name => "GetRandomValue";
|
||||
|
||||
procedure take_screenshot (file_path : in string := "screenshot.png") with import => true, convention => c, external_name => "TakeScreenshot";
|
||||
|
||||
procedure set_trace_log_level (level : in trace_log_level) with import => true, convention => c, external_name => "SetTraceLogLevel";
|
||||
|
||||
function load_texture (file_path : in string) return texture with import => true, convention => c, external_name => "LoadTexture";
|
||||
function load_sound (file_path : in string) return sound with import => true, convention => c, external_name => "LoadSound";
|
||||
function load_font (file_path : in string) return font with import => true, convention => c, external_name => "LoadFont";
|
||||
|
||||
procedure unload_texture (data : in texture) with import => true, convention => c, external_name => "UnloadTexture";
|
||||
procedure unload_sound (data : in sound) with import => true, convention => c, external_name => "UnloadSound";
|
||||
procedure unload_font (data : in font) with import => true, convention => c, external_name => "UnloadFont";
|
||||
|
||||
procedure draw_line (x0, y0, x1, y1 : in integer; tint : in colour) with import => true, convention => c, external_name => "DrawLine";
|
||||
procedure draw_rectangle (x, y, width, height : in integer; tint : in colour) with import => true, convention => c, external_name => "DrawRectangle";
|
||||
|
||||
procedure draw_text (
|
||||
data : in font := no_font;
|
||||
text : in string := "--";
|
||||
view : in vector := (0.0, 0.0);
|
||||
origin : in vector := (0.0, 0.0);
|
||||
rotate : in float := 0.0;
|
||||
scale : in float := 0.0;
|
||||
space : in float := 0.0;
|
||||
tint : in colour := (others => 255)
|
||||
) with import => true, convention => c, external_name => "DrawTextPro";
|
||||
|
||||
procedure draw_texture (
|
||||
data : in texture := no_texture;
|
||||
uv : in rectangle := (others => 0.0);
|
||||
view : in rectangle := (others => 0.0);
|
||||
origin : in vector := (0.0, 0.0);
|
||||
rotate : in float := 0.0;
|
||||
tint : in colour := (others => 255)
|
||||
) with import => true, convention => c, external_name => "DrawTexturePro";
|
||||
|
||||
procedure play_sound (data : in sound) with import => true, convention => c, external_name => "PlaySound";
|
||||
procedure stop_sound (data : in sound) with import => true, convention => c, external_name => "StopSound";
|
||||
procedure pause_sound (data : in sound) with import => true, convention => c, external_name => "PauseSound";
|
||||
procedure resume_sound (data : in sound) with import => true, convention => c, external_name => "ResumeSound";
|
||||
|
||||
------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
|
@ -76,29 +76,29 @@ package body world is
|
||||
loop
|
||||
for y in 0 .. height - 1
|
||||
loop
|
||||
map.block (x, y) := core.random_integer (0, 23);
|
||||
map.block (x, y) := core.random (0, 23);
|
||||
end loop;
|
||||
end loop;
|
||||
--
|
||||
for object in 0 .. landmark_limit
|
||||
loop
|
||||
map.landmark (object).index := core.random_integer (0, limit (index) - 1);
|
||||
map.landmark (object).x := core.base * core.random_integer (1, map.width - 1);
|
||||
map.landmark (object).y := core.base * core.random_integer (1, map.height - 1);
|
||||
map.landmark (object).index := core.random (0, limit (index) - 1);
|
||||
map.landmark (object).x := core.base * core.random (1, map.width - 1);
|
||||
map.landmark (object).y := core.base * core.random (1, map.height - 1);
|
||||
end loop;
|
||||
--
|
||||
for object in 0 .. construction_limit
|
||||
loop
|
||||
map.construction (object).index := core.random_integer (0, construction.codex'pos (construction.codex'last));
|
||||
map.construction (object).x := core.base * core.random_integer (1, map.width - 1);
|
||||
map.construction (object).y := core.base * core.random_integer (1, map.height - 1);
|
||||
map.construction (object).index := core.random (0, construction.codex'pos (construction.codex'last));
|
||||
map.construction (object).x := core.base * core.random (1, map.width - 1);
|
||||
map.construction (object).y := core.base * core.random (1, map.height - 1);
|
||||
end loop;
|
||||
--
|
||||
for object in 0 .. item_limit
|
||||
loop
|
||||
map.item (object).index := core.random_integer (0, item.codex'pos (item.codex'last));
|
||||
map.item (object).x := core.base * core.random_integer (1, map.width - 1);
|
||||
map.item (object).y := core.base * core.random_integer (1, map.height - 1);
|
||||
map.item (object).index := core.random (0, item.codex'pos (item.codex'last));
|
||||
map.item (object).x := core.base * core.random (1, map.width - 1);
|
||||
map.item (object).y := core.base * core.random (1, map.height - 1);
|
||||
end loop;
|
||||
--
|
||||
core.echo (core.success, "Finished procedurally generating new map.");
|
||||
|
Loading…
Reference in New Issue
Block a user