xhads/source/core.adb

358 lines
14 KiB
Ada
Raw Normal View History

-- Copyright (c) 2024 - Ognjen 'xolatile' Milan Robovic
--
-- GNU General Public Licence (version 3 or later)
2024-04-25 09:26:08 -04:00
with core, ray;
2024-02-15 21:03:09 -05:00
2024-04-25 09:26:08 -04:00
package body core is
2024-04-25 04:14:45 -04:00
------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
type terminal_colour is (
grey, red, green, yellow, blue, pink,
cyan, white
);
type terminal_effect is (
normal, bold, italic, underline, blink, invert
);
------------------------------------------------------------------------------------------
2024-04-26 10:33:17 -04:00
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;
------------------------------------------------------------------------------------------
procedure terminal (colour : in terminal_colour := white;
effect : in terminal_effect := normal) is
2024-03-11 08:42:25 -04:00
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;
------------------------------------------------------------------------------------------
procedure echo (status : in echo_status;
text : in string) is
2024-03-11 08:42:25 -04:00
begin
2024-03-21 19:03:15 -04:00
if not echo_mark (status) then
return;
end if;
2024-03-11 08:42:25 -04:00
--
put ("[");
2024-03-11 08:42:25 -04:00
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);
2024-03-11 08:42:25 -04:00
end echo;
------------------------------------------------------------------------------------------
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;
------------------------------------------------------------------------------------------
2024-02-15 21:03:09 -05:00
function c_string (ada_string : string) return string is
begin
return (ada_string & character'val (0));
end c_string;
------------------------------------------------------------------------------------------
2024-04-26 11:05:19 -04:00
function random (minimum, maximum : in integer) return integer is
begin
2024-04-26 10:33:17 -04:00
return ray.get_random (minimum, maximum);
2024-04-26 11:05:19 -04:00
end random;
------------------------------------------------------------------------------------------
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;
------------------------------------------------------------------------------------------
function import_sprite (file_path : in string; frames, states : in integer) return sprite is
2024-02-15 21:03:09 -05:00
this : sprite;
begin
2024-04-26 10:33:17 -04:00
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;
2024-02-15 21:03:09 -05:00
--
if this.width = 0 or this.height = 0 then
echo (failure, "Sprite not imported: " & file_path);
else
echo (import, this.index'image & file_path & this.frames'image & this.states'image & this.width'image & this.height'image);
end if;
--
2024-02-15 21:03:09 -05:00
return this;
end import_sprite;
2024-02-15 21:03:09 -05:00
------------------------------------------------------------------------------------------
function import_font (file_path : in string; scale, space : in integer) return font is
this : font;
begin
2024-04-26 10:33:17 -04:00
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;
2024-02-15 21:03:09 -05:00
------------------------------------------------------------------------------------------
function import_song (file_path : in string) return song is
this : song;
2024-02-20 12:32:41 -05:00
begin
sound_array (sound_count) := ray.load_sound (c_string (file_path));
--
sound_count := sound_count + 1;
this.index := sound_count - 1;
2024-02-20 12:32:41 -05:00
--
return this;
end import_song;
2024-02-20 12:32:41 -05:00
------------------------------------------------------------------------------------------
procedure draw (data : in sprite;
x : in integer := 0;
y : in integer := 0;
u : in integer := 0;
v : in integer := 0;
width : in integer := 0;
height : in integer := 0;
state : in integer := 0) is
resize : vector := (0, 0);
2024-02-15 21:03:09 -05:00
begin
resize.x := (if width = 0 then data.width else width);
resize.y := (if height = 0 then data.height else height);
--
ray.draw_texture (data => texture_array (data.index),
uv => (float (if u = 0 then (animation_time mod data.frames) * data.width else u), float (v), float (resize.x), float (resize.y)),
view => (float (x), float (y), float (resize.x) * float (zoom), float (resize.y) * float (zoom)));
2024-02-15 21:03:09 -05:00
end draw;
------------------------------------------------------------------------------------------
procedure write (text : in string := "";
x : in integer := 0;
y : in integer := 0;
data : in font) is
begin
ray.draw_text (data => font_array (data.index),
text => c_string (text),
view => (float ((icon - data.scale) / 2 + x), float ((icon - data.scale) / 2 + y)),
scale => float (data.scale),
space => float (data.space));
2024-02-15 21:03:09 -05:00
end write;
------------------------------------------------------------------------------------------
function lowercase (text : in string) return string is
result : string (1 .. text'length);
begin
for index in text'range loop
2024-02-15 21:03:09 -05:00
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 read_text_box return string is
begin
return to_string (text_box.data);
end read_text_box;
------------------------------------------------------------------------------------------
procedure write_text_box (text : in string) is
begin
text_box.data := to_unbounded_string (text);
end write_text_box;
------------------------------------------------------------------------------------------
2024-04-26 10:33:17 -04:00
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;
------------------------------------------------------------------------------------------
2024-03-24 07:46:56 -04:00
procedure initialize is
begin
2024-04-26 10:33:17 -04:00
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 .. 4);
--
echo (comment, "-- Setting trace log level to none (ignoring all default Raylib logs).");
2024-04-26 10:33:17 -04:00
ray.set_trace_log_level (ray.log_none);
echo (comment, "-- Initializing Raylib window data...");
echo (comment, "-- -- Window title : Chads of Might & Magic");
echo (comment, "-- -- Window width : 1800");
echo (comment, "-- -- Window height : 900");
2024-04-26 10:33:17 -04:00
ray.open_window (1800, 900, "Chads of Might & Magic");
echo (comment, "-- Initializing Raylib audio device data...");
2024-04-26 10:33:17 -04:00
ray.open_audio_device;
--
ray.randomization (19970725);
2024-04-26 10:33:17 -04:00
ray.set_target_fps (60);
--
2024-04-26 10:33:17 -04:00
echo (success, "Initialized core components.");
end initialize;
------------------------------------------------------------------------------------------
procedure deinitialize is
begin
2024-04-26 10:33:17 -04:00
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.");
--
2024-04-26 10:33:17 -04:00
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...");
2024-04-26 10:33:17 -04:00
ray.close_audio_device;
--
echo (comment, "-- Deinitializing Raylib window data...");
2024-04-26 10:33:17 -04:00
ray.close_window;
--
2024-04-26 10:33:17 -04:00
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);
2024-04-26 10:33:17 -04:00
framerate := integer (ray.get_fps);
signal := ray.get_key_pressed;
cursor.x := ray.get_mouse_x;
cursor.y := ray.get_mouse_y;
--
ray.draw_fps (0, 0);
--
2024-04-26 10:33:17 -04:00
ray.end_drawing;
--
2024-04-26 10:33:17 -04:00
if ray.exit_key_is_pressed then
engine_active := false;
end if;
--
2024-04-26 10:33:17 -04:00
if ray.mouse_button_is_pressed (ray.mouse_button_left) then cursor_mode := 1; end if;
if ray.mouse_button_is_pressed (ray.mouse_button_right) then cursor_mode := 2; end if;
if ray.mouse_button_is_pressed (ray.mouse_button_middle) then cursor_mode := 3; end if;
if ray.mouse_button_is_released (ray.mouse_button_left) then cursor_mode := 0; end if;
if ray.mouse_button_is_released (ray.mouse_button_right) then cursor_mode := 0; end if;
if ray.mouse_button_is_released (ray.mouse_button_middle) then cursor_mode := 0; end if;
--
case signal is
when 48 .. 57 => signal_mode := signal - 48 + signal_code'pos (signal_0);
when 65 .. 90 => signal_mode := signal - 65 + signal_code'pos (signal_a);
when 320 .. 329 => signal_mode := signal - 320 + signal_code'pos (signal_kp_0);
--
when 0 => signal_mode := signal_code'pos (signal_none);
when 32 => signal_mode := signal_code'pos (signal_space);
when 96 => signal_mode := signal_code'pos (signal_grave);
when 340 => signal_mode := signal_code'pos (signal_left_shift);
when 341 => signal_mode := signal_code'pos (signal_left_control);
when 333 => signal_mode := signal_code'pos (signal_kp_subtract);
when 334 => signal_mode := signal_code'pos (signal_kp_add);
when 256 => signal_mode := signal_code'pos (signal_escape);
when 257 => signal_mode := signal_code'pos (signal_enter);
when 258 => signal_mode := signal_code'pos (signal_tab);
when 259 => signal_mode := signal_code'pos (signal_backspace);
when 262 => signal_mode := signal_code'pos (signal_right);
when 263 => signal_mode := signal_code'pos (signal_left);
when 264 => signal_mode := signal_code'pos (signal_down);
when 265 => signal_mode := signal_code'pos (signal_up);
when others => signal_mode := signal_code'pos (signal_none);
end case;
--
2024-04-26 10:33:17 -04:00
ray.begin_drawing;
--
2024-04-26 10:33:17 -04:00
ray.clear_background ((50, 60, 70, 255));
end synchronize;
------------------------------------------------------------------------------------------
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;
2024-02-15 21:03:09 -05:00
------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
end core;