xolatile/xhads
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Experimental removal of C graphics files, compiles but segfaults...

Browse Source
This commit is contained in:
Ognjen Milan Robovic 2024-03-17 15:15:18 -04:00
parent 8beb8bdeda
commit b173b130d5
8 changed files with 288 additions and 114 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
source/attribute.ads
View File

@ -19,17 +19,17 @@ package attribute is
text : core.long_string;
end record;
type trait_array is array (codex) of information;
type sprite_array is array (codex) of core.sprite;
--~type trait_array is array (codex) of information;
--~type sprite_array is array (codex) of core.sprite;
type value_array is array (codex) of base_limit;
------------------------------------------------------------------------------------------
sprite : sprite_array;
sprite : array (codex) of core.sprite;
count : constant natural := codex'pos (codex'last) + 1;
trait : constant trait_array := (
trait : constant array (codex) of information := (
("Attack ", 0, "Determines strength, edurance and damage dealth. "),
("Defense ", 0, "Determines resistance, stamina and damage blocked. "),
("Power ", 0, "Determines might and magic range, spread and usage. "),

9
source/chad.ads
View File

@ -24,20 +24,21 @@ package chad is
record
index : codex;
attributes : attribute.value_array;
--~attributes : array (attribute.codex) of attribute.base_limit;
skills : skill.value_array;
resources : resource.value_array;
end record;
type trait_array is array (codex) of information;
type sprite_array is array (codex) of core.sprite;
--~type trait_array is array (codex) of information;
--~type sprite_array is array (codex) of core.sprite;
------------------------------------------------------------------------------------------
sprite : sprite_array;
sprite : array (codex) of core.sprite;
count : constant natural := codex'pos (codex'last) + 1;
trait : constant trait_array := (
trait : constant array (codex) of information := (
("Ognjen Milan Robovic ", faction.castle, attribute.power, skill.archery, resource.gold),
("Richard Martin Stallman ", faction.stronghold, attribute.knowledge, skill.leadership, resource.ore),
("Eric Steven Raymond ", faction.inferno, attribute.defense, skill.resistance, resource.wood),

259
source/core.adb
View File

@ -6,6 +6,62 @@ package body core is
------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
type colour is range 0 .. 2 ** 32 - 1;
--
type rectangle is record x, y, width, height : integer; end record;
--
type texture_data is record id : natural; width, height, mipmaps, format : integer; end record;
type sound_data is record buffer, processor : integer; sampleRate, sampleSize, channels, frameCount : natural; end record;
type font_data is record baseSize, glyphCount, glyphPadding : integer; id : texture_data; recs, glyphs : integer; end record;
--
procedure initialize_video (width, height : in integer; title : in string) with import => true, convention => c, external_name => "InitWindow";
procedure initialize_audio with import => true, convention => c, external_name => "InitAudioDevice";
procedure deinitialize_video with import => true, convention => c, external_name => "CloseWindow";
procedure deinitialize_audio with import => true, convention => c, external_name => "CloseAudioDevice";
procedure initialize_frame with import => true, convention => c, external_name => "BeginDrawing";
procedure deinitialize_frame with import => true, convention => c, external_name => "EndDrawing";
--
procedure error_callback (callback : in integer) with import => true, convention => c, external_name => "SetTraceLogCallback";
procedure clear_frame (colour : in integer) with import => true, convention => c, external_name => "ClearBackground";
procedure limit_framerate (framerate : in integer) with import => true, convention => c, external_name => "SetTargetFPS";
function queue_framerate return float with import => true, convention => c, external_name => "GetFPS";
function close_callback return integer with import => true, convention => c, external_name => "WindowShouldClose";
--
function queue_event return integer with import => true, convention => c, external_name => "GetKeyPressed";
function mouse_pressed (button : in integer) return integer with import => true, convention => c, external_name => "IsMouseButtonPressed";
function mouse_released (button : in integer) return integer with import => true, convention => c, external_name => "IsMouseButtonReleased";
function mouse_x return integer with import => true, convention => c, external_name => "GetMouseX";
function mouse_y return integer with import => true, convention => c, external_name => "GetMouseY";
function screen_width return integer with import => true, convention => c, external_name => "GetScreenWidth";
function screen_height return integer with import => true, convention => c, external_name => "GetScreenHeight";
--
function load_texture (file_path : in string) return texture_data with import => true, convention => c, external_name => "LoadTexture";
function load_sound (file_path : in string) return sound_data with import => true, convention => c, external_name => "LoadSound";
function load_font (file_path : in string) return font_data with import => true, convention => c, external_name => "LoadFont";
--
procedure unload_texture (data : in texture_data) with import => true, convention => c, external_name => "UnloadTexture";
procedure unload_sound (data : in sound_data) with import => true, convention => c, external_name => "UnloadSound";
procedure unload_font (data : in font_data) with import => true, convention => c, external_name => "UnloadFont";
--
procedure play_sound (data : in sound_data) with import => true, convention => c, external_name => "PlaySound";
procedure stop_sound (data : in sound_data) with import => true, convention => c, external_name => "StopSound";
--
procedure draw_texture (data : in texture_data; s, d : in rectangle; o : in vector; rotation : in float; tint : in colour) with import => true, convention => c, external_name => "DrawTexturePro";
procedure draw_string (data : in font_data; text : in string; p, o : in vector; r, t, s : in float; tint : in colour) with import => true, convention => c, external_name => "DrawTextPro";
procedure draw_vector (x1, y1, x2, y2 : in integer; tint : in colour) with import => true, convention => c, external_name => "DrawLine";
--
function get_random_value (minimum, maximum : in integer) return integer with import => true, convention => c, external_name => "GetRandomValue";
texture_count : integer := 0;
sound_count : integer := 0;
font_count : integer := 1;
texture_array : array (0 .. 1600) of texture_data;
sound_array : array (0 .. 2) of sound_data;
font_array : array (1 .. 4) of font_data;
------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
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
@ -31,7 +87,6 @@ package body core is
dash;
echo (comment, "Immediately terminating the program, no memory management clean-up.");
dash;
die;
end if;
end echo;
@ -59,31 +114,6 @@ package body core is
------------------------------------------------------------------------------------------
procedure configure is
begin
echo (comment, "Configuring core game engine components...");
--
engine_configure;
--
hexagon_grid_sprite := load_sprite ("./sprite/ui/hexagon_grid_tile.png", 1, 1);
hexagon_fill_sprite := load_sprite ("./sprite/ui/hexagon_fill_tile.png", 1, 1);
end configure;
------------------------------------------------------------------------------------------
procedure synchronize is
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);
--
engine_synchronize;
end synchronize;
------------------------------------------------------------------------------------------
function flip_coin return integer is
begin
return (random_integer (0, 1));
@ -112,6 +142,13 @@ package body core is
------------------------------------------------------------------------------------------
function random_integer (minimum, maximum : in integer) return integer is
begin
return get_random_value (minimum, maximum);
end random_integer;
------------------------------------------------------------------------------------------
function clip (value, minimum, maximum : in integer) return integer is
begin
if value < minimum then return minimum; end if;
@ -125,8 +162,8 @@ package body core is
this : sprite;
begin
this.index := import_texture (c_string (file_path));
this.width := sprite_width (this.index) / states;
this.height := sprite_height (this.index) / frames;
this.width := texture_array (this.index).width / states;
this.height := texture_array (this.index).height / frames;
this.frames := frames;
this.states := states;
--
@ -196,7 +233,7 @@ package body core is
------------------------------------------------------------------------------------------
procedure line (origin, offset : in vector_2) is
procedure line (origin, offset : in vector) is
begin
render_vector (origin.x, origin.y, origin.x + offset.x, origin.y + offset.y);
end line;
@ -285,8 +322,8 @@ package body core is
------------------------------------------------------------------------------------------
procedure draw_squared_grid (x, y, width, height : in integer) is
offset : constant vector_2 := (((width - base) / 2) mod base, ((height - base) / 2) mod base);
repeat : constant vector_2 := (2 * (((width - base) / 2) / base) + 1, 2 * (((height - base) / 2) / base) + 1);
offset : constant vector := (((width - base) / 2) mod base, ((height - base) / 2) mod base);
repeat : constant vector := (2 * (((width - base) / 2) / base) + 1, 2 * (((height - base) / 2) / base) + 1);
begin
for next in 0 .. repeat.y
loop
@ -319,8 +356,8 @@ package body core is
------------------------------------------------------------------------------------------
procedure draw_hexagon_grid (x, y, width, height : in integer) is
offset : constant vector_2 := (((width - base) / 2) mod base, ((height - base) / 2) mod base);
repeat : constant vector_2 := (2 * (((width - base) / 2) / base) + 1, 2 * (((height - base) / 2) / base) + 1);
offset : constant vector := (((width - base) / 2) mod base, ((height - base) / 2) mod base);
repeat : constant vector := (2 * (((width - base) / 2) / base) + 1, 2 * (((height - base) / 2) / base) + 1);
begin
for step in 0 .. repeat.y
loop
@ -376,6 +413,162 @@ package body core is
text_box.data := to_unbounded_string (text);
end write_text_box;
------------------------------------------------------------------------------------------
procedure render_sprite (sprite, x, y, u, v, width, height : in integer) is
begin
draw_texture (texture_array (sprite), (u, v, width, height), (x, y, abs width, abs height), (0, 0), 0.0, 16#FFFFFFFF#);
end render_sprite;
------------------------------------------------------------------------------------------
procedure render_string (text : in string; x, y, colour, index, size, pad : in integer) is
begin
draw_string (font_array (index), text, ((32 - size) / 2 + x, (32 - size) / 2 + y), (0, 0), 0.0, float (size), float (pad), 16#FFFFFFFF#);
end render_string;
------------------------------------------------------------------------------------------
procedure render_vector (x1, y1, x2, y2 : in integer) is
begin
draw_vector (x1, y1, x2, y2, 16#FF#);
end render_vector;
function window_width return integer is begin return screen_width; end window_width;
function window_height return integer is begin return screen_height; end window_height;
------------------------------------------------------------------------------------------
procedure configure is
begin
echo (comment, "Configuring core game engine components...");
--
hexagon_grid_sprite := load_sprite ("./sprite/ui/hexagon_grid_tile.png", 1, 1);
hexagon_fill_sprite := load_sprite ("./sprite/ui/hexagon_fill_tile.png", 1, 1);
end configure;
------------------------------------------------------------------------------------------
procedure initialize is
begin
engine_active := true;
--
error_callback (7);
initialize_video (1800, 900, "Chads of Might & Magic");
initialize_audio;
--
limit_framerate (60);
end initialize;
------------------------------------------------------------------------------------------
procedure deinitialize is
begin
engine_active := false;
--
for index in 0 .. texture_count - 1 loop unload_texture (texture_array (index)); end loop;
for index in 0 .. sound_count - 1 loop unload_sound (sound_array (index)); end loop;
for index in 1 .. font_count - 1 loop unload_font (font_array (index)); end loop;
--
deinitialize_video;
deinitialize_audio;
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 (queue_framerate);
signal := queue_event;
cursor.x := mouse_x;
cursor.y := mouse_y;
--
deinitialize_frame;
--
if close_callback = 1 then
engine_active := false;
end if;
--
if mouse_pressed (0) = 1 then cursor_mode := 1; end if;
if mouse_pressed (1) = 1 then cursor_mode := 2; end if;
if mouse_pressed (2) = 1 then cursor_mode := 3; end if;
if mouse_released (0) = 1 then cursor_mode := 0; end if;
if mouse_released (1) = 1 then cursor_mode := 0; end if;
if mouse_released (2) = 1 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;
--
initialize_frame;
--
clear_frame (16#506070FF#);
end synchronize;
------------------------------------------------------------------------------------------
function import_texture (file_path : in string) return integer is
begin
echo (comment, "[" & integer'image (texture_count) & " ] Importing texture: " & file_path);
--
texture_count := texture_count + 1;
--~texture_array := realloc (texture_array, (unsigned long int) texture_count * sizeof (* texture_array));
texture_array (texture_count - 1) := load_texture (file_path);
--
return texture_count - 1;
end import_texture;
------------------------------------------------------------------------------------------
function import_sound (file_path : in string) return integer is
begin
sound_count := sound_count + 1;
--~sound_array := realloc (sound_array, (unsigned long int) sound_count * sizeof (* sound_array));
sound_array (sound_count - 1) := load_sound (file_path);
--
return sound_count - 1;
end import_sound;
------------------------------------------------------------------------------------------
function import_font (file_path : in string) return integer is
begin
font_count := font_count + 1;
--~font_array := realloc (font_array, (unsigned long int) font_count * sizeof (* font_array));
font_array (font_count - 1) := load_font (file_path);
--
return font_count - 1;
end import_font;
------------------------------------------------------------------------------------------
procedure play_song (index : in integer) is begin play_sound (sound_array (index)); end play_song;
procedure stop_song (index : in integer) is begin stop_sound (sound_array (index)); end stop_song;
------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
end core;

86
source/core.ads
View File

@ -19,8 +19,8 @@ package core is
);
type signal_code is (
signal_none, signal_space, signal_zero, signal_one, signal_two, signal_three,
signal_four, signal_five, signal_six, signal_seven, signal_eight, signal_nine,
signal_none, signal_space, signal_0, signal_1, signal_2, signal_3,
signal_4, signal_5, signal_6, signal_7, signal_8, signal_9,
signal_a, signal_b, signal_c, signal_d, signal_e, signal_f,
signal_g, signal_h, signal_i, signal_j, signal_k, signal_l,
signal_m, signal_n, signal_o, signal_p, signal_q, signal_r,
@ -47,7 +47,7 @@ package core is
index, size, pad : integer;
end record;
type vector_2 is
type vector is
record
x, y : integer;
end record;
@ -61,22 +61,17 @@ package core is
------------------------------------------------------------------------------------------
-- C
cursor_x : integer with import => true, convention => c;
cursor_y : integer with import => true, convention => c;
cursor_mode : integer with import => true, convention => c;
signal_mode : integer with import => true, convention => c;
engine_active : boolean with import => true, convention => c;
framerate : integer with import => true, convention => c;
------------------------------------------------------------------------------------------
icon : constant natural := 32;
base : constant natural := 32;
gameplay_framerate : constant natural := 60;
animation_framerate : constant natural := 6;
cursor : vector := (0, 0);
cursor_mode : integer := 0;
signal_mode : integer := 0;
engine_active : boolean := false;
framerate : integer := 0;
global_time : natural := 0;
gameplay_time : natural := 0;
animation_time : natural := 0;
@ -84,47 +79,12 @@ package core is
hexagon_grid_sprite : sprite;
hexagon_fill_sprite : sprite;
camera : vector_2 := (0, 0);
camera : vector := (0, 0);
text_box : volatile;
------------------------------------------------------------------------------------------
-- C
procedure die with import => true, convention => c;
function random_integer (minimum, maximum : in integer) return integer with import => true, convention => c;
procedure engine_configure with import => true, convention => c;
procedure engine_synchronize with import => true, convention => c;
function window_width return integer with import => true, convention => c;
function window_height return integer with import => true, convention => c;
procedure render_sprite (sprite, x, y, u, v, width, height : in integer) with import => true, convention => c;
procedure render_string (text : in string; x, y, colour, index, size, pad : in integer) with import => true, convention => c;
procedure render_vector (x1, y1, x2, y2 : in integer) with import => true, convention => c;
function import_texture (file_path : in string) return integer with import => true, convention => c;
function import_sound (file_path : in string) return integer with import => true, convention => c;
function import_font (file_path : in string) return integer with import => true, convention => c;
function sprite_width (index : in integer) return integer with import => true, convention => c;
function sprite_height (index : in integer) return integer with import => true, convention => c;
procedure play_sound (index : in integer) with import => true, convention => c;
procedure stop_sound (index : in integer) with import => true, convention => c;
procedure loop_sound (index : in integer) with import => true, convention => c;
------------------------------------------------------------------------------------------
-- Fortran
procedure ai_synchronize (level : in integer) with import => true, convention => fortran;
------------------------------------------------------------------------------------------
procedure terminal (colour : in terminal_colour := white; effect : in terminal_effect := normal);
procedure echo (status : in echo_status; message : in string);
@ -132,14 +92,13 @@ package core is
procedure dash;
procedure semi_dash;
procedure configure;
procedure synchronize;
function flip_coin return integer;
function roll_dice return integer;
function by_chance (chance : in integer) return integer;
function c_string (ada_string : in string) return string;
function random_integer (minimum, maximum : in integer) return integer;
function clip (value, minimum, maximum : in integer) return integer;
function load_sprite (file_path : in string; frames, states : in integer) return sprite;
@ -151,7 +110,7 @@ package core is
procedure draw (data : in sprite; x, y : in integer);
procedure move (data : in sprite; x, y, frame, state : in integer);
procedure line (origin, offset : in vector_2);
procedure line (origin, offset : in vector);
procedure write (text : in string; x, y : in integer; data : in font; colour : in integer := 16#FFFFFF#);
procedure debug (text : in string);
@ -169,6 +128,25 @@ package core is
procedure write_text_box (text : in string);
procedure configure;
procedure initialize;
procedure deinitialize;
procedure synchronize;
function window_width return integer;
function window_height return integer;
procedure render_sprite (sprite, x, y, u, v, width, height : in integer);
procedure render_string (text : in string; x, y, colour, index, size, pad : in integer);
procedure render_vector (x1, y1, x2, y2 : in integer);
function import_texture (file_path : in string) return integer;
function import_sound (file_path : in string) return integer;
function import_font (file_path : in string) return integer;
procedure play_song (index : in integer);
procedure stop_song (index : in integer);
------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
end core;

8
source/main.adb
View File

@ -99,9 +99,11 @@ begin
core.dash;
core.configure;
core.initialize;
ui.configure;
core.play_sound (core.import_sound (core.c_string ("./song/main_menu.ogg")));
core.play_song (core.import_sound (core.c_string ("./song/main_menu.ogg")));
attribute.configure;
skill.configure;
@ -114,8 +116,6 @@ begin
chad.configure;
world.configure;
core.ai_synchronize (6);
world.make (world.swamp, 180, 140);
preview_width := core.window_width - side_panel;
@ -155,4 +155,6 @@ begin
------------------------------------------------------------------------------------------
core.deinitialize;
end main;

12
source/raylib.c
View File

@ -60,8 +60,8 @@ static void render_clean_up (void) {
CloseWindow ();
}
extern int cursor_x;
extern int cursor_y;
extern int cursor.x;
extern int cursor.y;
extern int cursor_mode;
extern int signal_mode;
extern int engine_active;
@ -88,8 +88,8 @@ extern void play_sound (int index);
extern void stop_sound (int index);
extern void loop_sound (int index);
int cursor_x = 0;
int cursor_y = 0;
int cursor.x = 0;
int cursor.y = 0;
int cursor_mode = 0;
int signal_mode = 0;
int engine_active = 0;
@ -163,8 +163,8 @@ void engine_synchronize (void) {
engine_active = 0;
}
cursor_x = GetMouseX ();
cursor_y = GetMouseY ();
cursor.x = GetMouseX ();
cursor.y = GetMouseY ();
if (IsMouseButtonPressed (MOUSE_BUTTON_LEFT)) { cursor_mode = 1; }
if (IsMouseButtonPressed (MOUSE_BUTTON_RIGHT)) { cursor_mode = 2; }

8
source/ui.adb
View File

@ -8,8 +8,8 @@ package body ui is
procedure select_text_box (text : in string; x, y, width, height : in integer) is
begin
if core.cursor_x > x and core.cursor_x < x + width
and core.cursor_y > y and core.cursor_y < y + height then
if core.cursor.x > x and core.cursor.x < x + width
and core.cursor.y > y and core.cursor.y < y + height then
core.write_text_box (text);
--~else
--~core.write_text_box ("");
@ -289,8 +289,8 @@ package body ui is
procedure draw_state_box (x, y : in integer) is
begin
core.write ("Cursor X :" & integer'image (core.cursor_x), x, y + 0, font (active));
core.write ("Cursor Y :" & integer'image (core.cursor_y), x, y + 32, font (active));
core.write ("Cursor X :" & integer'image (core.cursor.x), x, y + 0, font (active));
core.write ("Cursor Y :" & integer'image (core.cursor.y), x, y + 32, font (active));
core.write ("Cursor Mode :" & integer'image (core.cursor_mode), x, y + 64, font (active));
core.write ("Signal Code :" & core.signal_code'image (core.signal_code'val (core.signal_mode)), x, y + 96, font (active));
core.write ("Camera X :" & integer'image (core.camera.x), x, y + 128, font (active));

12
source/xcb.c
View File

@ -81,8 +81,8 @@ static void render_clean_up (void) {
xcb_disconnect (connection);
}
extern int cursor_x;
extern int cursor_y;
extern int cursor.x;
extern int cursor.y;
extern int cursor_mode;
extern int signal_mode;
@ -111,8 +111,8 @@ extern void play_sound (int index);
extern void stop_sound (int index);
extern void loop_sound (int index);
int cursor_x = 0;
int cursor_y = 0;
int cursor.x = 0;
int cursor.y = 0;
int cursor_mode = 0;
int signal_mode = 0;
@ -253,8 +253,8 @@ void engine_synchronize (void) {
cursor_mode = button_press_event->detail;
} else if ((event->response_type & 127) == XCB_MOTION_NOTIFY) {
xcb_motion_notify_event_t * button_press_event = (xcb_motion_notify_event_t *) event;
cursor_x = button_press_event->event_x;
cursor_y = button_press_event->event_y;
cursor.x = button_press_event->event_x;
cursor.y = button_press_event->event_y;
}
free (event);