Files
lace/4-high/gel/source/platform/sdl/gel-window-sdl.adb
2022-07-31 17:34:54 +10:00

479 lines
22 KiB
Ada

with
SDL.Events.Windows,
SDL.Events.Keyboards,
SDL.Events.Events,
SDL.Events.Mice,
SDL.Video.Windows.Makers,
SDL.Log,
ada.Text_IO;
package body gel.Window.sdl
is
package std_SDL renames standard.SDL;
use std_SDL,
std_SDL.Events;
function to_gel_Key (From : in std_SDL.Events.Keyboards.Key_Codes) return gel.keyboard.Key;
---------
--- Forge
--
procedure define (Self : in View; Title : in String;
Width : in Natural;
Height : in Natural)
is
use type Video.Windows.Window_Flags;
begin
if not std_SDL.initialise
then
raise gel.Error with "Unable to initialise SDL.";
end if;
Video.Windows.Makers.create (Win => Self.window_Handle,
Title => Title,
X => 100,
Y => 100,
Width => C.int (Width),
Height => C.int (Height),
Flags => Video.Windows.openGL
or Video.Windows.Resizable);
Video.GL.create (Self.GL_Context, From => Self.window_Handle);
end define;
overriding
procedure destroy (Self : in out Item)
is
begin
Self.window_Handle.finalize;
std_SDL.finalise;
destroy (gel.Window.item (Self)); -- Destroy base class.
end destroy;
package body Forge
is
function to_Window (Title : in String;
Width : in Natural;
Height : in Natural) return gel.Window.sdl.item
is
begin
return Self : gel.Window.sdl.item := (gel.Window.private_Forge.to_Window (Title, Width, Height)
with others => <>)
do
define (Self'unchecked_Access, Title, Width, Height);
end return;
end to_Window;
function new_Window (Title : in String;
Width : in Natural;
Height : in Natural) return Window.sdl.view
is
Self : constant gel.Window.sdl.view := new Window.sdl.item' (to_Window (Title, Width, Height));
begin
return Self;
end new_Window;
end Forge;
--------------
--- Operations
--
use gel.Keyboard;
overriding
procedure emit_Events (Self : in out Item)
is
use type std_SDL.Events.Keyboards.Key_Codes;
Event : aliased std_SDL.Events.Events.Events;
begin
while std_SDL.Events.Events.Poll (Event)
loop
case Event.Common.Event_Type
is
when std_SDL.Events.Quit =>
Self.is_Open := False;
when std_SDL.Events.Keyboards.Key_Down =>
Self.Keyboard.emit_key_press_Event (Key => to_gel_Key (Event.keyboard.key_Sym.key_Code),
key_Code => Integer (Event.keyboard.key_Sym.key_Code));
when std_SDL.Events.Keyboards.Key_Up =>
std_SDL.Log.put_Debug ("Key up event: " & Event.keyboard.key_Sym. key_Code'Image &
" Scan code: " & Event.keyboard.key_Sym.scan_Code'Image);
if Event.keyboard.key_Sym.key_Code = std_SDL.Events.Keyboards.Code_escape -- TODO: Make this user-configurable.
then
Self.is_Open := False;
end if;
Self.Keyboard.emit_key_release_Event (Key => to_gel_Key (Event.keyboard.key_Sym.key_Code));
when std_SDL.Events.Mice.Button_Down =>
Self.Mouse.emit_button_press_Event (Button => gel.mouse.button_Id (std_SDL.Events.Mice.Buttons'Pos (Event.mouse_Button.Button) + 1),
Modifiers => Self.Keyboard.Modifiers,
Site => [Integer (Event.mouse_Button.X),
Integer (Event.mouse_Button.Y)]);
when std_SDL.Events.Mice.Button_Up =>
Self.Mouse.emit_button_release_Event (Button => gel.mouse.button_Id (std_SDL.Events.Mice.Buttons'Pos (Event.Mouse_Button.Button) + 1),
Modifiers => Self.Keyboard.Modifiers,
Site => [Integer (Event.mouse_Button.X),
Integer (Event.mouse_Button.Y)]);
when std_SDL.Events.Mice.Motion =>
Self.Mouse.emit_motion_Event (Site => [Integer (Event.Mouse_Motion.x),
Integer (Event.Mouse_Motion.y)]);
when std_SDL.Events.Mice.Wheel => -- TODO
null;
when std_SDL.Events.Windows.Window =>
declare
use std_SDL.Events.Windows;
begin
if Event.Window.Event_ID = Windows.Resized
then
Self.Size_is (Integer (Event.Window.Data_1),
Integer (Event.Window.Data_2));
end if;
end;
when others => -- TODO
null;
end case;
end loop;
-- SDL_GL_SwapBuffers;
end emit_Events;
overriding
procedure enable_GL (Self : in Item)
is
begin
std_SDL.Video.gl.set_Current (Self.GL_Context, To => Self.window_Handle);
end enable_GL;
overriding
procedure disable_GL (Self : in Item)
is
null_Context : standard.SDL.Video.GL.Contexts;
begin
std_SDL.Video.gl.set_Current (null_Context, To => Self.window_Handle);
end disable_GL;
overriding
procedure swap_GL (Self : in out Item)
is
use std_SDL.Video.GL;
begin
swap (Self.window_Handle);
end swap_GL;
function to_gel_Key (From : in std_SDL.Events.Keyboards.key_Codes) return gel.keyboard.Key
is
package Key renames std_SDL.Events.keyboards;
begin
case From
is
when Key.Code_return => return gel.Keyboard.Enter;
when Key.Code_escape => return gel.Keyboard.Escape;
when Key.Code_backspace => return gel.Keyboard.BackSpace;
when Key.Code_tab => return gel.Keyboard.Tab;
when Key.Code_space => return gel.Keyboard.Space;
when Key.Code_exclamation => return gel.Keyboard.Exclaim;
when Key.Code_double_quote => return gel.Keyboard.QuoteDbl;
when Key.Code_hash => return gel.Keyboard.Hash;
when Key.Code_percent => return gel.Keyboard.Percent;
when Key.Code_dollar => return gel.Keyboard.Dollar;
when Key.Code_ampersand => return gel.Keyboard.Ampersand;
when Key.Code_quote => return gel.Keyboard.Quote;
when Key.Code_left_parenthesis => return gel.Keyboard.leftParen;
when Key.Code_right_parenthesis => return gel.Keyboard.rightParen;
when Key.Code_asterisk => return gel.Keyboard.Asterisk;
when Key.Code_plus => return gel.Keyboard.Plus;
when Key.Code_comma => return gel.Keyboard.Comma;
when Key.Code_minus => return gel.Keyboard.Minus;
when Key.Code_period => return gel.Keyboard.Period;
when Key.Code_slash => return gel.Keyboard.Slash;
when Key.Code_0 => return gel.Keyboard.'0';
when Key.Code_1 => return gel.Keyboard.'1';
when Key.Code_2 => return gel.Keyboard.'2';
when Key.Code_3 => return gel.Keyboard.'3';
when Key.Code_4 => return gel.Keyboard.'4';
when Key.Code_5 => return gel.Keyboard.'5';
when Key.Code_6 => return gel.Keyboard.'6';
when Key.Code_7 => return gel.Keyboard.'7';
when Key.Code_8 => return gel.Keyboard.'8';
when Key.Code_9 => return gel.Keyboard.'9';
when Key.Code_colon => return gel.Keyboard.Colon;
when Key.Code_semi_colon => return gel.Keyboard.semiColon;
when Key.Code_less => return gel.Keyboard.Less;
when Key.Code_equals => return gel.Keyboard.Equals;
when Key.Code_greater => return gel.Keyboard.Greater;
when Key.Code_question => return gel.Keyboard.Question;
when Key.Code_at => return gel.Keyboard.At_key;
when Key.Code_left_bracket => return gel.Keyboard.leftBracket;
when Key.Code_back_slash => return gel.Keyboard.backSlash;
when Key.Code_right_bracket => return gel.Keyboard.rightBracket;
when Key.Code_caret => return gel.Keyboard.Caret;
when Key.Code_underscore => return gel.Keyboard.Underscore;
when Key.Code_back_quote => return gel.Keyboard.backQuote;
when Key.Code_a => return gel.Keyboard.A;
when Key.Code_b => return gel.Keyboard.B;
when Key.Code_c => return gel.Keyboard.C;
when Key.Code_d => return gel.Keyboard.D;
when Key.Code_e => return gel.Keyboard.E;
when Key.Code_f => return gel.Keyboard.F;
when Key.Code_g => return gel.Keyboard.G;
when Key.Code_h => return gel.Keyboard.H;
when Key.Code_i => return gel.Keyboard.I;
when Key.Code_j => return gel.Keyboard.J;
when Key.Code_k => return gel.Keyboard.K;
when Key.Code_l => return gel.Keyboard.L;
when Key.Code_m => return gel.Keyboard.M;
when Key.Code_n => return gel.Keyboard.N;
when Key.Code_o => return gel.Keyboard.O;
when Key.Code_p => return gel.Keyboard.P;
when Key.Code_q => return gel.Keyboard.Q;
when Key.Code_r => return gel.Keyboard.R;
when Key.Code_s => return gel.Keyboard.S;
when Key.Code_t => return gel.Keyboard.T;
when Key.Code_u => return gel.Keyboard.U;
when Key.Code_v => return gel.Keyboard.V;
when Key.Code_w => return gel.Keyboard.W;
when Key.Code_x => return gel.Keyboard.X;
when Key.Code_y => return gel.Keyboard.Y;
when Key.Code_z => return gel.Keyboard.Z;
when Key.Code_caps_lock => return gel.Keyboard.CapsLock;
when Key.Code_F1 => return gel.Keyboard.F1;
when Key.Code_F2 => return gel.Keyboard.F2;
when Key.Code_F3 => return gel.Keyboard.F3;
when Key.Code_F4 => return gel.Keyboard.F4;
when Key.Code_F5 => return gel.Keyboard.F5;
when Key.Code_F6 => return gel.Keyboard.F6;
when Key.Code_F7 => return gel.Keyboard.F7;
when Key.Code_F8 => return gel.Keyboard.F8;
when Key.Code_F9 => return gel.Keyboard.F9;
when Key.Code_F10 => return gel.Keyboard.F10;
when Key.Code_F11 => return gel.Keyboard.F11;
when Key.Code_F12 => return gel.Keyboard.F12;
when Key.Code_print_screen => return gel.Keyboard.Print;
when Key.Code_scroll_lock => return gel.Keyboard.ScrollLock;
when Key.Code_pause => return gel.Keyboard.Pause;
when Key.Code_insert => return gel.Keyboard.Insert;
when Key.Code_home => return gel.Keyboard.Home;
when Key.Code_page_up => return gel.Keyboard.PageUp;
when Key.Code_delete => return gel.Keyboard.Delete;
when Key.Code_end => return gel.Keyboard.End_key;
when Key.Code_page_down => return gel.Keyboard.PageDown;
when Key.Code_right => return gel.Keyboard.Right;
when Key.Code_left => return gel.Keyboard.Left;
when Key.Code_down => return gel.Keyboard.Down;
when Key.Code_up => return gel.Keyboard.Up;
when Key.Code_num_lock_clear => return gel.Keyboard.NumLock;
when Key.Code_KP_divide => return gel.Keyboard.KP_Divide;
when Key.Code_KP_multiply => return gel.Keyboard.KP_Multiply;
when Key.Code_KP_minus => return gel.Keyboard.KP_Minus;
when Key.Code_KP_plus => return gel.Keyboard.KP_Plus;
when Key.Code_KP_enter => return gel.Keyboard.KP_Enter;
when Key.Code_KP_1 => return gel.Keyboard.KP1;
when Key.Code_KP_2 => return gel.Keyboard.KP2;
when Key.Code_KP_3 => return gel.Keyboard.KP3;
when Key.Code_KP_4 => return gel.Keyboard.KP4;
when Key.Code_KP_5 => return gel.Keyboard.KP5;
when Key.Code_KP_6 => return gel.Keyboard.KP6;
when Key.Code_KP_7 => return gel.Keyboard.KP7;
when Key.Code_KP_8 => return gel.Keyboard.KP8;
when Key.Code_KP_9 => return gel.Keyboard.KP9;
when Key.Code_KP_0 => return gel.Keyboard.KP0;
when Key.Code_KP_period => return gel.Keyboard.KP_Period;
-- when Key.Code_application => return gel.Keyboard.;
when Key.Code_power => return gel.Keyboard.Power;
when Key.Code_KP_equals => return gel.Keyboard.KP_Equals;
when Key.Code_F13 => return gel.Keyboard.F13;
when Key.Code_F14 => return gel.Keyboard.F14;
when Key.Code_F15 => return gel.Keyboard.F15;
-- when Key.Code_F16 => return gel.Keyboard.;
-- when Key.Code_F17 => return gel.Keyboard.;
-- when Key.Code_F18 => return gel.Keyboard.;
-- when Key.Code_F19 => return gel.Keyboard.;
-- when Key.Code_F20 => return gel.Keyboard.;
-- when Key.Code_F21 => return gel.Keyboard.;
-- when Key.Code_F22 => return gel.Keyboard.;
-- when Key.Code_F23 => return gel.Keyboard.;
-- when Key.Code_F24 => return gel.Keyboard.;
-- when Key.Code_execute => return gel.Keyboard.;
when Key.Code_help => return gel.Keyboard.Help;
when Key.Code_menu => return gel.Keyboard.Menu;
-- when Key.Code_select => return gel.Keyboard.;
-- when Key.Code_stop => return gel.Keyboard.;
-- when Key.Code_again => return gel.Keyboard.;
when Key.Code_undo => return gel.Keyboard.Undo;
-- when Key.Code_cut => return gel.Keyboard.;
-- when Key.Code_copy => return gel.Keyboard.;
-- when Key.Code_paste => return gel.Keyboard.;
-- when Key.Code_find => return gel.Keyboard.;
-- when Key.Code_mute => return gel.Keyboard.;
-- when Key.Code_volume_up => return gel.Keyboard.;
-- when Key.Code_volume_down => return gel.Keyboard.;
-- when Key.Code_KP_comma => return gel.Keyboard.;
-- when Key.Code_KP_equals_AS400 => return gel.Keyboard.;
-- when Key.Code_alt_erase => return gel.Keyboard.;
when Key.Code_sys_req => return gel.Keyboard.SysReq;
-- when Key.Code_cancel => return gel.Keyboard.;
when Key.Code_clear => return gel.Keyboard.Clear;
-- when Key.Code_prior => return gel.Keyboard.;
-- when Key.Code_return_2 => return gel.Keyboard.;
-- when Key.Code_separator => return gel.Keyboard.;
-- when Key.Code_out => return gel.Keyboard.;
-- when Key.Code_oper => return gel.Keyboard.;
-- when Key.Code_clear_again => return gel.Keyboard.;
-- when Key.Code_CR_sel => return gel.Keyboard.;
-- when Key.Code_Ex_sel => return gel.Keyboard.;
-- when Key.Code_KP_00 => return gel.Keyboard.;
-- when Key.Code_KP_000 => return gel.Keyboard.;
-- when Key.Code_thousands_separator => return gel.Keyboard.;
-- when Key.Code_decimal_separator => return gel.Keyboard.;
-- when Key.Code_currency_unit => return gel.Keyboard.;
-- when Key.Code_KP_left_parenthesis => return gel.Keyboard.;
-- when Key.Code_KP_right_parentheesis => return gel.Keyboard.;
-- when Key.Code_KP_left_brace => return gel.Keyboard.;
-- when Key.Code_KP_right_brace => return gel.Keyboard.;
-- when Key.Code_KP_tab => return gel.Keyboard.;
-- when Key.Code_KP_backspace => return gel.Keyboard.;
-- when Key.Code_KP_A => return gel.Keyboard.;
-- when Key.Code_KP_B => return gel.Keyboard.;
-- when Key.Code_KP_C => return gel.Keyboard.;
-- when Key.Code_KP_D => return gel.Keyboard.;
-- when Key.Code_KP_E => return gel.Keyboard.;
-- when Key.Code_KP_F => return gel.Keyboard.;
-- when Key.Code_KP_xor => return gel.Keyboard.;
-- when Key.Code_KP_power => return gel.Keyboard.;
-- when Key.Code_KP_percent => return gel.Keyboard.;
-- when Key.Code_KP_less => return gel.Keyboard.;
-- when Key.Code_KP_greater => return gel.Keyboard.;
-- when Key.Code_KP_ampersand => return gel.Keyboard.;
-- when Key.Code_KP_double_ampersand => return gel.Keyboard.;
-- when Key.Code_KP_vertical_bar => return gel.Keyboard.;
-- when Key.Code_KP_double_vertical_bar => return gel.Keyboard.;
-- when Key.Code_KP_colon => return gel.Keyboard.;
-- when Key.Code_KP_hash => return gel.Keyboard.;
-- when Key.Code_KP_space => return gel.Keyboard.;
-- when Key.Code_KP_at => return gel.Keyboard.;
-- when Key.Code_KP_exclamation => return gel.Keyboard.;
-- when Key.Code_KP_memory_store => return gel.Keyboard.;
-- when Key.Code_KP_memory_recall => return gel.Keyboard.;
-- when Key.Code_KP_memory_clear => return gel.Keyboard.;
-- when Key.Code_KP_memory_add => return gel.Keyboard.;
-- when Key.Code_KP_memory_subtract => return gel.Keyboard.;
-- when Key.Code_KP_memory_multiply => return gel.Keyboard.;
-- when Key.Code_KP_memory_divide => return gel.Keyboard.;
-- when Key.Code_KP_plus_minus => return gel.Keyboard.;
-- when Key.Code_KP_clear => return gel.Keyboard.;
-- when Key.Code_KP_clear_entry => return gel.Keyboard.;
-- when Key.Code_KP_binary => return gel.Keyboard.;
-- when Key.Code_KP_octal => return gel.Keyboard.;
-- when Key.Code_KP_decimal => return gel.Keyboard.;
-- when Key.Code_KP_hexadecimal => return gel.Keyboard.;
when Key.Code_left_control => return gel.Keyboard.lCtrl;
when Key.Code_left_shift => return gel.Keyboard.lShift;
when Key.Code_left_alt => return gel.Keyboard.lAlt;
-- when Key.Code_left_gui => return gel.Keyboard.;
when Key.Code_right_control => return gel.Keyboard.rCtrl;
when Key.Code_right_shift => return gel.Keyboard.rShift;
when Key.Code_right_alt => return gel.Keyboard.rAlt;
-- when Key.Code_right_gui => return gel.Keyboard.;
-- when Key.Code_mode => return gel.Keyboard.;
-- when Key.Code_audio_next => return gel.Keyboard.;
-- when Key.Code_audio_previous => return gel.Keyboard.;
-- when Key.Code_audio_stop => return gel.Keyboard.;
-- when Key.Code_audio_play => return gel.Keyboard.;
-- when Key.Code_audio_mute => return gel.Keyboard.;
-- when Key.Code_media_select => return gel.Keyboard.;
-- when Key.Code_www => return gel.Keyboard.;
-- when Key.Code_mail => return gel.Keyboard.;
-- when Key.Code_calculator => return gel.Keyboard.;
-- when Key.Code_computer => return gel.Keyboard.;
-- when Key.Code_AC_search => return gel.Keyboard.;
-- when Key.Code_AC_home => return gel.Keyboard.;
-- when Key.Code_AC_back => return gel.Keyboard.;
-- when Key.Code_AC_forward => return gel.Keyboard.;
-- when Key.Code_AC_stop => return gel.Keyboard.;
-- when Key.Code_AC_refresh => return gel.Keyboard.;
-- when Key.Code_AC_bookmarks => return gel.Keyboard.;
-- when Key.Code_brightness_down => return gel.Keyboard.;
-- when Key.Code_brightness_up => return gel.Keyboard.;
-- when Key.Code_display_switch => return gel.Keyboard.;
-- when Key.Code_illumination_toggle => return gel.Keyboard.;
-- when Key.Code_illumination_down => return gel.Keyboard.;
-- when Key.Code_illumination_up => return gel.Keyboard.;
-- when Key.Code_eject => return gel.Keyboard.;
-- when Key.Code_sleep => return gel.Keyboard.;
when others =>
ada.Text_IO.put_Line ("SDL window unhandled key: " & From'Image); -- TODO: Remaining key codes.
end case;
return gel.Keyboard.Key'First;
end to_gel_Key;
-------------------
--- Window Creator
--
function window_Creator (Name : in String;
Width,
Height : in Positive) return gel.Window.view
is
begin
return gel.Window.view (Forge.new_Window (Name, Width, Height));
end window_Creator;
begin
gel.Window.use_create_Window (window_Creator'Access);
end gel.Window.sdl;