|
- -- Copyright (c) 2024 - Ognjen 'xolatile' Milan Robovic
- --
- -- GNU General Public Licence (version 3 or later)
-
- with ray;
-
- 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) 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;
-
- ------------------------------------------------------------------------------------------
-
- 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 "+" (data : in point; modifier : in natural) return point is
- this : point := data;
- begin
- this.value := (if (data.value + modifier) > data.limit then data.limit else (data.value + modifier));
- --
- return this;
- end "+";
-
- ------------------------------------------------------------------------------------------
-
- function "-" (data : in point; modifier : in natural) return point is
- this : point := data;
- begin
- this.value := (if (data.value - modifier) <= 0 then 0 else (data.value - modifier));
- --
- return this;
- end "-";
-
- ------------------------------------------------------------------------------------------
-
- function "*" (data : in point; modifier : in natural) return point is
- this : point := data;
- begin
- this.value := (if (data.value * modifier) > data.limit then data.limit else (data.value * modifier));
- --
- return this;
- end "*";
-
- ------------------------------------------------------------------------------------------
-
- function "/" (data : in point; modifier : in natural) return point is
- this : point := data;
- begin
- this.value := (if (data.value / modifier) <= 0 then 0 else (data.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 c_string (ada_string : string) return string is
- begin
- return (ada_string & character'val (0));
- end c_string;
-
- ------------------------------------------------------------------------------------------
-
- function random (minimum, maximum : in integer) return integer is
- begin
- return ray.get_random (minimum, maximum);
- 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 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 (object : in integer) return integer is begin return (window_width - object) / 2; end center_x;
- function center_y (object : in integer) return integer is begin return (window_height - object) / 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 * zoom and cursor.y > y and cursor.y < y + height * zoom;
- 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)))) & character'val (0);
- end import_text;
-
- ------------------------------------------------------------------------------------------
-
- procedure create_image (width, height : in integer) is
- begin
- global_mapshot := ray.image_colour (width * base, height * base, (0, 0, 0, 255));
- end create_image;
-
- ------------------------------------------------------------------------------------------
-
- 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_mapshot,
- 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_mapshot, c_string (file_path));
- --
- ray.image_delete (global_mapshot);
- 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;
- 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 u > 0 then u else (animation_time mod data.frames) * data.width),
- y => float (if v > 0 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;
- function read_text_box return string is begin return to_string (text_box.text); end read_text_box;
-
- ------------------------------------------------------------------------------------------
-
- procedure write_help_box (text : in string) is begin help_box.text := to_unbounded_string (text); end write_help_box;
- procedure write_text_box (text : in string) is begin text_box.text := to_unbounded_string (text); end write_text_box;
-
- ------------------------------------------------------------------------------------------
-
- procedure increment (value : in out integer) is begin value := value + 1; end increment;
- procedure decrement (value : in out integer) is begin value := value - 1; end decrement;
-
- ------------------------------------------------------------------------------------------
-
- procedure idle_skip is null;
-
- procedure move_camera_up is begin core.camera.y := core.camera.y - 1; end move_camera_up;
- procedure move_camera_down is begin core.camera.y := core.camera.y + 1; end move_camera_down;
- procedure move_camera_left is begin core.camera.x := core.camera.x - 1; end move_camera_left;
- procedure move_camera_right is begin core.camera.x := core.camera.x + 1; end move_camera_right;
-
- ------------------------------------------------------------------------------------------
-
- 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"));
- --
- --~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;
- --
- 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;
- --
- 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 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;
-
- ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
-
- end core;
|