xhads/source/core.adb

with core;

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;
	--
	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_rectangle (x, y, width, height : integer; tint : color) with import => true, convention => c, external_name => "DrawRectangle";
	--
	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;

	type texture_data_array is array (natural range <>) of texture;
	type sound_data_array   is array (natural range <>) of sound;
	type font_data_array    is array (natural range <>) of font;

	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; message : in string) is
	begin
		if not echo_mark (status) then
			return;
		end if;
		--
		put ("[");
		case status is
			when failure => terminal (red,    bold); put ("Failure");
			when warning => terminal (yellow, bold); put ("Warning");
			when success => terminal (green,  bold); put ("Success");
			when comment => terminal (grey,   bold); put ("Comment");
			when import  => terminal (cyan,   bold); put ("   +   ");
			when export  => terminal (pink,   bold); put ("   >   ");
			when deport  => terminal (blue,   bold); put ("   -   ");
			when ray_ada => terminal (white,  bold); put ("Ray-Ada");
		end case;
		terminal;
		put_line ("] " & message);
	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 flip_coin return integer is
	begin
		return (random_integer (0, 1));
	end flip_coin;

                                             ------------------------------------------------------------------------------------------

	function roll_dice return integer is
	begin
		return (random_integer (1, 6));
	end roll_dice;

                                             ------------------------------------------------------------------------------------------

	function by_chance (chance : in integer) return integer is
	begin
		return (random_integer (0, 100) mod chance);
	end by_chance;

                                             ------------------------------------------------------------------------------------------

	function c_string (ada_string : string) return string is
	begin
		return (ada_string & character'val (0));
	end c_string;

                                             ------------------------------------------------------------------------------------------

	function random_integer (minimum, maximum : in integer) return integer is
	begin
		return get_random (minimum, maximum);
	end random_integer;

                                             ------------------------------------------------------------------------------------------

	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) := load_texture (c_string (file_path));
		--
		texture_count := texture_count + 1;
		this.index    := texture_count - 1;
		this.width    := texture_array (this.index).width / states;
		this.height   := texture_array (this.index).height / frames;
		this.frames   := frames;
		this.states   := states;
		--
		return this;
	end import_sprite;

                                             ------------------------------------------------------------------------------------------

	function import_song (file_path : in string) return integer is
	begin
		sound_array (sound_count) := load_sound (c_string (file_path));
		--
		sound_count := sound_count + 1;
		--
		return sound_count - 1;
	end import_song;

                                             ------------------------------------------------------------------------------------------

	function import_glyphs (file_path : in string; size, pad : in integer) return glyphs is
		this : glyphs;
	begin
		font_array (font_count) := load_font (c_string (file_path));
		--
		font_count := font_count + 1;
		this.index := font_count - 1;
		this.size  := size;
		this.pad   := pad;
		--
		return this;
	end import_glyphs;

                                             ------------------------------------------------------------------------------------------

	procedure crop (data : in sprite; x, y, u, v, width, height : in integer) is
	begin
		render_sprite (data.index, x, y, u, v, width, height);
	end crop;

                                             ------------------------------------------------------------------------------------------

	procedure view (data : in sprite; x, y, u, v, width, height : in integer) is
		--~crop_u, crop_v, crop_width, crop_height : integer;
	begin
		if x > u + width
		or y > v + height
		or x < u - data.width
		or y < v - data.height then
			return;
		end if;
		--
		--~crop_width  := data.width  - (if x + data.width  > u + width  then (x + data.width)  mod (u + width)  else 0);
		--~crop_height := data.height - (if y + data.height > v + height then (y + data.height) mod (v + height) else 0);
		--
		--~crop_u := (if x < u then data.width  - u mod (x + data.width)  else 0);
		--~crop_v := (if y < v then data.height - v mod (y + data.height) else 0);
		--~crop_u := (if x < u and x < u - data.width  then data.width  - (x + data.width)  mod u else 0);
		--~crop_v := (if y < v and y < v - data.height then data.height - (y + data.height) mod v else 0);
		--~crop_u := data.width  - (if x < u then (x + data.width)  mod u else 0);
		--~crop_v := data.height - (if y < v then (y + data.height) mod v else 0);
		--~crop_u := data.width  - (if x < u then u mod x else 0);
		--~crop_v := data.height - (if y < v then v mod y else 0);
		--
		--~render_sprite (data.index, x, y, crop_u, crop_v, crop_width, crop_height);
		render_sprite (data.index, x, y, 0, 0, data.width, data.height);
	end view;

                                             ------------------------------------------------------------------------------------------

	procedure draw (data : in sprite; x, y : in integer) is
	begin
		render_sprite (data.index, x, y, 0, 0, data.width, data.height);
	end draw;

                                             ------------------------------------------------------------------------------------------

	procedure move (data : in sprite; x, y, frame, state : in integer) is
	begin
		render_sprite (data.index, x, y, state * data.width, (animation_time mod frame) * data.height, data.width, data.height);
	end move;

                                             ------------------------------------------------------------------------------------------

	procedure line (origin, offset : in vector) is
	begin
		render_vector (origin.x, origin.y, origin.x + offset.x, origin.y + offset.y);
	end line;

                                             ------------------------------------------------------------------------------------------

	procedure write (text : in string; x, y : in integer; data : in glyphs; colour : in colour_range := 16#FFFFFFFF#) is
	begin
		render_string (text, x, y, colour, data.index, data.size, data.pad);
	end write;

                                             ------------------------------------------------------------------------------------------

	procedure debug (text : in string) is
	begin
		put_line ("> " & text);
	end debug;

                                             ------------------------------------------------------------------------------------------

	procedure hexagonal_grid (x, y, width, height : in integer; fill : in boolean) is
		crop_width  : constant integer := width  mod hexagon_grid_sprite.width;
		crop_height : constant integer := height mod hexagon_grid_sprite.height;
		use_sprite  : constant sprite  := (if fill then hexagon_fill_sprite else hexagon_grid_sprite);
	begin
		for move_y in 0 .. height / hexagon_grid_sprite.height - 1
		loop
			for move_x in 0 .. width / hexagon_grid_sprite.width - 1
			loop
				draw (use_sprite, x + move_x * hexagon_grid_sprite.width, y + move_y * hexagon_grid_sprite.height);
			end loop;
			--
			crop (use_sprite, x + width - crop_width, y + move_y * hexagon_grid_sprite.height, 0, 0, crop_width, hexagon_grid_sprite.height);
		end loop;
		--
		for move_x in 0 .. width / hexagon_grid_sprite.width - 1
		loop
			crop (use_sprite, x + move_x * hexagon_grid_sprite.width, y + height - crop_height, 0, 0, hexagon_grid_sprite.width, crop_height);
		end loop;
		--
		crop (use_sprite, x + width - crop_width, y + height - crop_height, 0, 0, crop_width, crop_height);
	end hexagonal_grid;

                                             ------------------------------------------------------------------------------------------

	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 uppercase (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 uppercase;

                                             ------------------------------------------------------------------------------------------

	procedure draw_central_grid (x, y, width, height : in integer) is
	begin
		render_vector (width / 2 + x,              y, width / 2 + x, height     + y);
		render_vector (            x, height / 2 + y, width     + x, height / 2 + y);
	end draw_central_grid;

                                             ------------------------------------------------------------------------------------------

	procedure draw_squared_grid (x, y, width, height : in integer) is
		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
			line ((x, y + offset.y + next * base), (width, 0));
		end loop;
		--
		if repeat.y mod 4 = 1 then
			for next in 0 .. repeat.x - 1 loop line ((x + offset.x + base / 2 + next * base, y                    ), (0, offset.y)); end loop;
			for next in 0 .. repeat.x - 1 loop line ((x + offset.x + base / 2 + next * base, y + height - offset.y), (0, offset.y)); end loop;
			--
			for step in 0 .. repeat.y / 2 - 1 loop
				for next in 0 .. repeat.x - 1 loop line ((x + offset.x + base / 2 + next * base, y + base + offset.y + 2 * step * base), (0, base)); end loop;
			end loop;
			for step in 0 .. repeat.y / 2 loop
				for next in 0 .. repeat.x loop line ((x + offset.x + next * base, y + offset.y + 2 * step * base), (0, base)); end loop;
			end loop;
		else
			for next in 0 .. repeat.x - 1 loop line ((x + offset.x + next * base, y                    ), (0, offset.y)); end loop;
			for next in 0 .. repeat.x - 1 loop line ((x + offset.x + next * base, y + height - offset.y), (0, offset.y)); end loop;
			--
			for step in 0 .. repeat.y / 2 - 1 loop
				for next in 0 .. repeat.x loop line ((x + offset.x + next * base, y + base + offset.y + 2 * step * base), (0, base)); end loop;
			end loop;
			for step in 0 .. repeat.y / 2 loop
				for next in 0 .. repeat.x - 1 loop line ((x + offset.x + base / 2 + next * base, y + offset.y + 2 * step * base), (0, base)); end loop;
			end loop;
		end if;
	end draw_squared_grid;

                                             ------------------------------------------------------------------------------------------

	procedure draw_hexagon_grid (x, y, width, height : in integer) is
		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
			if step mod 2 = 1 then
				for next in 0 .. repeat.x - 1
				loop
					line ((x + offset.x + base / 2 + next * base, y + offset.y + step * base + base / 4), (-base / 2, -base / 2));
					line ((x + offset.x + base / 2 + next * base, y + offset.y + step * base + base / 4), ( base / 2, -base / 2));
				end loop;
			else
				for next in 0 .. repeat.x - 1
				loop
					line ((x + offset.x + base / 2 + next * base, y + offset.y + step * base - base / 4), (-base / 2, base / 2));
					line ((x + offset.x + base / 2 + next * base, y + offset.y + step * base - base / 4), ( base / 2, base / 2));
				end loop;
			end if;
		end loop;
		--
		if repeat.y mod 4 = 1 then
			for next in 0 .. repeat.x - 1 loop line ((x + offset.x + base / 2 + next * base, y                               ), (0, offset.y - base / 4)); end loop;
			for next in 0 .. repeat.x - 1 loop line ((x + offset.x + base / 2 + next * base, y + base / 4 + height - offset.y), (0, offset.y - base / 4)); end loop;
			--
			for step in 0 .. repeat.y / 2 - 1 loop
				for next in 0 .. repeat.x - 1 loop line ((x + offset.x + base / 2 + next * base, y + 5 * base / 4 + offset.y + 2 * step * base), (0, base / 2)); end loop;
			end loop;
			for step in 0 .. repeat.y / 2 loop
				for next in 0 .. repeat.x loop line ((x + offset.x + next * base, y + base / 4 + offset.y + 2 * step * base), (0, base / 2)); end loop;
			end loop;
		else
			for next in 0 .. repeat.x - 1 loop line ((x + offset.x + next * base, y                    ), (0, offset.y)); end loop;
			for next in 0 .. repeat.x - 1 loop line ((x + offset.x + next * base, y + height - offset.y), (0, offset.y)); end loop;
			--
			for step in 0 .. repeat.y / 2 - 1 loop
				for next in 0 .. repeat.x loop line ((x + offset.x + next * base, y + 5 * base / 4 + offset.y + 2 * step * base), (0, base / 2)); end loop;
			end loop;
			for step in 0 .. repeat.y / 2 loop
				for next in 0 .. repeat.x - 1 loop line ((x + offset.x + base / 2 + next * base, y + base / 4 + offset.y + 2 * step * base), (0, base / 2)); end loop;
			end loop;
		end if;
	end draw_hexagon_grid;

                                             ------------------------------------------------------------------------------------------

	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 render_sprite (sprite, x, y, u, v, width, height : in integer) is
	begin
		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 (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, (0, 0, 0, 255));
	end render_vector;

	function window_width  return integer is begin return get_screen_width;  end window_width;
	function window_height return integer is begin return get_screen_height; end window_height;

                                             ------------------------------------------------------------------------------------------
--~base ::= A|B|C|D|E|F|G|H|I|J|K|L|M|N|O|P|Q|R|S|T|U|V|W|X|Y|Z;
	procedure initialize is
	begin
		core.echo (core.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 ..    4);
		--
		core.echo (core.ray_ada, "-- Setting trace log level to none (ignoring all default Raylib logs).");
		set_trace_log_level (log_none);
		core.echo (core.ray_ada, "-- Initializing Raylib window data...");
		core.echo (core.ray_ada, "-- -- Window title  : Chads of Might & Magic");
		core.echo (core.ray_ada, "-- -- Window width  : 1800");
		core.echo (core.ray_ada, "-- -- Window height : 900");
		open_window (1800, 900, "Chads of Might & Magic");
		core.echo (core.ray_ada, "-- Initializing Raylib audio device data...");
		open_audio_device;
		--
		randomization  (25071997);
		set_target_fps (60);
		--
		hexagon_grid_sprite := import_sprite ("./sprite/ui/hexagon_grid_tile.png", 1, 1);
		hexagon_fill_sprite := import_sprite ("./sprite/ui/hexagon_fill_tile.png", 1, 1);
		--
		core.echo (core.success, "Initialized core components.");
	end initialize;

                                             ------------------------------------------------------------------------------------------

	procedure deinitialize is
	begin
		core.echo (core.comment, "Deinitializing core components...");
		--
		engine_active := false;
		--
		core.echo (core.deport, "-- -- Unloading Raylib" & integer'image (texture_count) & " textures.");
		core.echo (core.deport, "-- -- Unloading Raylib" & integer'image (sound_count)   & " sounds.");
		core.echo (core.deport, "-- -- Unloading Raylib" & integer'image (font_count)    & " fonts.");
		--
		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 0 .. font_count    - 1 loop unload_font    (font_array    (index)); end loop;
		--
		core.echo (core.ray_ada, "-- Deinitializing Raylib audio device data...");
		close_audio_device;
		--
		core.echo (core.ray_ada, "-- Deinitializing Raylib window data...");
		close_window;
		--
		core.echo (core.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 (get_fps);
		signal         := get_key_pressed;
		cursor.x       := get_mouse_x;
		cursor.y       := get_mouse_y;
		--
		end_drawing;
		--
		if exit_key_is_pressed then
			engine_active := false;
		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);
			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;
		--
		begin_drawing;
		--
		clear_background ((50, 60, 70, 255));
	end synchronize;

                                             ------------------------------------------------------------------------------------------

	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;

                                             ------------------------------------------------------------------------------------------

	procedure overlay is
	begin
		draw_rectangle (0, 0, window_width, window_height, (0, 0, 0, 100));
	end overlay;

------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------

end core;