-- 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 "+" (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 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 => 1); 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 => 1); 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 => 1); 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 => 1); 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; ------------------------------------------------------------------------------------------ procedure block_queue (data : in block) is begin if block_count = block_limit - 1 then return; end if; -- block_array (block_count) := data; -- increment (block_count); end block_queue; ------------------------------------------------------------------------------------------ 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 := 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_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; -- --~for index in reverse 0 .. block_count - 1 loop --~if core.cursor.x > block_array (index).x and core.cursor.x < block_array (index).width --~and core.cursor.y > block_array (index).y and core.cursor.y < block_array (index).height --~and core.cursor_mode = block_array (index).mode then --~block_array (index).action.all; --~core.cursor_mode := 0; --~exit; --~end if; --~end loop; -- block_count := 0; -- ray.begin_drawing; -- ray.clear_background ((0, 0, 0, 255)); end synchronize; ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------ end core;