gel.window: Add support for a Gtk window.

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

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;

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;