-- Copyright (c) 2024 - Ognjen 'xolatile' Milan Robovic -- -- GNU General Public Licence (version 3 or later) with core, 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 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); else echo (import, this.index'image & file_path & this.frames'image & this.states'image & this.width'image & this.height'image); 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; 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); 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))); 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)); end write; ------------------------------------------------------------------------------------------ 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 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; ------------------------------------------------------------------------------------------ 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; ------------------------------------------------------------------------------------------ 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); 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.draw_fps (window_width - 100, window_height - 100); -- 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 - 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; -- ray.begin_drawing; -- 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; ------------------------------------------------------------------------------------------ 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; ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------ end core;