diff --git a/source/core.adb b/source/core.adb index 769ce8a..8b3275a 100644 --- a/source/core.adb +++ b/source/core.adb @@ -1,11 +1,193 @@ -with core, raylib; +with core; -use core, raylib; +use core; package body core is ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------ + type color_range is range 0 .. 2 ** 8 - 1; + type logical is new boolean; + -- + for logical'size use 32; + for color_range'size use 8; + -- + type trace_log_level is ( + log_all, log_trace, log_debug, log_info, log_warning, log_error, + log_fatal, log_none + ) with convention => c; + -- + type mouse_button is ( + mouse_button_left, mouse_button_right, mouse_button_middle, mouse_button_side, mouse_button_extra, mouse_button_forward, + mouse_button_back + ) with convention => c; + -- + --~key_null : constant integer := 0; + --~key_space : constant integer := 32; + --~key_apostrophe : constant integer := 39; + --~key_comma : constant integer := 44; + --~key_minus : constant integer := 45; + --~key_period : constant integer := 46; + --~key_slash : constant integer := 47; + --~key_0 : constant integer := 48; + --~key_1 : constant integer := 49; + --~key_2 : constant integer := 50; + --~key_3 : constant integer := 51; + --~key_4 : constant integer := 52; + --~key_5 : constant integer := 53; + --~key_6 : constant integer := 54; + --~key_7 : constant integer := 55; + --~key_8 : constant integer := 56; + --~key_9 : constant integer := 57; + --~key_semicolon : constant integer := 59; + --~key_equal : constant integer := 61; + --~key_a : constant integer := 65; + --~key_b : constant integer := 66; + --~key_c : constant integer := 67; + --~key_d : constant integer := 68; + --~key_e : constant integer := 69; + --~key_f : constant integer := 70; + --~key_g : constant integer := 71; + --~key_h : constant integer := 72; + --~key_i : constant integer := 73; + --~key_j : constant integer := 74; + --~key_k : constant integer := 75; + --~key_l : constant integer := 76; + --~key_m : constant integer := 77; + --~key_n : constant integer := 78; + --~key_o : constant integer := 79; + --~key_p : constant integer := 80; + --~key_q : constant integer := 81; + --~key_r : constant integer := 82; + --~key_s : constant integer := 83; + --~key_t : constant integer := 84; + --~key_u : constant integer := 85; + --~key_v : constant integer := 86; + --~key_w : constant integer := 87; + --~key_x : constant integer := 88; + --~key_y : constant integer := 89; + --~key_z : constant integer := 90; + --~key_left_bracket : constant integer := 91; + --~key_backslash : constant integer := 92; + --~key_right_bracket : constant integer := 93; + --~key_grave : constant integer := 96; + --~key_escape : constant integer := 256; + --~key_enter : constant integer := 257; + --~key_tab : constant integer := 258; + --~key_backspace : constant integer := 259; + --~key_insert : constant integer := 260; + --~key_delete : constant integer := 261; + --~key_right : constant integer := 262; + --~key_left : constant integer := 263; + --~key_down : constant integer := 264; + --~key_up : constant integer := 265; + --~key_page_up : constant integer := 266; + --~key_page_down : constant integer := 267; + --~key_home : constant integer := 268; + --~key_end : constant integer := 269; + --~key_caps_lock : constant integer := 280; + --~key_scroll_lock : constant integer := 281; + --~key_num_lock : constant integer := 282; + --~key_print_screen : constant integer := 283; + --~key_pause : constant integer := 284; + --~key_f1 : constant integer := 290; + --~key_f2 : constant integer := 291; + --~key_f3 : constant integer := 292; + --~key_f4 : constant integer := 293; + --~key_f5 : constant integer := 294; + --~key_f6 : constant integer := 295; + --~key_f7 : constant integer := 296; + --~key_f8 : constant integer := 297; + --~key_f9 : constant integer := 298; + --~key_f10 : constant integer := 299; + --~key_f11 : constant integer := 300; + --~key_f12 : constant integer := 301; + --~key_pad_0 : constant integer := 320; + --~key_pad_1 : constant integer := 321; + --~key_pad_2 : constant integer := 322; + --~key_pad_3 : constant integer := 323; + --~key_pad_4 : constant integer := 324; + --~key_pad_5 : constant integer := 325; + --~key_pad_6 : constant integer := 326; + --~key_pad_7 : constant integer := 327; + --~key_pad_8 : constant integer := 328; + --~key_pad_9 : constant integer := 329; + --~key_pad_decimal : constant integer := 330; + --~key_pad_divide : constant integer := 331; + --~key_pad_multiply : constant integer := 332; + --~key_pad_subtract : constant integer := 333; + --~key_pad_add : constant integer := 334; + --~key_pad_enter : constant integer := 335; + --~key_pad_equal : constant integer := 336; + --~key_left_shift : constant integer := 340; + --~key_left_control : constant integer := 341; + --~key_left_alt : constant integer := 342; + --~key_left_super : constant integer := 343; + --~key_right_shift : constant integer := 344; + --~key_right_control : constant integer := 345; + --~key_right_alt : constant integer := 346; + --~key_right_super : constant integer := 347; + --~key_kb_menu : constant integer := 348; + -- + type vessel is record x, y : float; end record with convention => c_pass_by_copy; + type color is record r, g, b, a : color_range; end record with convention => c_pass_by_copy; + type rectangle is record x ,y, width, height : float; end record with convention => c_pass_by_copy; + type texture is record id : natural; width, height, mipmaps, format : integer; end record with convention => c_pass_by_copy; + type font is record base, count, pad : integer; data : texture; r : access rectangle; non : access natural; end record with convention => c_pass_by_copy; + type stream is record buffer, processor : access natural; rate, size, channels : natural; end record with convention => c_pass_by_copy; + type sound is record data : stream; frame : natural; end record with convention => c_pass_by_copy; + -- + procedure open_window (width, height : integer; title : string) with import => true, convention => c, external_name => "InitWindow"; + procedure close_window with import => true, convention => c, external_name => "CloseWindow"; + -- + procedure open_audio_device with import => true, convention => c, external_name => "InitAudioDevice"; + procedure close_audio_device with import => true, convention => c, external_name => "CloseAudioDevice"; + -- + procedure set_exit_key (key : integer) with import => true, convention => c, external_name => "SetExitKey"; + function exit_key_is_pressed return logical with import => true, convention => c, external_name => "WindowShouldClose"; + function get_key_pressed return integer with import => true, convention => c, external_name => "GetKeyPressed"; + function mouse_button_is_pressed (button : mouse_button) return logical with import => true, convention => c, external_name => "IsMouseButtonPressed"; + function mouse_button_is_released (button : mouse_button) return logical with import => true, convention => c, external_name => "IsMouseButtonReleased"; + function get_mouse_x return integer with import => true, convention => c, external_name => "GetMouseX"; + function get_mouse_y return integer with import => true, convention => c, external_name => "GetMouseY"; + function get_mouse_vessel return vessel with import => true, convention => c, external_name => "GetMousePosition"; + function get_screen_width return integer with import => true, convention => c, external_name => "GetScreenWidth"; + function get_screen_height return integer with import => true, convention => c, external_name => "GetScreenHeight"; + -- + procedure clear_background (tint : color) with import => true, convention => c, external_name => "ClearBackground"; + procedure begin_drawing with import => true, convention => c, external_name => "BeginDrawing"; + procedure end_drawing with import => true, convention => c, external_name => "EndDrawing"; + -- + procedure set_target_fps (fps : integer) with import => true, convention => c, external_name => "SetTargetFPS"; + function get_fps return integer with import => true, convention => c, external_name => "GetFPS"; + procedure randomization (seed : natural) with import => true, convention => c, external_name => "SetRandomSeed"; + function get_random (minimum, maximum : integer) return integer with import => true, convention => c, external_name => "GetRandomValue"; + -- + procedure take_screenshot (path : string := "screenshot.png") with import => true, convention => c, external_name => "TakeScreenshot"; + -- + procedure set_trace_log_level (level : trace_log_level) with import => true, convention => c, external_name => "SetTraceLogLevel"; + -- + function load_texture (path : string) return texture with import => true, convention => c, external_name => "LoadTexture"; + function load_sound (path : string) return sound with import => true, convention => c, external_name => "LoadSound"; + function load_font (path : string) return font with import => true, convention => c, external_name => "LoadFont"; + -- + procedure unload_texture (data : texture) with import => true, convention => c, external_name => "UnloadTexture"; + procedure unload_sound (data : sound) with import => true, convention => c, external_name => "UnloadSound"; + procedure unload_font (data : font) with import => true, convention => c, external_name => "UnloadFont"; + -- + procedure draw_line (x0, y0, x1, y1 : integer; tint : color) with import => true, convention => c, external_name => "DrawLine"; + -- + procedure draw_image (data : texture; uv : rectangle; view : vessel; tint : color) with import => true, convention => c, external_name => "DrawTextureRec"; + -- + procedure draw_text (data : font; text : string; view : vessel; size, pad : float; tint : color) with import => true, convention => c, external_name => "DrawTextEx"; + -- + procedure play_sound (data : sound) with import => true, convention => c, external_name => "PlaySound"; + procedure stop_sound (data : sound) with import => true, convention => c, external_name => "StopSound"; + procedure pause_sound (data : sound) with import => true, convention => c, external_name => "PauseSound"; + procedure resume_sound (data : sound) with import => true, convention => c, external_name => "ResumeSound"; + +------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------ + texture_count : integer := 0; sound_count : integer := 0; font_count : integer := 0; @@ -102,7 +284,7 @@ package body core is function random_integer (minimum, maximum : in integer) return integer is begin - return get_random_value (minimum, maximum); + return get_random (minimum, maximum); end random_integer; ------------------------------------------------------------------------------------------ @@ -217,7 +399,7 @@ package body core is procedure write (text : in string; x, y : in integer; data : in glyphs; colour : in colour_range := 16#FFFFFFFF#) is begin - render_string (c_string (text), x, y, colour, data.index, data.size, data.pad); + render_string (text, x, y, colour, data.index, data.size, data.pad); end write; ------------------------------------------------------------------------------------------ @@ -392,27 +574,29 @@ package body core is procedure render_sprite (sprite, x, y, u, v, width, height : in integer) is begin - draw_texture_pro (data => texture_array (sprite), - source => (float (u), float (v), float ( width), float ( height)), - destination => (float (x), float (y), float (abs width), float (abs height))); + draw_image (data => texture_array (sprite), + uv => (float (u), float (v), float (width), float (height)), + view => (float (x), float (y)), + tint => (255, 255, 255, 255)); end render_sprite; ------------------------------------------------------------------------------------------ procedure render_string (text : in string; x, y : in integer; colour : in colour_range; index, size, pad : in integer) is begin - draw_text_pro (data => font_array (index), - text => c_string (text), - position => (float ((32 - size) / 2 + x), float ((32 - size) / 2 + y)), - font_size => float (size), - spacing => float (pad)); + draw_text (data => font_array (index), + text => c_string (text), + view => (float ((32 - size) / 2 + x), float ((32 - size) / 2 + y)), + size => float (size), + pad => float (pad), + tint => (255, 255, 255, 255)); end render_string; ------------------------------------------------------------------------------------------ procedure render_vector (x1, y1, x2, y2 : in integer) is begin - draw_line (x1, y1, x2, y2, black); + draw_line (x1, y1, x2, y2, (255, 60, 60, 255)); end render_vector; function window_width return integer is begin return get_screen_width; end window_width; @@ -461,22 +645,22 @@ package body core is gameplay_time := global_time mod (gameplay_framerate); animation_time := global_time / (gameplay_framerate / animation_framerate); framerate := integer (get_fps); - signal := keyboard_key'pos (get_key_pressed); + signal := get_key_pressed; cursor.x := get_mouse_x; cursor.y := get_mouse_y; -- end_drawing; -- - if window_should_close then + if exit_key_is_pressed then engine_active := false; end if; -- - if is_mouse_button_pressed (mouse_button_left) then cursor_mode := 1; end if; - if is_mouse_button_pressed (mouse_button_right) then cursor_mode := 2; end if; - if is_mouse_button_pressed (mouse_button_middle) then cursor_mode := 3; end if; - if is_mouse_button_released (mouse_button_left) then cursor_mode := 0; end if; - if is_mouse_button_released (mouse_button_right) then cursor_mode := 0; end if; - if is_mouse_button_released (mouse_button_middle) then cursor_mode := 0; end if; + if mouse_button_is_pressed (mouse_button_left) then cursor_mode := 1; end if; + if mouse_button_is_pressed (mouse_button_right) then cursor_mode := 2; end if; + if mouse_button_is_pressed (mouse_button_middle) then cursor_mode := 3; end if; + if mouse_button_is_released (mouse_button_left) then cursor_mode := 0; end if; + if mouse_button_is_released (mouse_button_right) then cursor_mode := 0; end if; + if mouse_button_is_released (mouse_button_middle) then cursor_mode := 0; end if; -- case signal is when 48 .. 57 => signal_mode := signal - 48 + signal_code'pos (signal_0); @@ -503,7 +687,7 @@ package body core is -- begin_drawing; -- - clear_background (sky_blue); + clear_background ((60, 255, 50, 255)); end synchronize; ------------------------------------------------------------------------------------------