nichkara/lace
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

gel.window: Add support for a Gtk window.

Browse Source
This commit is contained in:
Rod Kay
2023-11-03 15:21:29 +11:00
parent 6a1d544e10
commit 0b4d19522b
17 changed files with 1340 additions and 26 deletions
Download Patch File Download Diff File Expand all files Collapse all files

12
4-high/gel/source/applet/gel-applet.adb
View File

@@ -31,6 +31,14 @@ is
procedure my_context_Clearer
is
begin
global_Window.disable_GL;
end my_context_Clearer;
procedure my_Swapper
is
begin
@@ -96,7 +104,8 @@ is
Self.Window.disable_GL;
Self.Renderer.Context_Setter_is (my_context_Setter'unrestricted_Access);
Self.Renderer.Context_Setter_is (my_context_Setter 'unrestricted_Access);
Self.Renderer.Context_Clearer_is (my_context_Clearer'unrestricted_Access);
Self.Renderer.start_Engine;
Self.Renderer.add_Font (Self. Font);
@@ -428,6 +437,7 @@ is
begin
Self.Window.emit_Events;
Self.Window.freshen;
Self.Window.swap_GL;
Self .respond;

2
4-high/gel/source/gel-sprite.adb
View File

@@ -1109,7 +1109,7 @@ is
function program_Parameters (Self : in Item) return opengl.Program.Parameters_view
function program_Parameters (Self : in Item) return opengl.Program.Parameters_view
is
begin
return Self.program_Parameters;

9
4-high/gel/source/gel-window.ads
View File

@@ -62,10 +62,11 @@ is
--- Operations
--
procedure emit_Events (Self : in out Item) is null;
procedure enable_GL (Self : in Item) is null;
procedure disable_GL (Self : in Item) is null;
procedure swap_GL (Self : in out Item) is null;
procedure emit_Events (Self : in out Item) is null;
procedure enable_GL (Self : in Item) is null;
procedure disable_GL (Self : in Item) is null;
procedure swap_GL (Self : in out Item) is null;
procedure freshen (Self : in Item) is null;
----------

660
4-high/gel/source/platform/gtk/gel-window-gtk.adb Normal file
View File

@@ -0,0 +1,660 @@
with
openGL.Renderer.lean,
gtk.Widget,
gtk.Main,
gtk.Window,
gtk.Handlers,
gdk.Types.Keysyms,
gdk.Event,
ada.Text_IO;
package body gel.Window.gtk
is
use gdk.Event,
std_gtk.Widget,
std_gtk.Window,
ada.Text_IO;
function to_gel_Key (From : in gdk.Types.gdk_Key_Type) return gel.keyboard.Key;
-------------
--- Callbacks
--
package Callbacks_with_gel_Window_user_Data is new std_gtk.Handlers.user_Callback (gtk_Widget_record,
User_type => gel.Window.gtk.view);
package Callbacks_with_gel_Window_user_Data_and_return_Boolean is new std_Gtk.Handlers.User_Return_Callback (gtk_Widget_record,
Return_type => Boolean,
User_type => Window.gtk.view);
function key_press_Event_Cb (Self : access gtk_Widget_record'Class;
Event : in gdk.Event.gdk_Event;
user_Data : in Window.gtk.view) return Boolean
is
pragma Unreferenced (Self);
gel_Window : Window.gtk.item'Class renames user_Data.all;
begin
-- put_Line ("key_press_Event_Cb ~ " & Event.Key'Image);
gel_Window.Keyboard.emit_key_press_Event (Key => to_gel_Key (Event.Key.keyVal),
key_Code => Integer (Event.Key.hardware_Keycode));
return True;
end key_press_Event_Cb;
function key_release_Event_Cb (Self : access gtk_Widget_record'Class;
Event : in gdk.Event.gdk_Event;
user_Data : in Window.gtk.view) return Boolean
is
pragma Unreferenced (Self);
use type Gdk.Types.Gdk_key_type;
gel_Window : Window.gtk.item'Class renames user_Data.all;
begin
-- put_Line ("key_release_Event_Cb ~ " & Event.Key'Image);
gel_Window.Keyboard.emit_key_release_Event (Key => to_gel_Key (Event.Key.keyVal));
if Event.Key.keyVal = gdk.Types.keySyms.gdk_Escape -- TODO: Make this user-configurable.
then
gel_Window.is_Open := False;
end if;
return True;
end key_release_Event_Cb;
procedure realize_Event_Cb (Widget : access gtk_Widget_Record'Class;
user_Data : in Window.gtk.view)
is
gl_Area : constant std_gtk.glArea.gtk_glArea := std_gtk.glArea.gtk_glArea (Widget);
gel_Window : Window.gtk.item'Class renames user_Data.all;
top_Window : gtk_Window;
begin
-- put_Line ("realize_Event_Cb");
gel_Window.is_Open := True;
top_Window := gtk_Window (gl_Area.get_Toplevel);
Callbacks_with_gel_Window_user_Data_and_return_Boolean.connect (top_Window,
"key_press_event",
Callbacks_with_gel_Window_user_Data_and_return_Boolean.to_Marshaller (key_press_Event_Cb'Access),
user_Data => user_Data);
Callbacks_with_gel_Window_user_Data_and_return_Boolean.connect (top_Window,
"key_release_event",
Callbacks_with_gel_Window_user_Data_and_return_Boolean.to_Marshaller (key_release_Event_Cb'Access),
user_Data => user_Data);
end realize_Event_Cb;
procedure gl_Area_resize_Event_Cb (Widget : access gtk_Widget_record'Class;
user_Data : in Window.gtk.view)
is
gel_Window : Window.gtk.item'Class renames user_Data.all;
Width : constant Integer := Integer (Widget.get_allocated_Width);
Height : constant Integer := Integer (Widget.get_allocated_Height);
begin
-- put_Line ("gl_Area_resize_Event_Cb ~ Height =>" & Height'Image & " Width =>" & Width'Image);
gel_Window.Size_is (Width, Height);
end gl_Area_resize_Event_Cb;
procedure unrealize_Event_Cb (Self : access gtk_Widget_record'Class;
user_Data : in Window.gtk.view)
is
pragma Unreferenced (Self);
gel_Window : Window.gtk.item'Class renames user_Data.all;
begin
-- put_Line ("unrealize_Event_Cb");
gel_Window.is_Open := False;
end unrealize_Event_Cb;
function render_Event_Cb (Self : access std_gtk.glArea .gtk_glArea_record 'Class;
Context : not null access gdk.glContext.gdk_glContext_record'Class) return Boolean
is
pragma Unreferenced (Self, Context);
begin
return True;
end render_Event_Cb;
function Button_press_Event_Cb (Self : access gtk_Widget_record'Class;
Event : in gdk.Event .gdk_Event;
user_Data : in gel.Window.gtk.view) return Boolean
is
pragma Unreferenced (Self);
gel_Window : Window.gtk.item'Class renames user_Data.all;
begin
-- put_Line ("Button_press_Event_Cb ~ Button =>"
-- & Event.Button.Button'Image
-- & " X =>" & Integer (Event.Button.X)'Image
-- & " Y =>" & Integer (Event.Button.Y)'Image);
gel_Window.Mouse.emit_button_press_Event (Button => gel.mouse.button_Id (Event.Button.Button),
Modifiers => gel_Window.Keyboard.Modifiers,
Site => [Integer (Event.Button.X),
Integer (Event.Button.Y)]);
return True;
end Button_press_Event_Cb;
function Button_release_Event_Cb (Self : access gtk_Widget_record'Class;
Event : in gdk.Event .gdk_Event;
user_Data : in gel.Window.gtk.view) return Boolean
is
pragma Unreferenced (Self);
gel_Window : Window.gtk.item'Class renames user_Data.all;
begin
-- put_Line ("Button_release_Event_Cb ~ Button =>"
-- & Event.Button.Button'Image
-- & " X =>" & Integer (Event.Button.X)'Image
-- & " Y =>" & Integer (Event.Button.Y)'Image);
gel_Window.Mouse.emit_button_release_Event (Button => gel.mouse.button_Id (Event.Button.Button),
Modifiers => gel_Window.Keyboard.Modifiers,
Site => [Integer (Event.Button.X),
Integer (Event.Button.Y)]);
return True;
end Button_release_Event_Cb;
function Pointer_motion_Event_Cb (Self : access gtk_Widget_record'Class;
Event : in gdk.Event .gdk_Event;
user_Data : in gel.Window.gtk.view) return Boolean
is
pragma Unreferenced (Self);
gel_Window : Window.gtk.item'Class renames user_Data.all;
begin
-- put_Line ("Pointer_motion_Event_Cb ~ Button =>"
-- & Event.Button.Button'Image
-- & " X =>" & Integer (Event.Button.X)'Image
-- & " Y =>" & Integer (Event.Button.Y)'Image);
-- -- & " X_root =>" & Integer (Event.Button.X_root)'Image
-- -- & " Y_root =>" & Integer (Event.Button.Y_root)'Image);
gel_Window.Mouse.emit_motion_Event (Site => [Integer (Event.Button.X),
Integer (Event.Button.Y)]);
return True;
end Pointer_motion_Event_Cb;
---------
--- Forge
--
procedure define (Self : access Item; Title : in String;
Width : in Natural;
Height : in Natural)
is
pragma Unreferenced (Title, Width, Height);
use std_gtk.glArea,
gdk .glContext;
begin
Self.gl_Area := gtk_glArea_new;
Self.gl_Area.set_use_ES (True);
Callbacks_with_gel_Window_user_Data.connect (Self.gl_Area,
"realize",
Callbacks_with_gel_Window_user_Data.to_Marshaller (realize_Event_Cb'Access),
user_Data => View (Self));
Callbacks_with_gel_Window_user_Data.connect (Self.gl_Area,
"resize",
Callbacks_with_gel_Window_user_Data.to_Marshaller (gl_Area_resize_Event_Cb'Access),
user_Data => View (Self));
Callbacks_with_gel_Window_user_Data.connect (Self.gl_Area,
"unrealize",
Callbacks_with_gel_Window_user_Data.to_Marshaller (unrealize_Event_Cb'Access),
user_Data => View (Self));
Self.gl_Area.on_Render (render_Event_Cb'Access);
Self.gl_Area.add_Events (Button_press_Mask);
Callbacks_with_gel_Window_user_Data_and_return_Boolean.connect (Self.gl_Area,
"button-press-event",
Callbacks_with_gel_Window_user_Data_and_return_Boolean.to_Marshaller (Button_press_Event_Cb'Access),
user_Data => View (Self));
Self.gl_Area.add_Events (Button_release_Mask);
Callbacks_with_gel_Window_user_Data_and_return_Boolean.connect (Self.gl_Area,
"button-release-event",
Callbacks_with_gel_Window_user_Data_and_return_Boolean.to_Marshaller (Button_release_Event_Cb'Access),
user_Data => View (Self));
Self.gl_Area.add_Events (Pointer_Motion_Mask);
Callbacks_with_gel_Window_user_Data_and_return_Boolean.connect (Self.gl_Area,
"motion-notify-event",
Callbacks_with_gel_Window_user_Data_and_return_Boolean.to_Marshaller (Pointer_motion_Event_Cb'Access),
user_Data => View (Self));
Self.gl_Context := Self.gl_Area.get_Context;
end define;
overriding
procedure destroy (Self : in out Item)
is
begin
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.gtk.item
is
begin
return Self : gel.Window.gtk.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.gtk.view
is
Self : constant gel.Window.gtk.view := new Window.gtk.item' (to_Window (Title, Width, Height));
begin
return Self;
end new_Window;
end Forge;
--------------
--- Operations
--
use gel.Keyboard;
function gl_Area (Self : in Item) return std_gtk.GLArea.Gtk_GLArea
is
begin
return Self.gl_Area;
end gl_Area;
-- procedure set_Context (Self : in out Item; To : in gdk.glContext.gdk_glContext)
-- is
-- begin
-- Self.gl_Context := To;
-- end set_Context;
overriding
procedure enable_GL (Self : in Item)
is
use gdk.GLContext;
use type std_gtk.glArea.gtk_GLArea;
begin
-- ada.Text_IO.Put_Line ("gel.window.gtk.enble_GL: attempting to make context current");
if Self.is_Open
and then ( Self.gl_Area /= null
and then Self.gl_Area.get_Context /= null)
then
Self.gl_Area.make_Current;
end if;
end enable_GL;
overriding
procedure disable_GL (Self : in Item)
is
begin
gdk.glContext.clear_Current;
end disable_GL;
overriding
procedure swap_GL (Self : in out Item)
is
begin
null;
end swap_GL;
overriding
procedure freshen (Self : in Item)
is
begin
while std_gtk.Main.Events_pending
loop
declare
Ignore : Boolean;
begin
openGL.Renderer.lean.gl_Lock.acquire;
Ignore := std_gtk.Main.main_Iteration;
openGL.Renderer.lean.gl_Lock.release;
end;
end loop;
if Self.is_Open
then
Self.gl_Area.queue_Render;
end if;
end freshen;
function to_gel_Key (From : in gdk.Types.gdk_Key_Type) return gel.Keyboard.Key
is
package Key renames gdk.Types.keySyms;
begin
case From
is
when Key.GDK_Return => return gel.Keyboard.Enter;
when Key.GDK_Escape => return gel.Keyboard.Escape;
when Key.GDK_Backspace => return gel.Keyboard.BackSpace;
when Key.GDK_Tab => return gel.Keyboard.Tab;
when Key.GDK_Space => return gel.Keyboard.Space;
when Key.GDK_Exclam => return gel.Keyboard.Exclaim;
when Key.GDK_QuoteDbl => return gel.Keyboard.QuoteDbl;
when Key.GDK_NumberSign => return gel.Keyboard.Hash;
when Key.GDK_Percent => return gel.Keyboard.Percent;
when Key.GDK_Dollar => return gel.Keyboard.Dollar;
when Key.GDK_Ampersand => return gel.Keyboard.Ampersand;
when Key.GDK_QuoteRight => return gel.Keyboard.Quote;
when Key.GDK_ParenLeft => return gel.Keyboard.leftParen;
when Key.GDK_ParenRight => return gel.Keyboard.rightParen;
when Key.GDK_Asterisk => return gel.Keyboard.Asterisk;
when Key.GDK_Plus => return gel.Keyboard.Plus;
when Key.GDK_Comma => return gel.Keyboard.Comma;
when Key.GDK_Minus => return gel.Keyboard.Minus;
when Key.GDK_Period => return gel.Keyboard.Period;
when Key.GDK_Slash => return gel.Keyboard.Slash;
when Key.GDK_0 => return gel.Keyboard.'0';
when Key.GDK_1 => return gel.Keyboard.'1';
when Key.GDK_2 => return gel.Keyboard.'2';
when Key.GDK_3 => return gel.Keyboard.'3';
when Key.GDK_4 => return gel.Keyboard.'4';
when Key.GDK_5 => return gel.Keyboard.'5';
when Key.GDK_6 => return gel.Keyboard.'6';
when Key.GDK_7 => return gel.Keyboard.'7';
when Key.GDK_8 => return gel.Keyboard.'8';
when Key.GDK_9 => return gel.Keyboard.'9';
when Key.GDK_colon => return gel.Keyboard.Colon;
when Key.GDK_semicolon => return gel.Keyboard.semiColon;
when Key.GDK_less => return gel.Keyboard.Less;
when Key.GDK_equal => return gel.Keyboard.Equals;
when Key.GDK_greater => return gel.Keyboard.Greater;
when Key.GDK_question => return gel.Keyboard.Question;
when Key.GDK_at => return gel.Keyboard.At_key;
when Key.GDK_bracketLeft => return gel.Keyboard.leftBracket;
when Key.GDK_backslash => return gel.Keyboard.backSlash;
when Key.GDK_bracketRight => return gel.Keyboard.rightBracket;
when Key.GDK_caret => return gel.Keyboard.Caret;
when Key.GDK_underscore => return gel.Keyboard.Underscore;
when Key.GDK_quoteleft => return gel.Keyboard.backQuote;
when Key.GDK_a | Key.GDK_lc_a => return gel.Keyboard.A;
when Key.GDK_b | Key.GDK_lc_b => return gel.Keyboard.B;
when Key.GDK_c | Key.GDK_lc_c => return gel.Keyboard.C;
when Key.GDK_d | Key.GDK_lc_d => return gel.Keyboard.D;
when Key.GDK_e | Key.GDK_lc_e => return gel.Keyboard.E;
when Key.GDK_f | Key.GDK_lc_f => return gel.Keyboard.F;
when Key.GDK_g | Key.GDK_lc_g => return gel.Keyboard.G;
when Key.GDK_h | Key.GDK_lc_h => return gel.Keyboard.H;
when Key.GDK_i | Key.GDK_lc_i => return gel.Keyboard.I;
when Key.GDK_j | Key.GDK_lc_j => return gel.Keyboard.J;
when Key.GDK_k | Key.GDK_lc_k => return gel.Keyboard.K;
when Key.GDK_l | Key.GDK_lc_l => return gel.Keyboard.L;
when Key.GDK_m | Key.GDK_lc_m => return gel.Keyboard.M;
when Key.GDK_n | Key.GDK_lc_n => return gel.Keyboard.N;
when Key.GDK_o | Key.GDK_lc_o => return gel.Keyboard.O;
when Key.GDK_p | Key.GDK_lc_p => return gel.Keyboard.P;
when Key.GDK_q | Key.GDK_lc_q => return gel.Keyboard.Q;
when Key.GDK_r | Key.GDK_lc_r => return gel.Keyboard.R;
when Key.GDK_s | Key.GDK_lc_s => return gel.Keyboard.S;
when Key.GDK_t | Key.GDK_lc_t => return gel.Keyboard.T;
when Key.GDK_u | Key.GDK_lc_u => return gel.Keyboard.U;
when Key.GDK_v | Key.GDK_lc_v => return gel.Keyboard.V;
when Key.GDK_w | Key.GDK_lc_w => return gel.Keyboard.W;
when Key.GDK_x | Key.GDK_lc_x => return gel.Keyboard.X;
when Key.GDK_y | Key.GDK_lc_y => return gel.Keyboard.Y;
when Key.GDK_z | Key.GDK_lc_z => return gel.Keyboard.Z;
when Key.GDK_caps_lock => return gel.Keyboard.CapsLock;
when Key.GDK_F1 => return gel.Keyboard.F1;
when Key.GDK_F2 => return gel.Keyboard.F2;
when Key.GDK_F3 => return gel.Keyboard.F3;
when Key.GDK_F4 => return gel.Keyboard.F4;
when Key.GDK_F5 => return gel.Keyboard.F5;
when Key.GDK_F6 => return gel.Keyboard.F6;
when Key.GDK_F7 => return gel.Keyboard.F7;
when Key.GDK_F8 => return gel.Keyboard.F8;
when Key.GDK_F9 => return gel.Keyboard.F9;
when Key.GDK_F10 => return gel.Keyboard.F10;
when Key.GDK_F11 => return gel.Keyboard.F11;
when Key.GDK_F12 => return gel.Keyboard.F12;
when Key.GDK_print => return gel.Keyboard.Print;
when Key.GDK_scroll_lock => return gel.Keyboard.ScrollLock;
when Key.GDK_pause => return gel.Keyboard.Pause;
when Key.GDK_insert => return gel.Keyboard.Insert;
when Key.GDK_home => return gel.Keyboard.Home;
when Key.GDK_page_up => return gel.Keyboard.PageUp;
when Key.GDK_delete => return gel.Keyboard.Delete;
when Key.GDK_end => return gel.Keyboard.End_key;
when Key.GDK_page_down => return gel.Keyboard.PageDown;
when Key.GDK_right => return gel.Keyboard.Right;
when Key.GDK_left => return gel.Keyboard.Left;
when Key.GDK_down => return gel.Keyboard.Down;
when Key.GDK_up => return gel.Keyboard.Up;
when Key.GDK_num_lock => return gel.Keyboard.NumLock;
when Key.GDK_KP_Divide => return gel.Keyboard.KP_Divide;
when Key.GDK_KP_Multiply => return gel.Keyboard.KP_Multiply;
when Key.GDK_KP_Subtract => return gel.Keyboard.KP_Minus;
when Key.GDK_KP_Add => return gel.Keyboard.KP_Plus;
when Key.GDK_KP_Enter => return gel.Keyboard.KP_Enter;
when Key.GDK_KP_1 => return gel.Keyboard.KP1;
when Key.GDK_KP_2 => return gel.Keyboard.KP2;
when Key.GDK_KP_3 => return gel.Keyboard.KP3;
when Key.GDK_KP_4 => return gel.Keyboard.KP4;
when Key.GDK_KP_5 => return gel.Keyboard.KP5;
when Key.GDK_KP_6 => return gel.Keyboard.KP6;
when Key.GDK_KP_7 => return gel.Keyboard.KP7;
when Key.GDK_KP_8 => return gel.Keyboard.KP8;
when Key.GDK_KP_9 => return gel.Keyboard.KP9;
when Key.GDK_KP_0 => return gel.Keyboard.KP0;
when Key.GDK_KP_Decimal => return gel.Keyboard.KP_Period;
-- when Key.GDK_application => return gel.Keyboard.;
-- when Key.GDK_power => return gel.Keyboard.Power;
when Key.GDK_KP_equal => return gel.Keyboard.KP_Equals;
when Key.GDK_F13 => return gel.Keyboard.F13;
when Key.GDK_F14 => return gel.Keyboard.F14;
when Key.GDK_F15 => return gel.Keyboard.F15;
-- when Key.GDK_F16 => return gel.Keyboard.;
-- when Key.GDK_F17 => return gel.Keyboard.;
-- when Key.GDK_F18 => return gel.Keyboard.;
-- when Key.GDK_F19 => return gel.Keyboard.;
-- when Key.GDK_F20 => return gel.Keyboard.;
-- when Key.GDK_F21 => return gel.Keyboard.;
-- when Key.GDK_F22 => return gel.Keyboard.;
-- when Key.GDK_F23 => return gel.Keyboard.;
-- when Key.GDK_F24 => return gel.Keyboard.;
-- when Key.GDK_execute => return gel.Keyboard.;
when Key.GDK_help => return gel.Keyboard.Help;
when Key.GDK_menu => return gel.Keyboard.Menu;
-- when Key.GDK_select => return gel.Keyboard.;
-- when Key.GDK_stop => return gel.Keyboard.;
-- when Key.GDK_again => return gel.Keyboard.;
when Key.GDK_undo => return gel.Keyboard.Undo;
-- when Key.GDK_cut => return gel.Keyboard.;
-- when Key.GDK_copy => return gel.Keyboard.;
-- when Key.GDK_paste => return gel.Keyboard.;
-- when Key.GDK_find => return gel.Keyboard.;
-- when Key.GDK_mute => return gel.Keyboard.;
-- when Key.GDK_volume_up => return gel.Keyboard.;
-- when Key.GDK_volume_down => return gel.Keyboard.;
-- when Key.GDK_KP_comma => return gel.Keyboard.;
-- when Key.GDK_KP_equals_AS400 => return gel.Keyboard.;
-- when Key.GDK_alt_erase => return gel.Keyboard.;
when Key.GDK_sys_req => return gel.Keyboard.SysReq;
-- when Key.GDK_cancel => return gel.Keyboard.;
when Key.GDK_clear => return gel.Keyboard.Clear;
-- when Key.GDK_prior => return gel.Keyboard.;
-- when Key.GDK_return_2 => return gel.Keyboard.;
-- when Key.GDK_separator => return gel.Keyboard.;
-- when Key.GDK_out => return gel.Keyboard.;
-- when Key.GDK_oper => return gel.Keyboard.;
-- when Key.GDK_clear_again => return gel.Keyboard.;
-- when Key.GDK_CR_sel => return gel.Keyboard.;
-- when Key.GDK_Ex_sel => return gel.Keyboard.;
-- when Key.GDK_KP_00 => return gel.Keyboard.;
-- when Key.GDK_KP_000 => return gel.Keyboard.;
-- when Key.GDK_thousands_separator => return gel.Keyboard.;
-- when Key.GDK_decimal_separator => return gel.Keyboard.;
-- when Key.GDK_currency_unit => return gel.Keyboard.;
-- when Key.GDK_KP_left_parenthesis => return gel.Keyboard.;
-- when Key.GDK_KP_right_parentheesis => return gel.Keyboard.;
-- when Key.GDK_KP_left_brace => return gel.Keyboard.;
-- when Key.GDK_KP_right_brace => return gel.Keyboard.;
-- when Key.GDK_KP_tab => return gel.Keyboard.;
-- when Key.GDK_KP_backspace => return gel.Keyboard.;
-- when Key.GDK_KP_A => return gel.Keyboard.;
-- when Key.GDK_KP_B => return gel.Keyboard.;
-- when Key.GDK_KP_C => return gel.Keyboard.;
-- when Key.GDK_KP_D => return gel.Keyboard.;
-- when Key.GDK_KP_E => return gel.Keyboard.;
-- when Key.GDK_KP_F => return gel.Keyboard.;
-- when Key.GDK_KP_xor => return gel.Keyboard.;
-- when Key.GDK_KP_power => return gel.Keyboard.;
-- when Key.GDK_KP_percent => return gel.Keyboard.;
-- when Key.GDK_KP_less => return gel.Keyboard.;
-- when Key.GDK_KP_greater => return gel.Keyboard.;
-- when Key.GDK_KP_ampersand => return gel.Keyboard.;
-- when Key.GDK_KP_double_ampersand => return gel.Keyboard.;
-- when Key.GDK_KP_vertical_bar => return gel.Keyboard.;
-- when Key.GDK_KP_double_vertical_bar => return gel.Keyboard.;
-- when Key.GDK_KP_colon => return gel.Keyboard.;
-- when Key.GDK_KP_hash => return gel.Keyboard.;
-- when Key.GDK_KP_space => return gel.Keyboard.;
-- when Key.GDK_KP_at => return gel.Keyboard.;
-- when Key.GDK_KP_exclamation => return gel.Keyboard.;
-- when Key.GDK_KP_memory_store => return gel.Keyboard.;
-- when Key.GDK_KP_memory_recall => return gel.Keyboard.;
-- when Key.GDK_KP_memory_clear => return gel.Keyboard.;
-- when Key.GDK_KP_memory_add => return gel.Keyboard.;
-- when Key.GDK_KP_memory_subtract => return gel.Keyboard.;
-- when Key.GDK_KP_memory_multiply => return gel.Keyboard.;
-- when Key.GDK_KP_memory_divide => return gel.Keyboard.;
-- when Key.GDK_KP_plus_minus => return gel.Keyboard.;
-- when Key.GDK_KP_clear => return gel.Keyboard.;
-- when Key.GDK_KP_clear_entry => return gel.Keyboard.;
-- when Key.GDK_KP_binary => return gel.Keyboard.;
-- when Key.GDK_KP_octal => return gel.Keyboard.;
-- when Key.GDK_KP_decimal => return gel.Keyboard.;
-- when Key.GDK_KP_hexadecimal => return gel.Keyboard.;
when Key.GDK_control_L => return gel.Keyboard.lCtrl;
when Key.GDK_shift_L => return gel.Keyboard.lShift;
when Key.GDK_alt_L => return gel.Keyboard.lAlt;
when Key.GDK_control_R => return gel.Keyboard.rCtrl;
when Key.GDK_shift_R => return gel.Keyboard.rShift;
when Key.GDK_alt_R => return gel.Keyboard.rAlt;
-- when Key.GDK_left_gui => return gel.Keyboard.;
-- when Key.GDK_right_gui => return gel.Keyboard.;
-- when Key.GDK_mode => return gel.Keyboard.;
-- when Key.GDK_audio_next => return gel.Keyboard.;
-- when Key.GDK_audio_previous => return gel.Keyboard.;
-- when Key.GDK_audio_stop => return gel.Keyboard.;
-- when Key.GDK_audio_play => return gel.Keyboard.;
-- when Key.GDK_audio_mute => return gel.Keyboard.;
-- when Key.GDK_media_select => return gel.Keyboard.;
-- when Key.GDK_www => return gel.Keyboard.;
-- when Key.GDK_mail => return gel.Keyboard.;
-- when Key.GDK_calculator => return gel.Keyboard.;
-- when Key.GDK_computer => return gel.Keyboard.;
-- when Key.GDK_AC_search => return gel.Keyboard.;
-- when Key.GDK_AC_home => return gel.Keyboard.;
-- when Key.GDK_AC_back => return gel.Keyboard.;
-- when Key.GDK_AC_forward => return gel.Keyboard.;
-- when Key.GDK_AC_stop => return gel.Keyboard.;
-- when Key.GDK_AC_refresh => return gel.Keyboard.;
-- when Key.GDK_AC_bookmarks => return gel.Keyboard.;
-- when Key.GDK_brightness_down => return gel.Keyboard.;
-- when Key.GDK_brightness_up => return gel.Keyboard.;
-- when Key.GDK_display_switch => return gel.Keyboard.;
-- when Key.GDK_illumination_toggle => return gel.Keyboard.;
-- when Key.GDK_illumination_down => return gel.Keyboard.;
-- when Key.GDK_illumination_up => return gel.Keyboard.;
-- when Key.GDK_eject => return gel.Keyboard.;
-- when Key.GDK_sleep => return gel.Keyboard.;
when others =>
ada.Text_IO.put_Line ("Gtk 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.gtk;

72
4-high/gel/source/platform/gtk/gel-window-gtk.ads Normal file
View File

@@ -0,0 +1,72 @@
with
gtk.glArea;
private
with
gdk.glContext;
package gel.Window.gtk
--
-- Provides a GTK implementation of a window.
--
is
type Item is new gel.Window.item with private;
type View is access all Item'Class;
---------
--- Forge
--
procedure define (Self : access Item; Title : in String;
Width : in Natural;
Height : in Natural);
overriding
procedure destroy (Self : in out Item);
package Forge
is
function new_Window (Title : in String;
Width : in Natural;
Height : in Natural) return Window.gtk.view;
end Forge;
--------------
--- Attributes
--
package std_gtk renames standard.GTK;
function gl_Area (Self : in Item) return std_gtk.GLArea.Gtk_GLArea;
--------------
--- Operations
--
overriding
procedure enable_GL (Self : in Item);
overriding
procedure disable_GL (Self : in Item);
overriding
procedure swap_GL (Self : in out Item);
overriding
procedure freshen (Self : in Item);
private
type Item is new gel.Window.item with
record
gl_Area : std_gtk.glArea .gtk_glArea;
gl_Context : gdk.glContext.gdk_glContext;
end record;
end gel.Window.gtk;

6
4-high/gel/source/platform/gtk/gel-window-setup.ads Normal file
View File

@@ -0,0 +1,6 @@
with
gel.Window.gtk;
package gel.Window.setup
renames gel.Window.gtk;