622 lines
26 KiB
Ada
622 lines
26 KiB
Ada
-- Copyright (c) 2024 - Ognjen 'xolatile' Milan Robovic
|
|
--
|
|
-- GNU General Public Licence (version 3 or later)
|
|
|
|
package body core is
|
|
|
|
------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
|
|
|
|
type terminal_colour is (
|
|
grey, red, green, yellow, blue, pink,
|
|
cyan, white
|
|
);
|
|
|
|
type terminal_effect is (
|
|
normal, bold, italic, underline, blink, invert
|
|
);
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
type texture_data_array is array (natural range <>) of ray.texture;
|
|
type sound_data_array is array (natural range <>) of ray.sound;
|
|
type font_data_array is array (natural range <>) of ray.font;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
texture_count : integer := 0;
|
|
sound_count : integer := 0;
|
|
font_count : integer := 0;
|
|
|
|
texture_array : access texture_data_array;
|
|
sound_array : access sound_data_array;
|
|
font_array : access font_data_array;
|
|
|
|
game_icon : ray.image;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
procedure terminal (colour : in terminal_colour := white;
|
|
effect : in terminal_effect := normal);
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
function "=" (a, b : in signal_code) return boolean is begin return natural (signal_code'pos (a)) = natural (signal_code'pos (b)); end "=";
|
|
function "=" (a, b : in cursor_code) return boolean is begin return natural (cursor_code'pos (a)) = natural (cursor_code'pos (b)); end "=";
|
|
function "/" (a, b : in signal_code) return boolean is begin return natural (signal_code'pos (a)) /= natural (signal_code'pos (b)); end "/";
|
|
function "/" (a, b : in cursor_code) return boolean is begin return natural (cursor_code'pos (a)) /= natural (cursor_code'pos (b)); end "/";
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
function "+" (a, b : in vector) return vector is begin return (a.x + b.x, a.y + b.y); end "+";
|
|
function "-" (a, b : in vector) return vector is begin return (a.x - b.x, a.y - b.y); end "-";
|
|
function "*" (a, b : in vector) return vector is begin return (a.x * b.x, a.y * b.y); end "*";
|
|
function "/" (a, b : in vector) return vector is begin return (a.x / b.x, a.y / b.y); end "/";
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
function "+" (data : in point; modifier : in natural) return point is
|
|
this : point := data;
|
|
begin
|
|
this.value := (if (this.value + modifier) > this.limit then this.limit else (this.value + modifier));
|
|
--
|
|
return this;
|
|
end "+";
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
function "-" (data : in point; modifier : in natural) return point is
|
|
this : point := data;
|
|
begin
|
|
this.value := (if (this.value - modifier) <= 0 then 0 else (this.value - modifier));
|
|
--
|
|
return this;
|
|
end "-";
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
function "*" (data : in point; modifier : in natural) return point is
|
|
this : point := data;
|
|
begin
|
|
this.value := (if (this.value * modifier) > this.limit then this.limit else (this.value * modifier));
|
|
--
|
|
return this;
|
|
end "*";
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
function "/" (data : in point; modifier : in natural) return point is
|
|
this : point := data;
|
|
begin
|
|
this.value := (if (this.value / modifier) <= 0 then 0 else (this.value / modifier));
|
|
--
|
|
return this;
|
|
end "/";
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
procedure echo (status : in echo_status;
|
|
text : in string) is
|
|
begin
|
|
if not echo_mark (status) then
|
|
return;
|
|
end if;
|
|
--
|
|
put ("[");
|
|
case status is
|
|
when failure => terminal (red, bold); put ("Failure"); terminal;
|
|
when warning => terminal (yellow, bold); put ("Warning"); terminal;
|
|
when success => terminal (green, bold); put ("Success"); terminal;
|
|
when comment => terminal (grey, bold); put ("Comment"); terminal;
|
|
when import => terminal (cyan, bold); put (" <-- "); terminal;
|
|
when export => terminal (blue, bold); put (" --> "); terminal;
|
|
end case;
|
|
put ("] ");
|
|
--
|
|
put_line (text);
|
|
end echo;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
procedure echo_when (condition : in boolean; status : in echo_status; text : in string) is
|
|
begin
|
|
if condition then
|
|
echo (status, text);
|
|
end if;
|
|
end echo_when;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
procedure dash is
|
|
begin
|
|
terminal (grey, bold);
|
|
put ("------------------------------------------------------------------------------------------");
|
|
put ("------------------------------------------------------------------------------------------");
|
|
terminal;
|
|
new_line;
|
|
end dash;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
procedure semi_dash is
|
|
begin
|
|
terminal (grey, bold);
|
|
put (" ");
|
|
put ("------------------------------------------------------------------------------------------");
|
|
terminal;
|
|
new_line;
|
|
end semi_dash;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
function time return float is
|
|
begin
|
|
return float (ray.get_time);
|
|
end time;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
function compress (data : in address; size : in integer; used : out integer) return address is
|
|
begin
|
|
return address (ray.compress (ray.pointer (data), size, used));
|
|
end compress;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
function decompress (data : in address; size : in integer; used : out integer) return address is
|
|
begin
|
|
return address (ray.decompress (ray.pointer (data), size, used));
|
|
end decompress;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
procedure zoom_in is begin core.zoom := 2; end zoom_in;
|
|
procedure zoom_out is begin core.zoom := 1; end zoom_out;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
function c_string (ada_string : string) return string is
|
|
begin
|
|
return (ada_string & terminator);
|
|
end c_string;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
function string_width (data : in string) return natural is
|
|
maximum_width : natural := 0;
|
|
width : natural := 0;
|
|
begin
|
|
for index in data'range loop
|
|
width := width + 1;
|
|
--
|
|
if data (index) = line_feed then
|
|
maximum_width := (if width > maximum_width then width - 1 else maximum_width);
|
|
width := 0;
|
|
end if;
|
|
end loop;
|
|
--
|
|
maximum_width := (if width > maximum_width then width else maximum_width);
|
|
--
|
|
return maximum_width;
|
|
end string_width;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
function string_height (data : in string) return natural is
|
|
height : natural := 0;
|
|
begin
|
|
for index in data'range loop
|
|
if data (index) = line_feed then
|
|
height := height + 1;
|
|
end if;
|
|
end loop;
|
|
--
|
|
return height + 2;
|
|
end string_height;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
function random (minimum, maximum : in integer) return integer is
|
|
begin
|
|
return ray.get_random (minimum, maximum);
|
|
end random;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
procedure clip (value : in out integer; minimum, maximum : in integer) is
|
|
begin
|
|
if value < minimum then value := minimum; end if;
|
|
if value > maximum then value := maximum; end if;
|
|
end clip;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
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 window_width return integer is begin return ray.get_screen_width; end window_width;
|
|
function window_height return integer is begin return ray.get_screen_height; end window_height;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
function center_x (width : in integer) return integer is begin return (window_width - width) / 2; end center_x;
|
|
function center_y (height : in integer) return integer is begin return (window_height - height) / 2; end center_y;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
function cursor_inside (x, y, width, height : in integer) return boolean is
|
|
begin
|
|
return cursor.x > x and cursor.x < x + width and cursor.y > y and cursor.y < y + height;
|
|
end cursor_inside;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
function import_sprite (file_path : in string; frames, states : in integer) return sprite is
|
|
this : sprite;
|
|
begin
|
|
texture_array (texture_count) := ray.load_texture (c_string (file_path));
|
|
--
|
|
texture_count := texture_count + 1;
|
|
this.index := texture_count - 1;
|
|
this.width := texture_array (this.index).width / frames;
|
|
this.height := texture_array (this.index).height / states;
|
|
this.frames := frames;
|
|
this.states := states;
|
|
--
|
|
if this.width = 0 or this.height = 0 then
|
|
echo (warning, "Sprite not imported: " & file_path);
|
|
end if;
|
|
--
|
|
return this;
|
|
end import_sprite;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
function import_font (file_path : in string; scale, space : in integer) return font is
|
|
this : font;
|
|
begin
|
|
font_array (font_count) := ray.load_font (c_string (file_path));
|
|
--
|
|
font_count := font_count + 1;
|
|
this.index := font_count - 1;
|
|
this.scale := scale;
|
|
this.space := space;
|
|
--
|
|
return this;
|
|
end import_font;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
function import_song (file_path : in string) return song is
|
|
this : song;
|
|
begin
|
|
sound_array (sound_count) := ray.load_sound (c_string (file_path));
|
|
--
|
|
sound_count := sound_count + 1;
|
|
this.index := sound_count - 1;
|
|
--
|
|
return this;
|
|
end import_song;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
procedure import_text (data : in out string_box_data; file_path : in string) is
|
|
begin
|
|
data.text := to_unbounded_string (to_ada (ray.load_text (c_string (file_path)).all)) & terminator;
|
|
end import_text;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
procedure create_image (width, height : in integer) is
|
|
begin
|
|
global_image := ray.image_colour (width, height, (0, 0, 0, 255));
|
|
end create_image;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
procedure draw_pixel (x, y : in integer; tint : in colour) is
|
|
new_tint : ray.colour := (ray.colour_range (tint.r), ray.colour_range (tint.g), ray.colour_range (tint.b), ray.colour_range (tint.a));
|
|
begin
|
|
ray.image_pixel (global_image, x, y, new_tint);
|
|
end draw_pixel;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
procedure render_image (data : in sprite; x, y, u, v, width, height : in integer) is
|
|
temporary : ray.image;
|
|
begin
|
|
temporary := ray.image_import (texture_array (data.index));
|
|
--
|
|
ray.image_render (data => global_image,
|
|
copy => temporary,
|
|
from => (float (u), float (v), float (width), float (height)),
|
|
to => (float (x), float (y), float (width), float (height)));
|
|
--
|
|
ray.image_delete (temporary);
|
|
end render_image;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
procedure export_image (file_path : in string) is
|
|
ignore : integer;
|
|
begin
|
|
ignore := ray.image_export (global_image, c_string (file_path));
|
|
--
|
|
ray.image_delete (global_image);
|
|
end export_image;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
procedure draw (data : in sprite := (others => 0);
|
|
x : in integer := 0;
|
|
y : in integer := 0;
|
|
u : in integer := 0;
|
|
v : in integer := 0;
|
|
width : in integer := 0;
|
|
height : in integer := 0;
|
|
ignore : in boolean := false;
|
|
state : in animation := idle;
|
|
factor : in integer := zoom;
|
|
tint : in colour := (others => 255)) is
|
|
new_width : constant float := float ((if width = 0 then data.width else width));
|
|
new_height : constant float := float ((if height = 0 then data.height else height));
|
|
--
|
|
new_tint : ray.colour := (ray.colour_range (tint.r), ray.colour_range (tint.g), ray.colour_range (tint.b), ray.colour_range (tint.a));
|
|
begin
|
|
ray.draw_texture (data => texture_array (data.index),
|
|
uv => (x => float (if ignore then u else (animation_time mod data.frames) * data.width),
|
|
y => float (if ignore then v else (animation'pos (state) mod data.states) * data.height),
|
|
width => new_width,
|
|
height => new_height),
|
|
view => (x => float (x),
|
|
y => float (y),
|
|
width => new_width * float (factor),
|
|
height => new_height * float (factor)),
|
|
tint => new_tint);
|
|
end draw;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
procedure draw_horizontally (data : in sprite; x, y, width, factor : in integer; tint : in colour := (others => 255)) is
|
|
begin
|
|
for move in 0 .. width / data.width - 1 loop
|
|
draw (data, x + move * data.width, y, tint => tint, factor => factor);
|
|
end loop;
|
|
--
|
|
if width mod data.width > 0 then
|
|
draw (data, x + (width / data.width) * data.width, y, 0, 0, width mod data.width, data.height, tint => tint, factor => factor);
|
|
end if;
|
|
end draw_horizontally;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
procedure draw_vertically (data : in sprite; x, y, height, factor : in integer; tint : in colour := (others => 255)) is
|
|
begin
|
|
for move in 0 .. height / data.height - 1 loop
|
|
draw (data, x, y + move * data.height, tint => tint, factor => factor);
|
|
end loop;
|
|
--
|
|
if height mod data.height > 0 then
|
|
draw (data, x, y + (height / data.height) * data.height, 0, 0, data.width, height mod data.height, tint => tint, factor => factor);
|
|
end if;
|
|
end draw_vertically;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
procedure write (text : in string := "";
|
|
x : in integer := 0;
|
|
y : in integer := 0;
|
|
tint : in colour := (others => 255);
|
|
size : in integer := 0;
|
|
data : in font := (others => 0)) is
|
|
new_tint : ray.colour := (ray.colour_range (tint.r), ray.colour_range (tint.g), ray.colour_range (tint.b), ray.colour_range (tint.a));
|
|
begin
|
|
ray.draw_text (data => font_array (data.index),
|
|
text => c_string (text),
|
|
view => (float (x), float (y)),
|
|
scale => (if size = 0 then float (font_array (data.index).base) else float (size)),
|
|
space => float (font_array (data.index).pad),
|
|
tint => new_tint);
|
|
end write;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
procedure play (index : in integer) is begin ray.play_sound (sound_array (index)); end play;
|
|
procedure stop (index : in integer) is begin ray.stop_sound (sound_array (index)); end stop;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
procedure overlay is
|
|
begin
|
|
ray.draw_rectangle (0, 0, window_width, window_height, (0, 0, 0, 127));
|
|
end overlay;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
function read_help_box return string is begin return to_string (help_box.text); end read_help_box;
|
|
|
|
procedure write_help_box (text : in string) is begin help_box.text := to_unbounded_string (text); end write_help_box;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
procedure save_point (here : in io.file_type; data : in point) is
|
|
begin
|
|
core.io.write (here, data.value);
|
|
core.io.write (here, data.limit);
|
|
end save_point;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
procedure load_point (here : in core.io.file_type; data : out point) is
|
|
begin
|
|
core.io.read (here, data.value);
|
|
core.io.read (here, data.limit);
|
|
end load_point;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
procedure increment (value : in out integer; super : in natural := 1) is begin value := value + super; end increment;
|
|
procedure decrement (value : in out integer; super : in natural := 1) is begin value := value - super; end decrement;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
procedure idle_skip is null;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
procedure toggle_fullscreen is
|
|
begin
|
|
ray.toggle_fullscreen;
|
|
end toggle_fullscreen;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
procedure initialize is
|
|
begin
|
|
echo (comment, "Initializing core components...");
|
|
--
|
|
engine_active := true;
|
|
texture_array := new texture_data_array (0 .. 1600);
|
|
sound_array := new sound_data_array (0 .. 4);
|
|
font_array := new font_data_array (0 .. 16);
|
|
--
|
|
echo (comment, "-- Setting trace log level to none (ignoring all default Raylib logs).");
|
|
ray.set_trace_log_level (ray.log_none);
|
|
--
|
|
ray.set_window_flags (ray.flag_window_resizable);
|
|
--
|
|
echo (comment, "-- Initializing Raylib window data...");
|
|
echo (comment, "-- -- Window title : Xorana");
|
|
echo (comment, "-- -- Window width : 1800");
|
|
echo (comment, "-- -- Window height : 900");
|
|
--
|
|
ray.open_window (1800, 900, c_string ("Xorana"));
|
|
ray.hide_cursor;
|
|
--
|
|
ray.set_window_minimal_size (640, 480);
|
|
ray.set_window_maximal_size (3840, 2160);
|
|
--
|
|
echo (comment, "-- Initializing Raylib audio device data...");
|
|
--~ray.open_audio_device;
|
|
--
|
|
game_icon := ray.load_image (c_string (folder & "/ui/game_icon.png"));
|
|
--
|
|
ray.window_icon (game_icon);
|
|
--
|
|
--ray.randomization (19970725);
|
|
ray.set_target_fps (60);
|
|
--
|
|
echo (success, "Initialized core components.");
|
|
end initialize;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
procedure deinitialize is
|
|
begin
|
|
echo (comment, "Deinitializing core components...");
|
|
--
|
|
engine_active := false;
|
|
--
|
|
echo (comment, "-- -- Unloading Raylib" & texture_count'image & " textures.");
|
|
echo (comment, "-- -- Unloading Raylib" & sound_count'image & " sounds.");
|
|
echo (comment, "-- -- Unloading Raylib" & font_count'image & " fonts.");
|
|
--
|
|
for index in 0 .. texture_count - 1 loop ray.unload_texture (texture_array (index)); end loop;
|
|
for index in 0 .. sound_count - 1 loop ray.unload_sound (sound_array (index)); end loop;
|
|
for index in 0 .. font_count - 1 loop ray.unload_font (font_array (index)); end loop;
|
|
--
|
|
echo (comment, "-- Deinitializing Raylib audio device data...");
|
|
--~ray.close_audio_device;
|
|
--
|
|
ray.unload_image (game_icon);
|
|
--
|
|
echo (comment, "-- Deinitializing Raylib window data...");
|
|
ray.close_window;
|
|
ray.show_cursor;
|
|
--
|
|
echo (success, "Deinitialized core components.");
|
|
end deinitialize;
|
|
|
|
------------------------------------------------------------------------------------------
|
|
|
|
procedure synchronize is
|
|
signal : integer := signal_code'pos (signal_none);
|
|
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);
|
|
framerate := integer (ray.get_fps);
|
|
signal := ray.get_key_pressed;
|
|
cursor.x := ray.get_mouse_x;
|
|
cursor.y := ray.get_mouse_y;
|
|
wheel := wheel + ray.mouse_wheel_move;
|
|
end_turn := false;
|
|
--
|
|
ray.end_drawing;
|
|
--
|
|
if ray.exit_key_is_pressed then
|
|
engine_active := false;
|
|
end if;
|
|
--
|
|
if ray.mouse_button_is_pressed (ray.mouse_button_left) then cursor_mode := cursor_left; end if;
|
|
if ray.mouse_button_is_pressed (ray.mouse_button_right) then cursor_mode := cursor_right; end if;
|
|
if ray.mouse_button_is_pressed (ray.mouse_button_middle) then cursor_mode := cursor_middle; end if;
|
|
if ray.mouse_button_is_released (ray.mouse_button_left) then cursor_mode := cursor_none; end if;
|
|
if ray.mouse_button_is_released (ray.mouse_button_right) then cursor_mode := cursor_none; end if;
|
|
if ray.mouse_button_is_released (ray.mouse_button_middle) then cursor_mode := cursor_none; end if;
|
|
--
|
|
case signal is
|
|
when 48 .. 57 => signal_mode := signal_code'val (signal - 48 + signal_code'pos (signal_0));
|
|
when 65 .. 90 => signal_mode := signal_code'val (signal - 65 + signal_code'pos (signal_a));
|
|
when 290 .. 301 => signal_mode := signal_code'val (signal - 290 + signal_code'pos (signal_f1));
|
|
when 320 .. 329 => signal_mode := signal_code'val (signal - 320 + signal_code'pos (signal_kp_0));
|
|
--
|
|
when 0 => signal_mode := signal_none;
|
|
when 32 => signal_mode := signal_space;
|
|
when 96 => signal_mode := signal_grave;
|
|
when 340 => signal_mode := signal_left_shift;
|
|
when 341 => signal_mode := signal_left_control;
|
|
when 333 => signal_mode := signal_kp_subtract;
|
|
when 334 => signal_mode := signal_kp_add;
|
|
when 256 => signal_mode := signal_escape;
|
|
when 257 => signal_mode := signal_enter;
|
|
when 258 => signal_mode := signal_tab;
|
|
when 259 => signal_mode := signal_backspace;
|
|
when 262 => signal_mode := signal_right;
|
|
when 263 => signal_mode := signal_left;
|
|
when 264 => signal_mode := signal_down;
|
|
when 265 => signal_mode := signal_up;
|
|
when others => signal_mode := signal_none;
|
|
end case;
|
|
--
|
|
ray.begin_drawing;
|
|
--
|
|
ray.clear_background ((0, 0, 0, 255));
|
|
end synchronize;
|
|
|
|
------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
|
|
|
|
procedure terminal (colour : in terminal_colour := white;
|
|
effect : in terminal_effect := normal) is
|
|
format : string := character'val (27) & "[" & character'val (terminal_effect'pos (effect) + 48) & ";3" & character'val (terminal_colour'pos (colour) + 48) & "m";
|
|
begin
|
|
put (format);
|
|
end terminal;
|
|
|
|
------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
|
|
|
|
end core;
|