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

2
.gitignore vendored
View File

@@ -28,7 +28,7 @@ bin
## Copies
#
3-mid/opengl (copy 1)
4-high/gel (copy *)
## Source
#

92
3-mid/opengl/source/lean/renderer/opengl-renderer-lean.adb
View File

@@ -24,6 +24,9 @@ with
ada.Task_Identification,
ada.unchecked_Deallocation;
with GL.Binding;
-- gdk.GLContext;
package body openGL.Renderer.lean
is
@@ -91,6 +94,7 @@ is
end Context_is;
procedure Context_Setter_is (Self : in out Item; Now : in context_Setter)
is
begin
@@ -98,6 +102,15 @@ is
end Context_Setter_is;
procedure context_Clearer_is (Self : in out Item; Now : in context_Clearer)
is
begin
Self.context_Clearer := Now;
end context_Clearer_is;
procedure Swapper_is (Self : in out Item; Now : in Swapper)
is
begin
@@ -211,9 +224,28 @@ is
-- Engine
--
protected body gl_Lock
is
entry acquire when not Locked
is
begin
Locked := True;
end acquire;
entry release when Locked
is
begin
Locked := False;
end release;
end gl_Lock;
task body Engine
is
the_Context : Context.view with unreferenced;
the_Context : Context.view; -- with unreferenced;
Done : Boolean := False;
begin
@@ -224,9 +256,10 @@ is
end start;
openGL.Tasks.Renderer_Task := ada.Task_Identification.current_Task;
Self.context_Setter.all;
-- Self.context_Setter.all;
Self.Context := the_Context;
put_Line ("openGL Server version: " & Server.Version);
-- put_Line ("openGL Server version: " & Server.Version);
or
accept Stop
@@ -235,9 +268,17 @@ is
end Stop;
end select;
-- put_Line ("renderer CONTEXT 1 " & Self.Context'Image);
gl_Lock.acquire;
Self.context_Setter.all;
openGL.Geometry. lit_textured_skinned.define_Program;
openGL.Geometry.lit_colored_textured_skinned.define_Program;
Self.context_Clearer.all;
gl_Lock.release;
while not Done
loop
@@ -281,6 +322,23 @@ is
exit when Done;
-- declare
-- use gl.Binding;
-- begin
-- gl_Lock.acquire;
-- --gl_Context.make_Current;
-- Self.context_Setter.all;
-- glClearColor (0.0, 1.0, 0.0, 0.0);
-- glClear (GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
-- -- Gdk.GLContext.clear_Current;
-- Self.context_Clearer.all;
-- gl_Lock.release;
-- end;
-- gl_Lock.acquire;
-- Self.context_Setter.all;
-- put_Line ("renderer CONTEXT 2 " & Self.Context'Image);
if new_font_Name /= null_Asset
then
Self.Fonts.insert ((new_font_Name,
@@ -289,25 +347,43 @@ is
elsif new_snapshot_Name /= null_Asset
then
gl_Lock.acquire;
Self.context_Setter.all;
IO.Screenshot (Filename => to_String (new_snapshot_Name),
with_Alpha => snapshot_has_Alpha);
Self.context_Clearer.all;
gl_Lock.release;
else
gl_Lock.acquire;
Self.context_Setter.all;
Self.update_Impostors_and_draw_Visuals (all_Updates (1 .. Length));
Self.free_old_Models;
Self.free_old_Impostors;
Self.is_Busy := False;
if Self.Swapper /= null
and Self.swap_Required
then
Self.Swapper.all;
end if;
Self.context_Clearer.all;
gl_Lock.release;
Self.free_old_Models;
Self.free_old_Impostors;
Self.is_Busy := False;
end if;
-- Self.context_Clearer.all;
-- gl_Lock.release;
end;
end loop;
Self.free_old_Models;
Self.free_old_Impostors;

27
3-mid/opengl/source/lean/renderer/opengl-renderer-lean.ads
View File

@@ -48,12 +48,14 @@ is
function Light (Self : in out Item; Id : in light.Id_t) return openGL.Light.item;
function fetch (Self : in out Item) return openGL.Light.items;
type context_Setter is access procedure;
type Swapper is access procedure;
type context_Setter is access procedure;
type context_Clearer is access procedure;
type Swapper is access procedure;
procedure Context_is (Self : in out Item; Now : in Context.view);
procedure Context_Setter_is (Self : in out Item; Now : in context_Setter);
procedure Swapper_is (Self : in out Item; Now : in Swapper);
procedure Context_is (Self : in out Item; Now : in Context.view);
procedure Context_Setter_is (Self : in out Item; Now : in context_Setter);
procedure Context_Clearer_is (Self : in out Item; Now : in context_Clearer);
procedure Swapper_is (Self : in out Item; Now : in Swapper);
--------------
@@ -88,9 +90,23 @@ is
procedure queue_Visuals (Self : in out Item; the_Visuals : in Visual.views;
the_Camera : access Camera.item'Class);
--- Engine
--
protected gl_Lock
is
entry acquire;
entry release;
private
Locked : Boolean := False;
end gl_Lock;
procedure start_Engine (Self : in out Item);
procedure stop_Engine (Self : in out Item);
procedure render (Self : in out Item; to_Surface : in Surface.view := null);
procedure add_Font (Self : in out Item; font_Id : in Font.font_Id);
procedure Screenshot (Self : in out Item; Filename : in String;
@@ -293,6 +309,7 @@ private
Context : openGL.Context.view;
context_Setter : lean.context_Setter;
context_Clearer : lean.context_Clearer;
Swapper : lean.Swapper;
swap_Required : Boolean;
is_Busy : Boolean := False;

5
3-mid/opengl/source/lean/shader/opengl-attribute.adb
View File

@@ -1,9 +1,11 @@
with
openGL.Tasks,
openGL.Errors,
GL.lean,
System,
ada.unchecked_Conversion;
package body openGL.Attribute
is
use GL.lean;
@@ -103,12 +105,15 @@ is
Tasks.check;
glEnableVertexAttribArray (Index => Self.gl_Location);
openGL.Errors.log;
glVertexAttribPointer (Index => Self.gl_Location,
Size => Self.Size,
the_Type => to_GL (Self.data_Kind),
Normalized => Self.Normalized,
Stride => Self.vertex_Stride,
Ptr => to_GL (Self.Offset));
openGL.Errors.log;
end enable;

401
4-high/gel/applet/demo/game/pong-gtk/launch_pong.adb Normal file
View File

@@ -0,0 +1,401 @@
with
gel.Window.setup,
gel.Window.gtk,
gel.Applet.gui_world,
gel.Forge,
gel.Sprite,
gel.World,
gel.Camera,
gel.Keyboard,
Physics,
openGL.Palette,
openGL.Light,
openGL.Model.text,
openGL.Renderer.lean,
float_Math.Random,
lace.Event,
lace.Response,
lace.Event.utility,
gtk.Box,
gtk.Label,
gtk.Main,
gtk.Window,
gtk.glArea,
ada.Text_IO,
ada.Exceptions;
pragma Unreferenced (gel.Window.setup);
procedure launch_Pong
--
-- Basic pong game.
--
is
use gel.Applet,
gel.Applet.gui_world,
gel.Keyboard,
gel.Math,
openGL.Palette,
gtk.Box,
gtk.Label,
gtk.Window,
ada.Text_IO;
--- GtkAda objects.
--
top_Window : Gtk_Window;
Label : Gtk_Label;
Box : Gtk_Vbox;
begin
-----------------
--- Setup GtkAda.
--
-- Initialize GtkAda.
--
gtk.Main.init;
-- Create a window with a size of 800 x 650.
--
gtk_new (top_Window);
top_Window.set_default_Size (800, 650);
-- Create a box to organize vertically the contents of the window.
--
gtk_New_vBox (Box);
top_Window.add (Box);
-- Add a label.
--
gtk_new (Label, "Hello Pong.");
Box.pack_Start (Label,
Expand => False,
Fill => False,
Padding => 10);
-- Show the window.
--
top_Window.show_All;
declare
--- Applet
--
the_Applet : gel.Applet.gui_world.view
:= gel.Forge.new_gui_Applet (Named => "Pong",
window_Width => 800,
window_Height => 650,
space_Kind => physics.Box2d);
--- Ball
--
the_Ball : constant gel.Sprite.view
:= gel.Forge.new_circle_Sprite (in_World => the_Applet.World,
Site => [0.0, 0.0],
Mass => 1.0,
Bounce => 1.0,
Friction => 0.0,
Radius => 0.5,
Color => Grey,
Texture => openGL.to_Asset ("assets/opengl/texture/Face1.bmp"));
court_Width : constant := 30.0;
court_Height : constant := 20.0;
--- Players
--
type Player is
record
Paddle : gel.Sprite.view;
moving_Up : Boolean := False;
moving_Down : Boolean := False;
Score : Natural := 0;
score_Text : gel.Sprite.view;
score_Model : openGL.Model.text.view;
end record;
type player_Id is range 1 .. 2;
type Players is array (player_Id) of Player;
the_Players : Players;
procedure add_Player (Id : in player_Id;
Site : in Vector_2)
is
the_Player : Player renames the_Players (Id);
score_Site : constant Vector_2 := Site + [0.0, court_Height / 2.0 + 0.8];
begin
the_Player.Paddle := gel.Forge.new_rectangle_Sprite (the_Applet.World,
Site => Site,
Mass => 0.0,
Bounce => 1.0,
Friction => 0.0,
Width => 0.7,
Height => 3.0,
Color => Red);
the_Player.score_Text := gel.Forge.new_text_Sprite (the_Applet.World,
Origin_3D,
" 0",
the_Applet.Font,
Green);
the_Player.score_Model := openGL.Model.text.view (the_Player.score_Text.graphics_Model);
the_Applet.World.add (the_Player.Paddle);
the_Applet.World.add (the_Player.score_Text);
the_Player.score_Text.Site_is (Vector_3 (score_Site & 0.0));
end add_Player;
--- Court Walls
--
procedure add_Wall (Site : in Vector_2;
Width,
Height : in Real)
is
the_Wall : constant gel.Sprite.view
:= gel.Forge.new_rectangle_Sprite (the_Applet.World,
Site => Site,
Mass => 0.0,
Bounce => 1.0,
Friction => 0.0,
Width => Width,
Height => Height,
Color => Blue);
begin
the_Applet.World.add (the_Wall);
end add_Wall;
--- Controls
--
relaunch_Ball : Boolean := True;
--- Events
--
type key_press_Response is new lace.Response.item with null record;
overriding
procedure respond (Self : in out key_press_Response; to_Event : in lace.Event.item'Class)
is
pragma Unreferenced (Self);
the_Event : gel.Keyboard.key_press_Event renames gel.Keyboard.key_press_Event (to_Event);
the_Key : constant gel.keyboard.Key := the_Event.modified_Key.Key;
begin
case the_Key
is
when up => the_Players (2).moving_Up := True;
when down => the_Players (2).moving_Down := True;
when a => the_Players (1).moving_Up := True;
when z => the_Players (1).moving_Down := True;
when SPACE => relaunch_Ball := True;
when others => null;
end case;
end respond;
type key_release_Response is new lace.Response.item with null record;
overriding
procedure respond (Self : in out key_release_Response; to_Event : in lace.Event.item'Class)
is
pragma Unreferenced (Self);
the_Event : gel.Keyboard.key_release_Event renames gel.Keyboard.key_release_Event (to_Event);
the_Key : constant gel.keyboard.Key := the_Event.modified_Key.Key;
begin
case the_Key
is
when up => the_Players (2).moving_Up := False;
when down => the_Players (2).moving_Down := False;
when a => the_Players (1).moving_Up := False;
when z => the_Players (1).moving_Down := False;
when others => null;
end case;
end respond;
function window_gl_Area return gtk.glArea.gtk_glArea
is
begin
return gel.Window.gtk.view (the_Applet.Window).GL_Area;
end window_gl_Area;
use lace.Event.Utility;
the_key_press_Response : aliased key_press_Response;
the_key_release_Response : aliased key_release_Response;
begin
--- Setup the game.
--
Box.pack_Start (window_gl_Area);
-- Show the window and present it.
--
top_Window.Show_All;
top_Window.Present;
the_Applet.Camera. Site_is ([0.0, 0.0, 20.0]);
the_Applet.World.Gravity_is ([0.0, 0.0, 0.0]);
the_Applet.World.add (the_Ball);
-- Set the lights position.
--
declare
Light : openGL.Light.item := the_Applet.Renderer.new_Light;
begin
Light.Site_is ([0.0, -1000.0, 0.0]);
the_Applet.Renderer.set (Light);
end;
--- Add the players.
--
declare
paddle_X_Offset : constant := court_Width / 2.0 - 2.0;
begin
add_Player (1, Site => [-paddle_X_Offset, 0.0]);
add_Player (2, Site => [ paddle_X_Offset, 0.0]);
end;
--- Build the court.
--
declare
Thickness : constant := 1.0; -- Thickness of the walls.
goal_Size : constant := 6.0;
side_wall_Height : constant := (court_Height - goal_Size) / 2.0;
top_wall_Y_Offset : constant := (court_Height - Thickness) / 2.0;
side_wall_X_Offset : constant := court_Width / 2.0;
side_wall_Y_Offset : constant := (side_wall_Height + goal_Size) / 2.0;
begin
add_Wall (Site => [0.0, top_wall_Y_Offset], Width => court_Width, Height => Thickness); -- Top
add_Wall (Site => [0.0, -top_wall_Y_Offset], Width => court_Width, Height => Thickness); -- Bottom
add_Wall (Site => [-side_wall_X_Offset, side_wall_Y_Offset], Width => Thickness, Height => side_wall_Height); -- upper Left
add_Wall (Site => [-side_wall_X_Offset, -side_wall_Y_Offset], Width => Thickness, Height => side_wall_Height); -- lower Left
add_Wall (Site => [ side_wall_X_Offset, side_wall_Y_Offset], Width => Thickness, Height => side_wall_Height); -- upper Right
add_Wall (Site => [ side_wall_X_Offset, -side_wall_Y_Offset], Width => Thickness, Height => side_wall_Height); -- lower Right
end;
-- Connect events.
--
connect ( the_Applet.local_Observer,
the_Applet.Keyboard,
the_key_press_Response'unchecked_Access,
+gel.Keyboard.key_press_Event'Tag);
connect ( the_Applet.local_Observer,
the_Applet.Keyboard,
the_key_release_Response'unchecked_Access,
+gel.Keyboard.key_release_Event'Tag);
--- Main loop.
--
while the_Applet.is_open
loop
the_Applet.World.evolve; -- Advance the world.
the_Applet.freshen; -- Handle any new events and update the screen.
--- Check goal scoring.
--
declare
procedure award_Goal (Id : in player_Id)
is
the_Player : Player renames the_Players (Id);
new_Score : constant String := Natural'Image (the_Player.Score + 1);
begin
relaunch_Ball := True;
the_Player.Score := the_Player.Score + 1;
the_Player.score_Model.Text_is (new_Score);
the_Ball.Site_is (Origin_3d);
the_Ball.Speed_is ([0.0, 0.0, 0.0]);
end award_Goal;
goal_X_Boundary : constant := court_Width / 2.0 + 1.0;
begin
if the_Ball.Site (1) > goal_X_Boundary then award_Goal (Id => 1);
elsif the_Ball.Site (1) < -goal_X_Boundary then award_Goal (Id => 2);
end if;
end;
--- Relauch the ball after a goal has been scored.
--
if relaunch_Ball
then
the_Ball.Site_is ([0.0, 0.0, 0.0]);
declare
the_Force : Vector_3 := [gel.Math.Random.random_Real (50.0, 200.0),
gel.Math.Random.random_Real ( 5.0, 20.0),
0.0];
begin
if gel.Math.Random.random_Boolean
then
the_Force := -the_Force;
end if;
the_Ball.apply_Force (the_Force);
end;
relaunch_Ball := False;
end if;
--- Move the paddles.
--
for the_Player of the_Players
loop
declare
paddle_Speed : constant Vector_3 := [0.0, 0.2, 0.0];
begin
if the_Player.moving_Up then the_Player.Paddle.Site_is (the_Player.Paddle.Site + paddle_Speed); end if;
if the_Player.moving_Down then the_Player.Paddle.Site_is (the_Player.Paddle.Site - paddle_Speed); end if;
end;
end loop;
end loop;
free (the_Applet);
end;
exception
when E : others =>
new_Line;
put_Line ("Unhandled exception in main task !");
put_Line (ada.Exceptions.exception_Information (E));
new_Line;
end launch_Pong;

18
4-high/gel/applet/demo/game/pong-gtk/pong.gpr Normal file
View File

@@ -0,0 +1,18 @@
with
"gel_gtk",
"lace_shared";
project Pong
is
for Object_Dir use "build";
for Exec_Dir use ".";
for Main use ("launch_pong.adb");
for Languages use ("Ada");
package Ide renames Lace_shared.Ide;
package Builder renames Lace_shared.Builder;
package Compiler renames Lace_shared.Compiler;
package Binder renames Lace_shared.Binder;
end Pong;

2
4-high/gel/applet/demo/game/pong/pong.gpr
View File

@@ -1,5 +1,5 @@
with
"gel",
"gel_sdl",
"lace_shared";
project Pong

10
4-high/gel/library/gel.gpr
View File

@@ -3,7 +3,7 @@ with
"opengl",
"collada",
"physics",
"sdlada",
-- "sdlada",
"lace_shared";
--library
@@ -25,7 +25,7 @@ is
"../source/joint",
"../source/applet",
"../source/applet/distributed",
"../source/platform/sdl",
-- "../source/platform/sdl",
"../source/terrain",
"../source/world");
@@ -33,8 +33,8 @@ is
package Builder renames Lace_shared.Builder;
package Compiler renames Lace_shared.Compiler;
package Linker is
for Linker_Options use ("-g", "-lSDL2");
end Linker;
-- package Linker is
-- for Linker_Options use ("-g", "-lSDL2");
-- end Linker;
end GEL;

21
4-high/gel/library/gtk/gel_gtk.gpr Normal file
View File

@@ -0,0 +1,21 @@
with
"gel",
"gtkada",
"lace_shared";
--library
project GEL_gtk
is
for Create_Missing_Dirs use "True";
for Source_Dirs use ("../../source/platform/gtk");
for Object_Dir use "build";
for Library_Dir use "lib";
for Library_Ali_Dir use "objects";
-- for Library_Name use "GEL_gtk";
package Ide renames Lace_shared.Ide;
package Builder renames Lace_shared.Builder;
package Compiler renames Lace_shared.Compiler;
end GEL_gtk;

25
4-high/gel/library/sdl/gel_sdl.gpr Normal file
View File

@@ -0,0 +1,25 @@
with
"gel",
"sdlada",
"lace_shared";
--library
project GEL_sdl
is
for Create_Missing_Dirs use "True";
for Source_Dirs use ("../../source/platform/sdl");
for Object_Dir use "build";
for Library_Dir use "lib";
for Library_Ali_Dir use "objects";
-- for Library_Name use "GEL_sdl";
package Ide renames Lace_shared.Ide;
package Builder renames Lace_shared.Builder;
package Compiler renames Lace_shared.Compiler;
-- package Linker is
-- for Linker_Options use ("-g", "-lSDL2");
-- end Linker;
end GEL_sdl;

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;

2
lace-gpr_paths.sh
View File

@@ -20,6 +20,8 @@ GPR_PROJECT_PATH=$LACE/3-mid/physics/implement/impact/library:$GPR_PROJECT_PATH
GPR_PROJECT_PATH=$LACE/4-high/gel/library:$GPR_PROJECT_PATH
GPR_PROJECT_PATH=$LACE/4-high/gel/library/sdl:$GPR_PROJECT_PATH
GPR_PROJECT_PATH=$LACE/4-high/gel/library/gtk:$GPR_PROJECT_PATH
export GPR_PROJECT_PATH