-- 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; ------------------------------------------------------------------------------------------ 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; ------------------------------------------------------------------------------------------ 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 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 (failure, "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 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 integer := 0; 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 => (float (if u = 0 then (animation_time mod data.frames) * data.width else u), float (v), new_width, new_height), view => (float (x), float (y), new_width * float (factor), new_height * float (factor)), tint => new_tint); end draw; ------------------------------------------------------------------------------------------ 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 => float ((if size = 0 then data.scale else size)), space => float (data.space), 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_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; ------------------------------------------------------------------------------------------ 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 is begin null; end idle; 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 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 .. 8); -- 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 : Chads of Might & Magic"); echo (comment, "-- -- Window width : 1800"); echo (comment, "-- -- Window height : 900"); ray.open_window (1800, 900, "Chads of Might & Magic"); -- echo (comment, "-- Initializing Raylib audio device data..."); ray.open_audio_device; -- 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; -- 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; -- 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;