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

Add initial prototype.

Browse Source
This commit is contained in:
Rod Kay
2022-07-31 17:34:54 +10:00
commit 54a53b2ac0
1421 changed files with 358874 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

67
3-mid/opengl/source/platform/egl/opengl-context.adb Normal file
View File

@@ -0,0 +1,67 @@
with
opengl.Display .privvy,
opengl.surface_Profile.privvy,
opengl.Surface .privvy,
egl.Binding,
System;
package body openGL.Context
is
use egl.Binding,
System;
procedure define (Self : in out Item; the_Display : access opengl.Display.item'Class;
the_surface_Profile : in opengl.surface_Profile.item)
is
use EGL,
opengl.Display .privvy,
opengl.surface_Profile.privvy;
contextAttribs : EGLint_array := [EGL_CONTEXT_CLIENT_VERSION, 2,
EGL_NONE];
begin
Self.egl_Context := eglCreateContext (to_eGL (the_Display.all),
to_eGL (the_surface_Profile),
EGL_NO_CONTEXT,
contextAttribs (contextAttribs'First)'Unchecked_Access);
if Self.egl_Context = EGL_NO_CONTEXT then
raise opengl.Error with "Unable to create an EGL Context.";
end if;
Self.Display := the_Display;
end define;
procedure make_Current (Self : in Item; read_Surface : in opengl.Surface.item;
write_Surface : in opengl.Surface.item)
is
use eGL,
opengl.Display.privvy,
opengl.Surface.privvy;
use type EGLBoolean;
Success : constant EGLBoolean := eglmakeCurrent (to_eGL (Self.Display.all),
to_eGL (read_Surface),
to_eGL (write_Surface),
Self.egl_Context);
begin
if Success = EGL_FALSE then
raise openGL.Error with "unable to make egl Context current";
end if;
end make_Current;
function egl_Context_debug (Self : in Item'Class) return egl.EGLConfig
is
begin
return self.egl_Context;
end egl_Context_debug;
end openGL.Context;

37
3-mid/opengl/source/platform/egl/opengl-context.ads Normal file
View File

@@ -0,0 +1,37 @@
with
openGL.Display,
openGL.surface_Profile,
openGL.Surface,
EGL;
package openGL.Context
--
-- Models an openGL context.
--
is
-- pragma Pure;
type Item is tagged private;
type View is access all Item'Class;
procedure define (Self : in out Item; the_Display : access opengl.Display.item'Class;
the_surface_Profile : in opengl.surface_Profile.item);
procedure make_Current (Self : in Item; read_Surface : in opengl.Surface.item;
write_Surface : in opengl.Surface.item);
function egl_Context_debug
(Self : in Item'Class) return egl.EGLConfig; -- tbd: move this to privvy pkg.
private
type Item is tagged
record
egl_Context : aliased egl.EGLContext;
Display : access opengl.Display.item'Class;
end record;
end openGL.Context;

44
3-mid/opengl/source/platform/egl/opengl-display.adb Normal file
View File

@@ -0,0 +1,44 @@
with eGL.Binding,
eGL.Pointers,
System;
package body openGL.Display
is
use eGL,
eGL.Binding,
eGL.Pointers;
function Default return Item
is
use type System.Address, eGL.EGLBoolean;
the_Display : Display.item;
Success : EGLBoolean;
Status : EGLBoolean;
begin
the_Display.Thin := eglGetDisplay (Display_Pointer (EGL_DEFAULT_DISPLAY));
if the_Display.Thin = egl_NO_DISPLAY then
raise openGL.Error with "Failed to open the default Display with eGL.";
end if;
Success := eglInitialize (the_Display.Thin, the_Display.Version_major'Unchecked_Access,
the_Display.Version_minor'Unchecked_Access);
if Success = egl_False then
raise openGL.Error with "Failed to initialise eGL using the default Display.";
end if;
Status := eglBindAPI (EGL_OPENGL_ES_API);
return the_Display;
end Default;
end openGL.Display;

29
3-mid/opengl/source/platform/egl/opengl-display.ads Normal file
View File

@@ -0,0 +1,29 @@
private
with
eGL;
package openGL.Display
--
-- Models an openGL display.
--
is
type Item is tagged private;
function Default return Item;
private
type Item is tagged
record
Thin : eGL.EGLDisplay;
Version_major,
Version_minor : aliased eGL.EGLint;
end record;
end openGL.Display;

21
3-mid/opengl/source/platform/egl/opengl-screen.adb Normal file
View File

@@ -0,0 +1,21 @@
package body openGL.Screen
is
-- function Thin (Self : in Item) return xcb.xcb_screen_t.Pointer
-- is
-- begin
-- return Self.Thin;
-- end Thin;
-- procedure Thin_is (Self : in out Item; Now : in xcb.xcb_screen_t.Pointer)
-- is
-- begin
-- Self.Thin := Now;
-- end Thin_is;
procedure dummy is begin null; end dummy;
end openGL.Screen;

24
3-mid/opengl/source/platform/egl/opengl-screen.ads Normal file
View File

@@ -0,0 +1,24 @@
package openGL.Screen
--
-- Models an openGL screen.
--
is
type Item is tagged limited private;
-- function Thin (Self : in Item) return xcb.xcb_screen_t.Pointer;
-- procedure Thin_is (Self : in out Item; Now : in xcb.xcb_screen_t.Pointer);
private
type Item is tagged limited
record
null; -- Thin : xcb.xcb_screen_t.Pointer;
end record;
procedure dummy;
end openGL.Screen;

58
3-mid/opengl/source/platform/egl/opengl-surface.adb Normal file
View File

@@ -0,0 +1,58 @@
with
opengl.surface_Profile.privvy,
opengl.Display .privvy,
eGL.Binding,
interfaces.c.Strings,
System;
package body opengl.Surface
is
use eGL.Binding;
-- Forge
--
procedure define (Self : in out Item; surface_Profile : in opengl.surface_Profile.item'Class;
Display : in opengl.Display.Item;
Window_Id : in Natural)
is
use opengl.Display .privvy,
opengl.surface_Profile.privvy,
System;
begin
Self.egl_Surface := eglCreateWindowSurface (to_eGL (Display),
to_eGL (surface_Profile),
egl.NativeWindowType (Window_Id),
null); -- const EGLint *attribList);
if self.egl_Surface = EGL_NO_SURFACE then
raise opengl.Error with "unable to create an EGL surface for a window";
end if;
Self.Display := Display;
end define;
-- Operations
--
procedure swap_Buffers (Self : in Item)
is
use openGL.Display.privvy,
eGL;
use type EGLBoolean;
Success : egl.EGLBoolean;
begin
Success := eglSwapBuffers (to_eGL (Self.Display),
Self.egl_Surface);
if Success = EGL_FALSE then
raise opengl.Error with "unable to swap egl buffers";
end if;
end swap_Buffers;
end opengl.Surface;

43
3-mid/opengl/source/platform/egl/opengl-surface.ads Normal file
View File

@@ -0,0 +1,43 @@
with
opengl.surface_Profile,
opengl.Display;
private
with
eGL;
package opengl.Surface
--
-- Models an openGL surface.
--
is
type Item is tagged private;
type Items is array (Positive range <>) of aliased Item;
type View is access all Item'class;
type Views is array (Positive range <>) of View;
-- Forge
--
procedure define (Self : in out Item; surface_Profile : in opengl.surface_Profile.item'Class;
Display : in opengl.Display.item;
Window_Id : in Natural);
-- Operations
--
procedure swap_Buffers (Self : in Item);
private
type Item is tagged
record
egl_Surface : egl.EGLSurface;
Display : openGL.Display.item;
end record;
end opengl.Surface;

251
3-mid/opengl/source/platform/egl/opengl-surface_profile.adb Normal file
View File

@@ -0,0 +1,251 @@
with eGL.binding;
with openGL.Display.privvy;
with Interfaces.C;
package body opengl.surface_Profile
is
use openGL.Display.privvy,
eGL,
eGL.Binding,
Interfaces;
subtype egl_attribute_List is EGLint_array;
function to_egl_Attributes (Desired : Qualities) return egl_attribute_List
is
use C;
the_Attributes : egl_attribute_List (1 .. 50);
Count : c.size_t := 0;
procedure add (Attribute : in EGLint;
Value : in EGLint)
is
begin
Count := Count + 1; the_Attributes (Count) := Attribute;
Count := Count + 1; the_Attributes (Count) := Value;
end add;
begin
add (EGL_SURFACE_TYPE, EGL_WINDOW_BIT);
add (EGL_RENDERABLE_TYPE, EGL_OPENGL_ES2_BIT);
if desired.color_Buffer.Bits_blue /= Irrelevant then
add (EGL_BLUE_SIZE,
EGLint (desired.color_Buffer.Bits_blue));
end if;
if desired.color_Buffer.Bits_green /= Irrelevant then
add (EGL_GREEN_SIZE,
EGLint (desired.color_Buffer.Bits_green));
end if;
if desired.color_Buffer.Bits_luminence /= Irrelevant then
add (EGL_LUMINANCE_SIZE,
EGLint (desired.color_Buffer.Bits_luminence));
end if;
if desired.color_Buffer.Bits_alpha /= Irrelevant then
add (EGL_ALPHA_SIZE,
EGLint (desired.color_Buffer.Bits_alpha));
end if;
if desired.color_Buffer.Bits_alpha_mask /= Irrelevant then
add (EGL_ALPHA_MASK_SIZE,
EGLint (desired.color_Buffer.Bits_alpha_mask));
end if;
if desired.depth_buffer_Bits /= Irrelevant then
add (EGL_DEPTH_SIZE,
EGLint (desired.depth_buffer_Bits));
end if;
if desired.stencil_buffer_Bits /= Irrelevant then
add (EGL_STENCIL_SIZE,
EGLint (desired.stencil_buffer_Bits));
end if;
Count := Count + 1;
the_Attributes (Count) := EGL_NONE; -- add 'end-of-list' token
return the_Attributes (1 .. Count);
end to_egl_Attributes;
procedure define (Self : in out Item; the_Display : access opengl.Display.item'Class;
Screen : access openGL.Screen .item'Class;
Desired : in Qualities := default_Qualities)
is
use C;
config_Count : aliased EGLint;
attribList : egl_attribute_List := to_egl_Attributes (Desired);
Success : EGLBoolean;
begin
Self.Display := the_Display;
Success := eglChooseConfig (to_eGL (the_Display.all),
attribList (attribList'First)'Unchecked_Access,
self.egl_Config 'Unchecked_Access,
1,
config_Count 'Unchecked_Access);
if Success = EGL_FALSE then
raise opengl.Error with "eglChooseConfig failed";
end if;
if config_Count = 0 then
raise desired_Qualitites_unavailable;
end if;
end define;
function fetch_All (the_Display : access opengl.Display.item'class) return surface_Profile.items
is
use type EGLBoolean;
Count : aliased EGLint;
Success : EGLBoolean := eglGetConfigs (to_eGL (the_Display.all),
null,
1,
Count'Unchecked_Access);
begin
if Success = EGL_FALSE then
raise opengl.Error with "Failed to get egl Config count.";
end if;
if Count = 0 then
raise opengl.Error with "Found zero egl Configs.";
end if;
declare
egl_Configs : array (1 .. Count) of aliased EGLConfig;
the_Profiles : surface_Profile.items (1 .. Positive (Count));
begin
Success := eglGetConfigs (to_eGL (the_Display.all),
egl_Configs (1)'Unchecked_Access,
Count,
Count'Unchecked_Access);
if Success = EGL_FALSE then
raise opengl.Error with "Failed to get egl Configs.";
end if;
for Each in the_Profiles'Range
loop
the_Profiles (Each).egl_Config := egl_Configs (EGLint (Each));
the_Profiles (Each).Display := the_Display;
end loop;
return the_Profiles;
end;
end fetch_All;
function Quality (Self : in Item) return Qualities
is
the_Qualities : Qualities;
Success : EGLBoolean;
Value : aliased EGLint;
procedure check_Success
is
use type EGLBoolean;
begin
if Success = EGL_FALSE then
raise openGL.Error with "Unable to get eGL surface configuration attribute.";
end if;
end check_Success;
procedure set_Value (Attribute : out Natural)
is
begin
if Value = EGL_DONT_CARE then
Attribute := Irrelevant;
else
Attribute := Natural (Value);
end if;
end set_Value;
begin
Success := eglGetConfigAttrib (to_eGL (Self.Display.all), Self.egl_Config, EGL_RED_SIZE, Value'Unchecked_Access);
check_Success;
set_Value (the_Qualities.color_Buffer.Bits_red);
Success := eglGetConfigAttrib (to_eGL (Self.Display.all), Self.egl_Config, EGL_GREEN_SIZE, Value'Unchecked_Access);
check_Success;
set_Value (the_Qualities.color_Buffer.Bits_green);
Success := eglGetConfigAttrib (to_eGL (Self.Display.all), Self.egl_Config, EGL_BLUE_SIZE, Value'Unchecked_Access);
check_Success;
set_Value (the_Qualities.color_Buffer.Bits_blue);
Success := eglGetConfigAttrib (to_eGL (Self.Display.all), Self.egl_Config, EGL_LUMINANCE_SIZE, Value'Unchecked_Access);
check_Success;
set_Value (the_Qualities.color_Buffer.Bits_luminence);
Success := eglGetConfigAttrib (to_eGL (Self.Display.all), Self.egl_Config, EGL_ALPHA_SIZE, Value'Unchecked_Access);
check_Success;
set_Value (the_Qualities.color_Buffer.Bits_alpha);
Success := eglGetConfigAttrib (to_eGL (Self.Display.all), Self.egl_Config, EGL_ALPHA_MASK_SIZE, Value'Unchecked_Access);
check_Success;
set_Value (the_Qualities.color_Buffer.Bits_alpha_mask);
Success := eglGetConfigAttrib (to_eGL (Self.Display.all), Self.egl_Config, EGL_DEPTH_SIZE, Value'Unchecked_Access);
check_Success;
set_Value (the_Qualities.depth_buffer_Bits);
Success := eglGetConfigAttrib (to_eGL (Self.Display.all), Self.egl_Config, EGL_STENCIL_SIZE, Value'Unchecked_Access);
check_Success;
set_Value (the_Qualities.stencil_buffer_Bits);
return the_Qualities;
end Quality;
function value_Image (Value : in Natural) return String
is
begin
if Value = Irrelevant then
return "Irrelevant";
else
return Natural'Image (Value);
end if;
end value_Image;
function Image (Self : in color_Buffer) return String
is
begin
return
"Bits_red =>" & value_Image (Self.Bits_red)
& " Bits_green =>" & value_Image (Self.Bits_green)
& " Bits_blue =>" & value_Image (Self.Bits_blue)
& " Bits_luminence =>" & value_Image (Self.Bits_luminence)
& " Bits_alpha =>" & value_Image (Self.Bits_alpha)
& " Bits_alpha_mask =>" & value_Image (Self.Bits_alpha_mask);
end Image;
function Image (Self : in Qualities) return String
is
begin
return
Image (Self.color_Buffer)
& " depth_buffer_Bits =>" & value_Image (Self.depth_buffer_Bits)
& " stencil_buffer_Bits => " & value_Image (Self.stencil_buffer_Bits);
end Image;
end opengl.surface_Profile;

93
3-mid/opengl/source/platform/egl/opengl-surface_profile.ads Normal file
View File

@@ -0,0 +1,93 @@
with
openGL.Display,
openGL.Screen;
private
with
eGL;
package opengl.surface_Profile
--
-- Models an openGL surface profile.
--
is
type Item is tagged private;
type View is access all Item'Class;
type Items is array (Positive range <>) of Item;
-- Surface Quality
--
Irrelevant : constant Natural := Natural'Last;
type color_Buffer is
record
Bits_red : Natural := Irrelevant;
Bits_green : Natural := Irrelevant;
Bits_blue : Natural := Irrelevant;
Bits_luminence : Natural := Irrelevant;
Bits_alpha : Natural := Irrelevant;
Bits_alpha_mask : Natural := Irrelevant;
end record;
function Image (Self : in color_Buffer) return String;
type Qualities is
record
color_Buffer : surface_Profile.color_Buffer;
depth_buffer_Bits : Natural := Irrelevant;
stencil_buffer_Bits : Natural := Irrelevant;
end record;
function Image (Self : in Qualities) return String;
default_Qualities : constant Qualities;
-- Forge
--
desired_Qualitites_unavailable : exception;
procedure define (Self : in out Item; the_Display : access opengl.Display.item'Class;
Screen : access openGL.Screen .item'Class;
Desired : in Qualities := default_Qualities);
function fetch_All (the_Display : access opengl.Display.item'Class) return surface_Profile.items;
-- Attributes
--
function Quality (Self : in Item) return Qualities;
private
type Item is tagged
record
egl_Config : aliased egl.EGLConfig;
Display : access opengl.Display.item'Class;
end record;
default_Qualities : constant Qualities := (color_Buffer => (Bits_red => 8,
Bits_green => 8,
Bits_blue => 8,
Bits_luminence => Irrelevant,
Bits_alpha => Irrelevant,
Bits_alpha_mask => Irrelevant),
depth_buffer_Bits => 24,
stencil_buffer_Bits => Irrelevant);
end opengl.surface_Profile;

12
3-mid/opengl/source/platform/egl/private/opengl-display-privvy.adb Normal file
View File

@@ -0,0 +1,12 @@
package body opengl.Display.privvy
is
function to_eGL (Self : in Display.item'Class) return eGL.EGLDisplay
is
begin
return Self.Thin;
end to_eGL;
end opengl.Display.privvy;

12
3-mid/opengl/source/platform/egl/private/opengl-display-privvy.ads Normal file
View File

@@ -0,0 +1,12 @@
with
eGL;
package opengl.Display.privvy
is
function to_eGL (Self : in Display.item'Class) return eGL.EGLDisplay;
end opengl.Display.privvy;

10
3-mid/opengl/source/platform/egl/private/opengl-surface-privvy.adb Normal file
View File

@@ -0,0 +1,10 @@
package body opengl.Surface.privvy
is
function to_eGL (Self : in Surface.item'Class) return egl.EGLSurface
is
begin
return Self.egl_Surface;
end to_eGL;
end opengl.Surface.privvy;

10
3-mid/opengl/source/platform/egl/private/opengl-surface-privvy.ads Normal file
View File

@@ -0,0 +1,10 @@
with
eGL;
package opengl.Surface.privvy
is
function to_eGL (Self : in Surface.item'Class) return egl.EGLSurface;
end opengl.Surface.privvy;

10
3-mid/opengl/source/platform/egl/private/opengl-surface_profile-privvy.adb Normal file
View File

@@ -0,0 +1,10 @@
package body opengl.surface_Profile.privvy
is
function to_eGL (Self : in Item'Class) return egl.EGLConfig
is
begin
return Self.egl_Config;
end to_eGL;
end opengl.surface_Profile.privvy;

10
3-mid/opengl/source/platform/egl/private/opengl-surface_profile-privvy.ads Normal file
View File

@@ -0,0 +1,10 @@
with
eGL;
package opengl.surface_Profile.privvy
is
function to_eGL (Self : in surface_Profile.Item'Class) return egl.EGLConfig;
end opengl.surface_Profile.privvy;

217
3-mid/opengl/source/platform/egl/private/thin/egl-binding.ads Normal file
View File

@@ -0,0 +1,217 @@
with
eGL.Pointers,
eGL.NativeDisplayType,
Interfaces.C.Strings,
System;
package eGL.Binding
is
function eglGetError return eGL.EGLint;
function eglGetDisplay
(display_id : in eGL.NativeDisplayType.Item) return eGL.EGLDisplay;
function eglInitialize
(dpy : in eGL.EGLDisplay;
major : in eGL.Pointers.EGLint_Pointer;
minor : in eGL.Pointers.EGLint_Pointer) return eGL.EGLBoolean;
function eglTerminate (dpy : in eGL.EGLDisplay) return eGL.EGLBoolean;
function eglQueryString
(dpy : in eGL.EGLDisplay;
name : in eGL.EGLint) return Interfaces.C.Strings.chars_ptr;
function eglGetConfigs
(dpy : in eGL.EGLDisplay;
configs : in eGL.Pointers.EGLConfig_Pointer;
config_size : in eGL.EGLint;
num_config : in eGL.Pointers.EGLint_Pointer) return eGL.EGLBoolean;
function eglChooseConfig
(dpy : in eGL.EGLDisplay;
attrib_list : in eGL.Pointers.EGLint_Pointer;
configs : in eGL.Pointers.EGLConfig_Pointer;
config_size : in eGL.EGLint;
num_config : in eGL.Pointers.EGLint_Pointer) return eGL.EGLBoolean;
function eglGetConfigAttrib
(dpy : in eGL.EGLDisplay;
config : in eGL.EGLConfig;
attribute : in eGL.EGLint;
value : in eGL.Pointers.EGLint_Pointer) return eGL.EGLBoolean;
function eglCreateWindowSurface
(dpy : in eGL.EGLDisplay;
config : in eGL.EGLConfig;
win : in eGL.NativeWindowType;
attrib_list : in eGL.Pointers.EGLint_Pointer) return eGL.EGLSurface;
function eglCreatePbufferSurface
(dpy : in eGL.EGLDisplay;
config : in eGL.EGLConfig;
attrib_list : in eGL.Pointers.EGLint_Pointer) return eGL.EGLSurface;
function eglCreatePixmapSurface
(dpy : in eGL.EGLDisplay;
config : in eGL.EGLConfig;
pixmap : in eGL.NativePixmapType;
attrib_list : in eGL.Pointers.EGLint_Pointer) return eGL.EGLSurface;
function eglDestroySurface
(dpy : in eGL.EGLDisplay;
surface : in eGL.EGLSurface) return eGL.EGLBoolean;
function eglQuerySurface
(dpy : in eGL.EGLDisplay;
surface : in eGL.EGLSurface;
attribute : in eGL.EGLint;
value : in eGL.Pointers.EGLint_Pointer) return eGL.EGLBoolean;
function eglBindAPI (api : in eGL.EGLenum) return eGL.EGLBoolean;
function eglQueryAPI return eGL.EGLenum;
function eglWaitClient return eGL.EGLBoolean;
function eglReleaseThread return eGL.EGLBoolean;
function eglCreatePbufferFromClientBuffer
(dpy : in eGL.EGLDisplay;
buftype : in eGL.EGLenum;
buffer : in eGL.EGLClientBuffer;
config : in eGL.EGLConfig;
attrib_list : in eGL.Pointers.EGLint_Pointer) return eGL.EGLSurface;
function eglSurfaceAttrib
(dpy : in eGL.EGLDisplay;
surface : in eGL.EGLSurface;
attribute : in eGL.EGLint;
value : in eGL.EGLint) return eGL.EGLBoolean;
function eglBindTexImage
(dpy : in eGL.EGLDisplay;
surface : in eGL.EGLSurface;
buffer : in eGL.EGLint) return eGL.EGLBoolean;
function eglReleaseTexImage
(dpy : in eGL.EGLDisplay;
surface : in eGL.EGLSurface;
buffer : in eGL.EGLint) return eGL.EGLBoolean;
function eglSwapInterval
(dpy : in eGL.EGLDisplay;
interval : in eGL.EGLint)
return eGL.EGLBoolean;
function eglCreateContext
(dpy : in eGL.EGLDisplay;
config : in eGL.EGLConfig;
share_context : in eGL.EGLContext;
attrib_list : in eGL.Pointers.EGLint_Pointer) return eGL.EGLContext;
function eglDestroyContext
(dpy : in eGL.EGLDisplay;
ctx : in eGL.EGLContext) return eGL.EGLBoolean;
function eglMakeCurrent
(dpy : in eGL.EGLDisplay;
draw : in eGL.EGLSurface;
read : in eGL.EGLSurface;
ctx : in eGL.EGLContext) return eGL.EGLBoolean;
function eglGetCurrentContext return eGL.EGLContext;
function eglGetCurrentSurface
(readdraw : in eGL.EGLint) return eGL.EGLSurface;
function eglGetCurrentDisplay return eGL.EGLDisplay;
function eglQueryContext
(dpy : in eGL.EGLDisplay;
ctx : in eGL.EGLContext;
attribute : in eGL.EGLint;
value : in eGL.Pointers.EGLint_Pointer) return eGL.EGLBoolean;
function eglWaitGL return eGL.EGLBoolean;
function eglWaitNative (engine : in eGL.EGLint) return eGL.EGLBoolean;
function eglSwapBuffers
(dpy : in eGL.EGLDisplay;
surface : in eGL.EGLSurface) return eGL.EGLBoolean;
function eglCopyBuffers
(dpy : in eGL.EGLDisplay;
surface : in eGL.EGLSurface;
target : in eGL.NativePixmapType) return eGL.EGLBoolean;
function eglGetProcAddress
(procname : in Interfaces.C.Strings.chars_ptr) return void_ptr;
-- Out-of-band handle values.
--
egl_DEFAULT_DISPLAY : constant access eGL.Display;
egl_NO_CONTEXT : constant eGL.EGLContext;
egl_NO_DISPLAY : constant eGL.EGLDisplay;
egl_NO_SURFACE : constant eGL.EGLSurface;
-- Out-of-band attribute value.
--
egl_DONT_CARE : constant eGL.EGLint;
private
use System;
egl_DEFAULT_DISPLAY : constant access eGL.Display := null;
egl_NO_CONTEXT : constant eGL.EGLContext := null_Address;
egl_NO_DISPLAY : constant eGL.EGLDisplay := null_Address;
egl_NO_SURFACE : constant eGL.EGLSurface := null_Address;
egl_DONT_CARE : constant eGL.EGLint := -1;
pragma Import (C, eglGetError, "eglGetError");
pragma Import (C, eglGetDisplay, "eglGetDisplay");
pragma Import (C, eglInitialize, "eglInitialize");
pragma Import (C, eglTerminate, "eglTerminate");
pragma Import (C, eglQueryString, "eglQueryString");
pragma Import (C, eglGetConfigs, "eglGetConfigs");
pragma Import (C, eglChooseConfig, "eglChooseConfig");
pragma Import (C, eglGetConfigAttrib, "eglGetConfigAttrib");
pragma Import (C, eglCreateWindowSurface, "eglCreateWindowSurface");
pragma Import (C, eglCreatePbufferSurface, "eglCreatePbufferSurface");
pragma Import (C, eglCreatePixmapSurface, "eglCreatePixmapSurface");
pragma Import (C, eglDestroySurface, "eglDestroySurface");
pragma Import (C, eglQuerySurface, "eglQuerySurface");
pragma Import (C, eglBindAPI, "eglBindAPI");
pragma Import (C, eglQueryAPI, "eglQueryAPI");
pragma Import (C, eglWaitClient, "eglWaitClient");
pragma Import (C, eglReleaseThread, "eglReleaseThread");
pragma Import (C, eglCreatePbufferFromClientBuffer,
"eglCreatePbufferFromClientBuffer");
pragma Import (C, eglSurfaceAttrib, "eglSurfaceAttrib");
pragma Import (C, eglBindTexImage, "eglBindTexImage");
pragma Import (C, eglReleaseTexImage, "eglReleaseTexImage");
pragma Import (C, eglSwapInterval, "eglSwapInterval");
pragma Import (C, eglCreateContext, "eglCreateContext");
pragma Import (C, eglDestroyContext, "eglDestroyContext");
pragma Import (C, eglMakeCurrent, "eglMakeCurrent");
pragma Import (C, eglGetCurrentContext, "eglGetCurrentContext");
pragma Import (C, eglGetCurrentSurface, "eglGetCurrentSurface");
pragma Import (C, eglGetCurrentDisplay, "eglGetCurrentDisplay");
pragma Import (C, eglQueryContext, "eglQueryContext");
pragma Import (C, eglWaitGL, "eglWaitGL");
pragma Import (C, eglWaitNative, "eglWaitNative");
pragma Import (C, eglSwapBuffers, "eglSwapBuffers");
pragma Import (C, eglCopyBuffers, "eglCopyBuffers");
pragma Import (C, eglGetProcAddress, "eglGetProcAddress");
end eGL.Binding;

12
3-mid/opengl/source/platform/egl/private/thin/egl-nativedisplaytype.ads Normal file
View File

@@ -0,0 +1,12 @@
with
eGL.Pointers;
package eGL.NativeDisplayType
is
subtype Item is eGL.Pointers.Display_Pointer;
type Item_array is array (C.size_t range <>) of aliased Item;
type Pointer is access all eGL.NativeDisplayType.Item;
type Pointer_array is array (C.size_t range <>) of aliased Pointer;
end eGL.NativeDisplayType;

28
3-mid/opengl/source/platform/egl/private/thin/egl-pointers.ads Normal file
View File

@@ -0,0 +1,28 @@
package eGL.Pointers
is
type Display_Pointer is access all eGL.Display;
type NativeWindowType_Pointer is access all eGL.NativeWindowType;
type NativePixmapType_Pointer is access all eGL.NativePixmapType;
type EGLint_Pointer is access all eGL.EGLint;
type EGLBoolean_Pointer is access all eGL.EGLBoolean;
type EGLenum_Pointer is access all eGL.EGLenum;
type EGLConfig_Pointer is access all eGL.EGLConfig;
type EGLContext_Pointer is access all eGL.EGLContext;
type EGLDisplay_Pointer is access all eGL.EGLDisplay;
type EGLSurface_Pointer is access all eGL.EGLSurface;
type EGLClientBuffer_Pointer is access all eGL.EGLClientBuffer;
type Display_Pointer_array is array (C.size_t range <>) of aliased Display_Pointer;
type NativeWindowType_Pointer_array is array (C.size_t range <>) of aliased NativeWindowType_Pointer;
type NativePixmapType_Pointer_array is array (C.size_t range <>) of aliased NativePixmapType_Pointer;
type EGLint_Pointer_array is array (C.size_t range <>) of aliased EGLint_Pointer;
type EGLBoolean_Pointer_array is array (C.size_t range <>) of aliased EGLBoolean_Pointer;
type EGLenum_Pointer_array is array (C.size_t range <>) of aliased EGLenum_Pointer;
type EGLConfig_Pointer_array is array (C.size_t range <>) of aliased EGLConfig_Pointer;
type EGLContext_Pointer_array is array (C.size_t range <>) of aliased EGLContext_Pointer;
type EGLDisplay_Pointer_array is array (C.size_t range <>) of aliased EGLDisplay_Pointer;
type EGLSurface_Pointer_array is array (C.size_t range <>) of aliased EGLSurface_Pointer;
type EGLClientBuffer_Pointer_array is array (C.size_t range <>) of aliased EGLClientBuffer_Pointer;
end eGL.Pointers;

210
3-mid/opengl/source/platform/egl/private/thin/egl.ads Normal file
View File

@@ -0,0 +1,210 @@
with
Interfaces.C,
System;
package eGL
is
use Interfaces;
---------
-- Types
--
subtype void_Ptr is System.Address;
subtype Display is System.Address;
subtype NativeWindowType is Interfaces.C.unsigned_long;
subtype NativePixmapType is Interfaces.C.unsigned_long;
subtype EGLint is Interfaces.Integer_32;
subtype EGLBoolean is Interfaces.C.unsigned;
subtype EGLenum is Interfaces.C.unsigned;
subtype EGLConfig is void_ptr;
subtype EGLContext is void_ptr;
subtype EGLDisplay is void_ptr;
subtype EGLSurface is void_ptr;
subtype EGLClientBuffer is void_ptr;
type void_Ptr_array is array (C.size_t range <>) of aliased void_Ptr;
type Display_array is array (C.size_t range <>) of aliased eGL.Display;
type NativeWindowType_array is array (C.size_t range <>) of aliased eGL.NativeWindowType;
type NativePixmapType_array is array (C.size_t range <>) of aliased eGL.NativePixmapType;
type EGLint_array is array (C.size_t range <>) of aliased eGL.EGLint;
type EGLBoolean_array is array (C.size_t range <>) of aliased eGL.EGLBoolean;
type EGLenum_array is array (C.size_t range <>) of aliased eGL.EGLenum;
type EGLConfig_array is array (C.size_t range <>) of aliased eGL.EGLConfig;
type EGLContext_array is array (C.size_t range <>) of aliased eGL.EGLContext;
type EGLDisplay_array is array (C.size_t range <>) of aliased eGL.EGLDisplay;
type EGLSurface_array is array (C.size_t range <>) of aliased eGL.EGLSurface;
type EGLClientBuffer_array is array (C.size_t range <>) of aliased eGL.EGLClientBuffer;
-------------
-- Constants
--
EGL_VERSION_1_0 : constant := 1;
EGL_VERSION_1_1 : constant := 1;
EGL_VERSION_1_2 : constant := 1;
EGL_VERSION_1_3 : constant := 1;
EGL_VERSION_1_4 : constant := 1;
EGL_FALSE : constant := 0;
EGL_TRUE : constant := 1;
EGL_SUCCESS : constant := 16#3000#;
EGL_NOT_INITIALIZED : constant := 16#3001#;
EGL_BAD_ACCESS : constant := 16#3002#;
EGL_BAD_ALLOC : constant := 16#3003#;
EGL_BAD_ATTRIBUTE : constant := 16#3004#;
EGL_BAD_CONFIG : constant := 16#3005#;
EGL_BAD_CONTEXT : constant := 16#3006#;
EGL_BAD_CURRENT_SURFACE : constant := 16#3007#;
EGL_BAD_DISPLAY : constant := 16#3008#;
EGL_BAD_MATCH : constant := 16#3009#;
EGL_BAD_NATIVE_PIXMAP : constant := 16#300a#;
EGL_BAD_NATIVE_WINDOW : constant := 16#300b#;
EGL_BAD_PARAMETER : constant := 16#300c#;
EGL_BAD_SURFACE : constant := 16#300d#;
EGL_CONTEXT_LOST : constant := 16#300e#;
EGL_BUFFER_SIZE : constant := 16#3020#;
EGL_ALPHA_SIZE : constant := 16#3021#;
EGL_BLUE_SIZE : constant := 16#3022#;
EGL_GREEN_SIZE : constant := 16#3023#;
EGL_RED_SIZE : constant := 16#3024#;
EGL_DEPTH_SIZE : constant := 16#3025#;
EGL_STENCIL_SIZE : constant := 16#3026#;
EGL_CONFIG_CAVEAT : constant := 16#3027#;
EGL_CONFIG_ID : constant := 16#3028#;
EGL_LEVEL : constant := 16#3029#;
EGL_MAX_PBUFFER_HEIGHT : constant := 16#302a#;
EGL_MAX_PBUFFER_PIXELS : constant := 16#302b#;
EGL_MAX_PBUFFER_WIDTH : constant := 16#302c#;
EGL_NATIVE_RENDERABLE : constant := 16#302d#;
EGL_NATIVE_VISUAL_ID : constant := 16#302e#;
EGL_NATIVE_VISUAL_TYPE : constant := 16#302f#;
EGL_PRESERVED_RESOURCES : constant := 16#3030#;
EGL_SAMPLES : constant := 16#3031#;
EGL_SAMPLE_BUFFERS : constant := 16#3032#;
EGL_SURFACE_TYPE : constant := 16#3033#;
EGL_TRANSPARENT_TYPE : constant := 16#3034#;
EGL_TRANSPARENT_BLUE_VALUE : constant := 16#3035#;
EGL_TRANSPARENT_GREEN_VALUE : constant := 16#3036#;
EGL_TRANSPARENT_RED_VALUE : constant := 16#3037#;
EGL_NONE : constant := 16#3038#;
EGL_BIND_TO_TEXTURE_RGB : constant := 16#3039#;
EGL_BIND_TO_TEXTURE_RGBA : constant := 16#303a#;
EGL_MIN_SWAP_INTERVAL : constant := 16#303b#;
EGL_MAX_SWAP_INTERVAL : constant := 16#303c#;
EGL_LUMINANCE_SIZE : constant := 16#303d#;
EGL_ALPHA_MASK_SIZE : constant := 16#303e#;
EGL_COLOR_BUFFER_TYPE : constant := 16#303f#;
EGL_RENDERABLE_TYPE : constant := 16#3040#;
EGL_MATCH_NATIVE_PIXMAP : constant := 16#3041#;
EGL_CONFORMANT : constant := 16#3042#;
EGL_SLOW_CONFIG : constant := 16#3050#;
EGL_NON_CONFORMANT_CONFIG : constant := 16#3051#;
EGL_TRANSPARENT_RGB : constant := 16#3052#;
EGL_RGB_BUFFER : constant := 16#308e#;
EGL_LUMINANCE_BUFFER : constant := 16#308f#;
EGL_NO_TEXTURE : constant := 16#305c#;
EGL_TEXTURE_RGB : constant := 16#305d#;
EGL_TEXTURE_RGBA : constant := 16#305e#;
EGL_TEXTURE_2D : constant := 16#305f#;
EGL_PBUFFER_BIT : constant := 16#1#;
EGL_PIXMAP_BIT : constant := 16#2#;
EGL_WINDOW_BIT : constant := 16#4#;
EGL_VG_COLORSPACE_LINEAR_BIT : constant := 16#20#;
EGL_VG_ALPHA_FORMAT_PRE_BIT : constant := 16#40#;
EGL_MULTISAMPLE_RESOLVE_BOX_BIT : constant := 16#200#;
EGL_SWAP_BEHAVIOR_PRESERVED_BIT : constant := 16#400#;
EGL_OPENGL_ES_BIT : constant := 16#1#;
EGL_OPENVG_BIT : constant := 16#2#;
EGL_OPENGL_ES2_BIT : constant := 16#4#;
EGL_OPENGL_BIT : constant := 16#8#;
EGL_VENDOR : constant := 16#3053#;
EGL_VERSION : constant := 16#3054#;
EGL_EXTENSIONS : constant := 16#3055#;
EGL_CLIENT_APIS : constant := 16#308d#;
EGL_HEIGHT : constant := 16#3056#;
EGL_WIDTH : constant := 16#3057#;
EGL_LARGEST_PBUFFER : constant := 16#3058#;
EGL_TEXTURE_FORMAT : constant := 16#3080#;
EGL_TEXTURE_TARGET : constant := 16#3081#;
EGL_MIPMAP_TEXTURE : constant := 16#3082#;
EGL_MIPMAP_LEVEL : constant := 16#3083#;
EGL_RENDER_BUFFER : constant := 16#3086#;
EGL_VG_COLORSPACE : constant := 16#3087#;
EGL_VG_ALPHA_FORMAT : constant := 16#3088#;
EGL_HORIZONTAL_RESOLUTION : constant := 16#3090#;
EGL_VERTICAL_RESOLUTION : constant := 16#3091#;
EGL_PIXEL_ASPECT_RATIO : constant := 16#3092#;
EGL_SWAP_BEHAVIOR : constant := 16#3093#;
EGL_MULTISAMPLE_RESOLVE : constant := 16#3099#;
EGL_BACK_BUFFER : constant := 16#3084#;
EGL_SINGLE_BUFFER : constant := 16#3085#;
EGL_VG_COLORSPACE_sRGB : constant := 16#3089#;
EGL_VG_COLORSPACE_LINEAR : constant := 16#308a#;
EGL_VG_ALPHA_FORMAT_NONPRE : constant := 16#308b#;
EGL_VG_ALPHA_FORMAT_PRE : constant := 16#308c#;
EGL_DISPLAY_SCALING : constant := 10000;
EGL_BUFFER_PRESERVED : constant := 16#3094#;
EGL_BUFFER_DESTROYED : constant := 16#3095#;
EGL_OPENVG_IMAGE : constant := 16#3096#;
EGL_CONTEXT_CLIENT_TYPE : constant := 16#3097#;
EGL_CONTEXT_CLIENT_VERSION : constant := 16#3098#;
EGL_MULTISAMPLE_RESOLVE_DEFAULT : constant := 16#309a#;
EGL_MULTISAMPLE_RESOLVE_BOX : constant := 16#309b#;
EGL_OPENGL_ES_API : constant := 16#30a0#;
EGL_OPENVG_API : constant := 16#30a1#;
EGL_OPENGL_API : constant := 16#30a2#;
EGL_DRAW : constant := 16#3059#;
EGL_READ : constant := 16#305a#;
EGL_CORE_NATIVE_ENGINE : constant := 16#305b#;
EGL_COLORSPACE : constant := 16#3087#;
EGL_ALPHA_FORMAT : constant := 16#3088#;
EGL_COLORSPACE_sRGB : constant := 16#3089#;
EGL_COLORSPACE_LINEAR : constant := 16#308a#;
EGL_ALPHA_FORMAT_NONPRE : constant := 16#308b#;
EGL_ALPHA_FORMAT_PRE : constant := 16#308c#;
end eGL;

40
3-mid/opengl/source/platform/glx/opengl-context.adb Normal file
View File

@@ -0,0 +1,40 @@
with
glx.Pointers;
package body openGL.Context -- TODO: Finish this package.
is
procedure define (Self : in out Item; Profile : in openGL.surface_Profile.item'Class)
is
pragma Unreferenced (Profile);
use GlX,
glx.Pointers;
begin
if Self.glx_Context = null
then
raise Program_Error with "No openGL context";
end if;
end define;
procedure make_Current (Self : in Item; read_Surface : in Surface.item;
write_Surface : in Surface.item)
is
pragma Unreferenced (write_Surface);
Success : glx.Bool with Unreferenced;
begin
null;
end make_Current;
function glx_Context_debug (Self : in Item'Class) return glx.Context.item
is
begin
return Self.glx_Context;
end glx_Context_debug;
end openGL.Context;

31
3-mid/opengl/source/platform/glx/opengl-context.ads Normal file
View File

@@ -0,0 +1,31 @@
with
openGL.surface_Profile,
openGL.Surface,
glx.Context;
package openGL.Context
--
-- Models an openGL (GLX) context.
--
is
type Item is tagged private;
type View is access all Item'Class;
procedure define (Self : in out Item; Profile : in surface_Profile.item'Class);
procedure make_Current (Self : in Item; read_Surface : in Surface.item;
write_Surface : in Surface.item);
function glx_Context_debug (Self : in Item'Class) return glx.Context.item; -- For debugging.
private
type Item is tagged
record
glx_Context : aliased glx.Context.item;
end record;
end openGL.Context;

18
3-mid/opengl/source/platform/glx/opengl-screen.ads Normal file
View File

@@ -0,0 +1,18 @@
package openGL.Screen
--
-- Models an openGL screen.
--
is
type Item is tagged limited private;
private
type Item is tagged limited
record
null;
end record;
end openGL.Screen;

45
3-mid/opengl/source/platform/glx/opengl-surface.adb Normal file
View File

@@ -0,0 +1,45 @@
with
openGL.Context,
interfaces.C;
package body openGL.Surface -- TODO: Finish this package.
is
use Glx,
Interfaces;
visual_Attributes : array (Positive range <>) of aliased C.int := (GLX_X_RENDERABLE, 1,
GLX_DRAWABLE_TYPE, GLX_WINDOW_BIT,
GLX_RENDER_TYPE, GLX_RGBA_BIT,
GLX_X_VISUAL_TYPE, GLX_TRUE_COLOR,
GLX_RED_SIZE, 8,
GLX_GREEN_SIZE, 8,
GLX_BLUE_SIZE, 8,
GLX_ALPHA_SIZE, 8,
GLX_DEPTH_SIZE, 24,
GLX_STENCIL_SIZE, 8,
GLX_DOUBLEBUFFER, 1,
0);
procedure define (Self : in out Item; Profile : in surface_Profile.item'Class;
Window_Id : in Natural)
is
pragma Unreferenced (Window_Id);
-- the_Profile : constant surface_Profile.item'Class := Profile;
begin
null;
end define;
-- Operations
--
procedure swap_Buffers (Self : in Item)
is
begin
null;
end swap_Buffers;
end openGL.Surface;

41
3-mid/opengl/source/platform/glx/opengl-surface.ads Normal file
View File

@@ -0,0 +1,41 @@
with
openGL.surface_Profile;
private
with
Glx;
limited private
with
openGL.Context;
package openGL.Surface
--
-- Models an openGL surface.
--
is
type Item is tagged private;
type Items is array (Positive range <>) of aliased Item;
type View is access all Item'Class;
type Views is array (Positive range <>) of View;
procedure define (Self : in out Item; Profile : in surface_Profile.item'Class;
Window_Id : in Natural);
-- Operations
--
procedure swap_Buffers (Self : in Item);
private
type Item is tagged
record
glx_Surface : glx.Drawable;
Context : access openGL.Context.item'Class;
end record;
end openGL.Surface;

105
3-mid/opengl/source/platform/glx/opengl-surface_profile.adb Normal file
View File

@@ -0,0 +1,105 @@
with
interfaces.C,
ada.unchecked_Conversion;
package body openGL.surface_Profile -- TODO: Finish this package.
is
use Interfaces,
GLX;
visual_Attributes : array (Positive range <>) of aliased C.int := (GLX_X_RENDERABLE, 1,
GLX_DRAWABLE_TYPE, GLX_WINDOW_BIT,
GLX_RENDER_TYPE, GLX_RGBA_BIT,
GLX_X_VISUAL_TYPE, GLX_TRUE_COLOR,
GLX_RED_SIZE, 8,
GLX_GREEN_SIZE, 8,
GLX_BLUE_SIZE, 8,
GLX_ALPHA_SIZE, 8,
GLX_DEPTH_SIZE, 24,
GLX_STENCIL_SIZE, 8,
GLX_DOUBLEBUFFER, 1,
-- GLX_SAMPLE_BUFFERS , 1,
-- GLX_SAMPLES , 4,
0);
procedure define (Self : in out Item; Screen : access openGL.Screen.item'Class;
Desired : in Qualities := default_Qualities)
is
pragma Unreferenced (Desired);
-- num_fb_configs : aliased C.int := 0;
-- visual_Id : aliased C.int;
Unused : C.int with Unreferenced;
begin
null;
end define;
function get_Visual (Self : in Item) return access glx.XVisualInfo
is
begin
return Self.Visual;
end get_Visual;
function fetch_All return surface_Profile.items
is
begin
raise Program_Error with "TBD";
return (1 .. 0 => <>);
end fetch_All;
function Quality (Self : in Item) return Qualities
is
pragma Unreferenced (Self);
begin
raise Program_Error with "TBD";
return (others => <>);
end Quality;
function value_Image (Value : in Natural) return String
is
begin
if Value = Irrelevant then
return "Irrelevant";
else
return Natural'Image (Value);
end if;
end value_Image;
function Image (Self : in color_Buffer) return String
is
begin
return "("
& "Bits_red =>" & value_Image (Self.Bits_red)
& ", Bits_green =>" & value_Image (Self.Bits_green)
& ", Bits_blue =>" & value_Image (Self.Bits_blue)
& ", Bits_luminence =>" & value_Image (Self.Bits_luminence)
& ", Bits_alpha =>" & value_Image (Self.Bits_alpha)
& ", Bits_alpha_mask =>" & value_Image (Self.Bits_alpha_mask)
& ")";
end Image;
function Image (Self : in Qualities) return String
is
begin
return "("
& Image (Self.color_Buffer)
& ", depth_buffer_Bits =>" & value_Image (Self. depth_buffer_Bits)
& ", stencil_buffer_Bits => " & value_Image (Self.stencil_buffer_Bits)
& ")";
end Image;
end openGL.surface_Profile;

90
3-mid/opengl/source/platform/glx/opengl-surface_profile.ads Normal file
View File

@@ -0,0 +1,90 @@
with
openGL.Screen,
GLX;
package openGL.surface_Profile
--
-- Models an openGL surface profile.
--
is
type Item is tagged private;
type View is access all Item'Class;
type Items is array (Positive range <>) of Item;
type Views is array (Positive range <>) of View;
-------------------
-- Surface Quality
--
Irrelevant : constant Natural := Natural'Last;
type color_Buffer is
record
Bits_red : Natural := Irrelevant;
Bits_green : Natural := Irrelevant;
Bits_blue : Natural := Irrelevant;
Bits_luminence : Natural := Irrelevant;
Bits_alpha : Natural := Irrelevant;
Bits_alpha_mask : Natural := Irrelevant;
end record;
function Image (Self : in color_Buffer) return String;
type Qualities is
record
color_Buffer : surface_Profile.color_Buffer;
depth_buffer_Bits : Natural := Irrelevant;
stencil_buffer_Bits : Natural := Irrelevant;
end record;
default_Qualities : constant Qualities;
function Image (Self : in Qualities) return String;
---------
-- Forge
--
desired_Qualitites_unavailable : exception;
procedure define (Self : in out Item; Screen : access openGL.Screen.item'Class;
Desired : in Qualities := default_Qualities);
function fetch_All return surface_Profile.items;
--------------
-- Attributes
--
function Quality (Self : in Item) return Qualities;
function get_Visual (Self : in Item) return access glx.XVisualInfo;
private
type Item is tagged
record
glx_Config : glx.FBConfig;
Visual : access glx.XVisualInfo;
end record;
default_Qualities : constant Qualities := (color_Buffer => (Bits_red => 8,
Bits_green => 8,
Bits_blue => 8,
Bits_luminence => Irrelevant,
Bits_alpha => Irrelevant,
Bits_alpha_mask => Irrelevant),
depth_buffer_Bits => 24,
stencil_buffer_Bits => Irrelevant);
end openGL.surface_Profile;

10
3-mid/opengl/source/platform/glx/private/opengl-surface-privvy.adb Normal file
View File

@@ -0,0 +1,10 @@
package body openGL.Surface.privvy
is
function to_GLX (Self : in Surface.item'Class) return glx.Drawable
is
begin
return Self.glx_Surface;
end to_GLX;
end openGL.Surface.privvy;

9
3-mid/opengl/source/platform/glx/private/opengl-surface-privvy.ads Normal file
View File

@@ -0,0 +1,9 @@
with
GLX;
package openGL.Surface.privvy
is
function to_GLX (Self : in Surface.item'Class) return glx.Drawable;
end openGL.Surface.privvy;

10
3-mid/opengl/source/platform/glx/private/opengl-surface_profile-privvy.adb Normal file
View File

@@ -0,0 +1,10 @@
package body openGL.surface_Profile.privvy
is
function to_GLX (Self : in Item'Class) return glx.FBConfig
is
begin
return Self.glx_Config;
end to_GLX;
end openGL.surface_Profile.privvy;

6
3-mid/opengl/source/platform/glx/private/opengl-surface_profile-privvy.ads Normal file
View File

@@ -0,0 +1,6 @@
package openGL.surface_Profile.privvy
is
function to_GLX (Self : in Item'Class) return glx.FBConfig;
end openGL.surface_Profile.privvy;

34
3-mid/opengl/source/platform/glx/private/thin/glx-binding.ads Normal file
View File

@@ -0,0 +1,34 @@
with
glx.Pointers,
interfaces.C;
package glx.Binding
is
function getCurrentContext return access ContextRec;
function getCurrentDrawable return Drawable;
procedure waitGL;
procedure waitX;
procedure useXFont (Font : in GLX.Font;
First : in C.int;
Count : in C.int;
List : in C.int);
function getCurrentReadDrawable return Drawable;
function get_visualid (Self : in Pointers.XVisualInfo_Pointer) return VisualID;
private
pragma Import (C, getCurrentContext, "glXGetCurrentContext");
pragma Import (C, getCurrentDrawable, "glXGetCurrentDrawable");
pragma Import (C, waitGL, "glXWaitGL");
pragma Import (C, waitX, "glXWaitX");
pragma Import (C, useXFont, "glXUseXFont");
pragma Import (C, getCurrentReadDrawable, "glXGetCurrentReadDrawable");
pragma Import (C, get_visualid, "Ada_get_visualid");
end glx.Binding;

32
3-mid/opengl/source/platform/glx/private/thin/glx-bufferswapcomplete.ads Normal file
View File

@@ -0,0 +1,32 @@
package glx.BufferSwapComplete
is
type Item is
record
the_Type : aliased C.int;
Serial : aliased C.unsigned_long;
send_Event : aliased Bool;
Display : System.Address;
Drawable : aliased glx.Drawable;
Event_type : aliased C.int;
UST : aliased Integer_64;
MSC : aliased Integer_64;
SBC : aliased Integer_64;
end record;
type Items is array (C.size_t range <>) of aliased BufferSwapComplete.item;
type Pointer is access all BufferSwapComplete.item;
type Pointers is array (C.size_t range <>) of aliased BufferSwapComplete.Pointer;
type Pointer_Pointer is access all BufferSwapComplete.Pointer;
function Construct return BufferSwapComplete.item;
private
pragma Import (C, Construct, "Ada_new_GLXBufferSwapComplete");
end glx.BufferSwapComplete;

14
3-mid/opengl/source/platform/glx/private/thin/glx-context.ads Normal file
View File

@@ -0,0 +1,14 @@
with
glx.Pointers;
package glx.Context
is
subtype Item is Pointers.ContextRec_Pointer;
type Pointer is access all Item;
type Pointer_Pointer is access all Pointer;
type Items is array (C.size_t range <>) of aliased Item;
type Pointers is array (C.size_t range <>) of aliased Pointer;
end glx.Context;

29
3-mid/opengl/source/platform/glx/private/thin/glx-event.ads Normal file
View File

@@ -0,0 +1,29 @@
with
glx.BufferSwapComplete,
glx.PbufferClobberEvent;
package glx.Event
is
type long_Array is array (C.size_t range <>) of aliased C.Long;
type Kind is (pBufferClobber,
BufferSwapComplete,
Pad);
type Item (Kind : Event.Kind := Event.Kind'First) is
record
case Kind is
when pBufferClobber => pBufferClobber : aliased glx.PBufferClobberEvent.item;
when BufferSwapComplete => BufferSwapComplete : aliased glx.BufferSwapComplete .item;
when Pad => Pad : aliased long_Array (0 .. 23);
end case;
end record
with unchecked_Union;
type Pointer is access all Item;
type Pointer_Pointer is access all Pointer;
type Items is array (C.size_t range <>) of aliased Item;
type Pointers is array (C.size_t range <>) of aliased Pointer;
end glx.Event;

26
3-mid/opengl/source/platform/glx/private/thin/glx-pbufferclobberevent.ads Normal file
View File

@@ -0,0 +1,26 @@
package glx.PbufferClobberEvent
is
type Item is
record
Event_Type : aliased C.int;
Draw_Type : aliased C.int;
Serial : aliased C.unsigned_long;
Send_Event : aliased glx.Bool;
Display : System.Address;
Drawable : aliased glx.Drawable;
Buffer_Mask : aliased C.unsigned;
aux_Buffer : aliased C.unsigned;
X : aliased C.int;
Y : aliased C.int;
Width : aliased C.int;
Height : aliased C.int;
Count : aliased C.int;
end record;
type Pointer is access all Item;
type Pointer_Pointer is access all Pointer;
type Items is array (C.size_t range <>) of aliased Item;
type Pointers is array (C.size_t range <>) of aliased Pointer;
end glx.PbufferClobberEvent;

24
3-mid/opengl/source/platform/glx/private/thin/glx-pointer_pointers.ads Normal file
View File

@@ -0,0 +1,24 @@
with
glx.Pointers;
package GLX.Pointer_Pointers
is
use glx.Pointers;
type VisualID_Pointer_Pointer is access all VisualID_Pointer;
type XVisualInfo_Pointer_Pointer is access all XVisualInfo_Pointer;
type Pixmap_Pointer_Pointer is access all Pixmap_Pointer;
type Font_Pointer_Pointer is access all Font_Pointer;
type Window_Pointer_Pointer is access all Window_Pointer;
type Bool_Pointer_Pointer is access all Bool_Pointer;
type ContextRec_Pointer_Pointer is access all ContextRec_Pointer;
type XID_Pointer_Pointer is access all XID_Pointer;
type GLXPixmap_Pointer_Pointer is access all GLXPixmap_Pointer;
type Drawable_Pointer_Pointer is access all Drawable_Pointer;
type FBConfig_Pointer_Pointer is access all FBConfig_Pointer;
type FBConfigID_Pointer_Pointer is access all FBConfigID_Pointer;
type ContextID_Pointer_Pointer is access all ContextID_Pointer;
type GLXWindow_Pointer_Pointer is access all Window_Pointer;
type PBuffer_Pointer_Pointer is access all PBuffer_Pointer;
end GLX.Pointer_Pointers;

78
3-mid/opengl/source/platform/glx/private/thin/glx-pointers.ads Normal file
View File

@@ -0,0 +1,78 @@
package GLX.Pointers
is
-- VisualID_Pointer
--
type VisualID_Pointer is access all VisualID;
type VisualID_Pointers is array (C.size_t range <>) of aliased VisualID_Pointer;
-- XVisualInfo_Pointer
--
type XVisualInfo_Pointer is access all XVisualInfo;
type XVisualInfo_Pointers is array (C.size_t range <>) of aliased XVisualInfo_Pointer;
-- Pixmap_Pointer
--
type Pixmap_Pointer is access all Pixmap;
type Pixmap_Pointers is array (C.size_t range <>) of aliased Pixmap_Pointer;
-- Font_Pointer
--
type Font_Pointer is access all Font;
type Font_Pointers is array (C.size_t range <>) of aliased Font_Pointer;
-- Window_Pointer
--
type Window_Pointer is access all Window;
type Window_Pointers is array (C.size_t range <>) of aliased Window_Pointer;
-- Bool_Pointer
--
type Bool_Pointer is access all Bool;
type Bool_Pointers is array (C.size_t range <>) of aliased Bool_Pointer;
-- ContextRec_Pointer
--
type ContextRec_Pointer is access all ContextRec;
type ContextRec_Pointers is array (C.size_t range <>) of aliased ContextRec_Pointer;
-- XID_Pointer
--
type XID_Pointer is access all XID;
type XID_Pointers is array (C.size_t range <>) of aliased XID_Pointer;
-- GLXPixmap_Pointer
--
type GLXPixmap_Pointer is access all GLXPixmap;
type GLXPixmap_Pointers is array (C.size_t range <>) of aliased GLXPixmap_Pointer;
-- Drawable_Pointer
--
type Drawable_Pointer is access all Drawable;
type Drawable_Pointers is array (C.size_t range <>) of aliased Drawable_Pointer;
-- FBConfig_Pointer
--
type FBConfig_Pointer is access all FBConfig;
type FBConfig_Pointers is array (C.size_t range <>) of aliased FBConfig_Pointer;
-- GLXFBConfigID_Pointer
--
type FBConfigID_Pointer is access all FBConfigID;
type FBConfigID_Pointers is array (C.size_t range <>) of aliased FBConfigID_Pointer;
-- GLXContextID_Pointer
--
type ContextID_Pointer is access all ContextID;
type ContextID_Pointers is array (C.size_t range <>) of aliased ContextID_Pointer;
-- GLXWindow_Pointer
--
type GLXWindow_Pointer is access all GLXWindow;
type GLXWindow_Pointers is array (C.size_t range <>) of aliased GLXWindow_Pointer;
-- PBuffer_Pointer
--
type PBuffer_Pointer is access all PBuffer;
type PBuffer_Pointers is array (C.size_t range <>) of aliased PBuffer_Pointer;
end GLX.Pointers;

253
3-mid/opengl/source/platform/glx/private/thin/glx.ads Normal file
View File

@@ -0,0 +1,253 @@
with
Interfaces.C,
System;
package GLX
is
use Interfaces;
---------
-- Types
--
-- XEventQueueOwner
--
type XEventQueueOwner is (nil);
for XEventQueueOwner use (nil => 0);
pragma Convention (C, XEventQueueOwner);
type XEventQueueOwner_Pointer is access all XEventQueueOwner;
type XEventQueueOwner_array is array (C.size_t range <>) of aliased XEventQueueOwner;
type XEventQueueOwner_Pointers is array (C.size_t range <>) of aliased XEventQueueOwner_Pointer;
-- XEventQueueOwner_Pointer_Pointer
--
type XEventQueueOwner_Pointer_Pointer is access all glx.XEventQueueOwner_Pointer;
-- VisualID
--
subtype VisualID is C.unsigned_long;
type VisualID_array is array (C.size_t range <>) of aliased VisualID;
-- XVisualInfo
--
subtype XVisualInfo is system.Address;
type XVisualInfo_array is array (C.size_t range <>) of aliased XVisualInfo;
-- Pixmap
--
subtype Pixmap is system.Address;
type Pixmap_array is array (C.size_t range <>) of aliased Pixmap;
-- Font
--
subtype Font is system.Address;
type Font_array is array (C.size_t range <>) of aliased Font;
-- Window
--
subtype Window is system.Address;
type Window_array is array (C.size_t range <>) of aliased Window;
-- Bool
--
subtype Bool is C.int;
type Bool_array is array (C.size_t range <>) of aliased Bool;
-- ContextRec
--
subtype ContextRec is system.Address;
type ContextRec_array is array (C.size_t range <>) of aliased ContextRec;
-- XID
--
subtype XID is system.Address;
type XID_array is array (C.size_t range <>) of aliased XID;
-- GLXPixmap
--
subtype GLXPixmap is XID;
type GLXPixmap_array is array (C.size_t range <>) of aliased glxPixmap;
-- GLXDrawable
--
subtype Drawable is glx.XID;
type Drawable_array is array (C.size_t range <>) of aliased Drawable;
-- FBConfig
--
subtype FBConfig is system.Address;
type FBConfig_array is array (C.size_t range <>) of aliased FBConfig;
-- FBConfigID
--
subtype FBConfigID is XID;
type FBConfigID_array is array (C.size_t range <>) of aliased FBConfigID;
-- ContextID
--
subtype ContextID is XID;
type ContextID_array is array (C.size_t range <>) of aliased ContextID;
-- Window
--
subtype GLXWindow is XID;
type GLXWindow_array is array (C.size_t range <>) of aliased GLXWindow;
-- GLXPbuffer
--
subtype PBuffer is XID;
type PBuffer_array is array (C.size_t range <>) of aliased PBuffer;
-------------
-- Constants
--
GLX_VERSION_1_1 : constant := 1;
GLX_VERSION_1_2 : constant := 1;
GLX_VERSION_1_3 : constant := 1;
GLX_VERSION_1_4 : constant := 1;
GLX_USE_GL : constant := 1;
GLX_BUFFER_SIZE : constant := 2;
GLX_LEVEL : constant := 3;
GLX_RGBA : constant := 4;
GLX_DOUBLEBUFFER : constant := 5;
GLX_STEREO : constant := 6;
GLX_AUX_BUFFERS : constant := 7;
GLX_RED_SIZE : constant := 8;
GLX_GREEN_SIZE : constant := 9;
GLX_BLUE_SIZE : constant := 10;
GLX_ALPHA_SIZE : constant := 11;
GLX_DEPTH_SIZE : constant := 12;
GLX_STENCIL_SIZE : constant := 13;
GLX_ACCUM_RED_SIZE : constant := 14;
GLX_ACCUM_GREEN_SIZE : constant := 15;
GLX_ACCUM_BLUE_SIZE : constant := 16;
GLX_ACCUM_ALPHA_SIZE : constant := 17;
GLX_BAD_SCREEN : constant := 1;
GLX_BAD_ATTRIBUTE : constant := 2;
GLX_NO_EXTENSION : constant := 3;
GLX_BAD_VISUAL : constant := 4;
GLX_BAD_CONTEXT : constant := 5;
GLX_BAD_VALUE : constant := 6;
GLX_BAD_ENUM : constant := 7;
GLX_VENDOR : constant := 1;
GLX_VERSION : constant := 2;
GLX_EXTENSIONS : constant := 3;
GLX_CONFIG_CAVEAT : constant := 16#20#;
GLX_DONT_CARE : constant := 16#ffffffff#;
GLX_X_VISUAL_TYPE : constant := 16#22#;
GLX_TRANSPARENT_TYPE : constant := 16#23#;
GLX_TRANSPARENT_INDEX_VALUE : constant := 16#24#;
GLX_TRANSPARENT_RED_VALUE : constant := 16#25#;
GLX_TRANSPARENT_GREEN_VALUE : constant := 16#26#;
GLX_TRANSPARENT_BLUE_VALUE : constant := 16#27#;
GLX_TRANSPARENT_ALPHA_VALUE : constant := 16#28#;
GLX_WINDOW_BIT : constant := 16#1#;
GLX_PIXMAP_BIT : constant := 16#2#;
GLX_PBUFFER_BIT : constant := 16#4#;
GLX_AUX_BUFFERS_BIT : constant := 16#10#;
GLX_FRONT_LEFT_BUFFER_BIT : constant := 16#1#;
GLX_FRONT_RIGHT_BUFFER_BIT : constant := 16#2#;
GLX_BACK_LEFT_BUFFER_BIT : constant := 16#4#;
GLX_BACK_RIGHT_BUFFER_BIT : constant := 16#8#;
GLX_DEPTH_BUFFER_BIT : constant := 16#20#;
GLX_STENCIL_BUFFER_BIT : constant := 16#40#;
GLX_ACCUM_BUFFER_BIT : constant := 16#80#;
GLX_NONE : constant := 16#8000#;
GLX_SLOW_CONFIG : constant := 16#8001#;
GLX_TRUE_COLOR : constant := 16#8002#;
GLX_DIRECT_COLOR : constant := 16#8003#;
GLX_PSEUDO_COLOR : constant := 16#8004#;
GLX_STATIC_COLOR : constant := 16#8005#;
GLX_GRAY_SCALE : constant := 16#8006#;
GLX_STATIC_GRAY : constant := 16#8007#;
GLX_TRANSPARENT_RGB : constant := 16#8008#;
GLX_TRANSPARENT_INDEX : constant := 16#8009#;
GLX_VISUAL_ID : constant := 16#800b#;
GLX_SCREEN : constant := 16#800c#;
GLX_NON_CONFORMANT_CONFIG : constant := 16#800d#;
GLX_DRAWABLE_TYPE : constant := 16#8010#;
GLX_RENDER_TYPE : constant := 16#8011#;
GLX_X_RENDERABLE : constant := 16#8012#;
GLX_FBCONFIG_ID : constant := 16#8013#;
GLX_RGBA_TYPE : constant := 16#8014#;
GLX_COLOR_INDEX_TYPE : constant := 16#8015#;
GLX_MAX_PBUFFER_WIDTH : constant := 16#8016#;
GLX_MAX_PBUFFER_HEIGHT : constant := 16#8017#;
GLX_MAX_PBUFFER_PIXELS : constant := 16#8018#;
GLX_PRESERVED_CONTENTS : constant := 16#801b#;
GLX_LARGEST_PBUFFER : constant := 16#801c#;
GLX_WIDTH : constant := 16#801d#;
GLX_HEIGHT : constant := 16#801e#;
GLX_EVENT_MASK : constant := 16#801f#;
GLX_DAMAGED : constant := 16#8020#;
GLX_SAVED : constant := 16#8021#;
GLX_WINDOW : constant := 16#8022#;
GLX_PBUFFER : constant := 16#8023#;
GLX_PBUFFER_HEIGHT : constant := 16#8040#;
GLX_PBUFFER_WIDTH : constant := 16#8041#;
GLX_RGBA_BIT : constant := 16#1#;
GLX_COLOR_INDEX_BIT : constant := 16#2#;
GLX_PBUFFER_CLOBBER_MASK : constant := 16#8000000#;
GLX_SAMPLE_BUFFERS : constant := 16#186a0#;
GLX_SAMPLES : constant := 16#186a1#;
GLX_PbufferClobber : constant := 0;
GLX_BufferSwapComplete : constant := 1;
a_a_GLX_NUMBER_EVENTS : constant := 17;
GLX_ARB_render_texture : constant := 1;
GLX_EXT_texture_from_pixmap : constant := 1;
GLX_BIND_TO_TEXTURE_RGB_EXT : constant := 16#20d0#;
GLX_BIND_TO_TEXTURE_RGBA_EXT : constant := 16#20d1#;
GLX_BIND_TO_MIPMAP_TEXTURE_EXT : constant := 16#20d2#;
GLX_BIND_TO_TEXTURE_TARGETS_EXT : constant := 16#20d3#;
GLX_Y_INVERTED_EXT : constant := 16#20d4#;
GLX_TEXTURE_FORMAT_EXT : constant := 16#20d5#;
GLX_TEXTURE_TARGET_EXT : constant := 16#20d6#;
GLX_MIPMAP_TEXTURE_EXT : constant := 16#20d7#;
GLX_TEXTURE_FORMAT_NONE_EXT : constant := 16#20d8#;
GLX_TEXTURE_FORMAT_RGB_EXT : constant := 16#20d9#;
GLX_TEXTURE_FORMAT_RGBA_EXT : constant := 16#20da#;
GLX_TEXTURE_1D_BIT_EXT : constant := 16#1#;
GLX_TEXTURE_2D_BIT_EXT : constant := 16#2#;
GLX_TEXTURE_RECTANGLE_BIT_EXT : constant := 16#4#;
GLX_TEXTURE_1D_EXT : constant := 16#20db#;
GLX_TEXTURE_2D_EXT : constant := 16#20dc#;
GLX_TEXTURE_RECTANGLE_EXT : constant := 16#20dd#;
GLX_FRONT_LEFT_EXT : constant := 16#20de#;
GLX_FRONT_RIGHT_EXT : constant := 16#20df#;
GLX_BACK_LEFT_EXT : constant := 16#20e0#;
GLX_BACK_RIGHT_EXT : constant := 16#20e1#;
GLX_FRONT_EXT : constant := 16#20de#;
GLX_BACK_EXT : constant := 16#20e0#;
GLX_AUX0_EXT : constant := 16#20e2#;
GLX_AUX1_EXT : constant := 16#20e3#;
GLX_AUX2_EXT : constant := 16#20e4#;
GLX_AUX3_EXT : constant := 16#20e5#;
GLX_AUX4_EXT : constant := 16#20e6#;
GLX_AUX5_EXT : constant := 16#20e7#;
GLX_AUX6_EXT : constant := 16#20e8#;
GLX_AUX7_EXT : constant := 16#20e9#;
GLX_AUX8_EXT : constant := 16#20ea#;
GLX_AUX9_EXT : constant := 16#20eb#;
end GLX;

18
3-mid/opengl/source/platform/glx/private/thin/glx_wrap.c Normal file
View File

@@ -0,0 +1,18 @@
#ifdef __cplusplus
extern "C"
{
#endif
#include "GL/glx.h"
VisualID
get_visualid (XVisualInfo* Self)
{
return Self->visualid;
}
#ifdef __cplusplus
}
#endif

55
3-mid/opengl/source/platform/osmesa/opengl-context.adb Normal file
View File

@@ -0,0 +1,55 @@
-- with
-- glx.Pointers;
with
OSMesa_C.Binding,
System;
package body openGL.Context
is
procedure define (Self : in out Item; the_Display : access openGL.Display.item'Class;
the_surface_Profile : in openGL.surface_Profile.item'Class)
is
pragma Unreferenced (the_surface_Profile);
-- use Glx,
-- glx.Pointers;
use OSMesa_C.Binding;
use type System.Address;
begin
Self.Context := OSMesaCreateContext (format => GL.GL_RGBA, -- OSMESA_RGBA,
sharelist => system.Null_Address);
if Self.Context = System.Null_Address
then
raise Program_Error with "no openGL context";
end if;
Self.Display := the_Display;
end define;
procedure make_Current (Self : in Item; read_Surface : in openGL.Surface.item;
write_Surface : in openGL.Surface.item)
is
pragma Unreferenced (write_Surface);
-- Success : glx.Bool; pragma Unreferenced (Success);
begin
null;
end make_Current;
-- function glx_Context_debug (Self : in Item'Class) return GLX.GLXContext.item
-- is
-- begin
-- return self.glx_Context;
-- end glx_Context_debug;
end openGL.Context;

41
3-mid/opengl/source/platform/osmesa/opengl-context.ads Normal file
View File

@@ -0,0 +1,41 @@
with
openGL.Display,
openGL.surface_Profile,
openGL.Surface,
OSMesa_C;
-- Glx.GLXContext;
package openGL.Context
--
-- Models an openGL (GLX) context.
--
is
type Item is tagged private;
type View is access all Item'Class;
procedure define (Self : in out Item; the_Display : access openGL.Display .item'Class;
the_surface_Profile : in openGL.surface_Profile.item'Class);
procedure make_Current (Self : in Item; read_Surface : in openGL.Surface.item;
write_Surface : in openGL.Surface.item);
-- function glx_Context_debug (Self : in Item'Class) return GLX.GLXContext.item; -- For debug.
private
type Item is tagged
record
-- glx_Context : aliased GLX.GLXContext.item;
Context : OSMesa_C.OSMesaContext;
Display : access openGL.Display.item'Class;
end record;
end openGL.Context;

25
3-mid/opengl/source/platform/osmesa/opengl-display.adb Normal file
View File

@@ -0,0 +1,25 @@
with
interfaces.C.Strings;
package body openGL.Display
is
function Default return Item
is
Self : Display.item;
begin
return Self;
end Default;
function screen_Id (Self : in Item) return interfaces.c.int
is
begin
return Self.screen_Id;
end screen_Id;
end openGL.Display;

30
3-mid/opengl/source/platform/osmesa/opengl-display.ads Normal file
View File

@@ -0,0 +1,30 @@
with
Interfaces.C;
package openGL.Display
--
-- Models an openGL display.
--
is
type Item is tagged private;
function Default return Item;
function screen_Id (Self : in Item) return interfaces.C.int;
private
use Interfaces;
type Item is tagged
record
screen_Id : aliased interfaces.C.int;
end record;
end openGL.Display;

18
3-mid/opengl/source/platform/osmesa/opengl-screen.ads Normal file
View File

@@ -0,0 +1,18 @@
package openGL.Screen
--
-- Models an openGL screen.
--
is
type Item is tagged limited private;
private
type Item is tagged limited
record
null;
end record;
end openGL.Screen;

52
3-mid/opengl/source/platform/osmesa/opengl-surface.adb Normal file
View File

@@ -0,0 +1,52 @@
with
openGL.Context,
interfaces.C;
package body openGL.Surface
is
use -- Glx,
Interfaces;
-- visual_attribs : array (Positive range <>) of aliased C.int := (GLX_X_RENDERABLE, 1,
-- GLX_DRAWABLE_TYPE, GLX_WINDOW_BIT,
-- GLX_RENDER_TYPE, GLX_RGBA_BIT,
-- GLX_X_VISUAL_TYPE, GLX_TRUE_COLOR,
-- GLX_RED_SIZE, 8,
-- GLX_GREEN_SIZE, 8,
-- GLX_BLUE_SIZE, 8,
-- GLX_ALPHA_SIZE, 8,
-- GLX_DEPTH_SIZE, 24,
-- GLX_STENCIL_SIZE, 8,
-- GLX_DOUBLEBUFFER, 1,
-- -- GLX_SAMPLE_BUFFERS , 1,
-- -- GLX_SAMPLES , 4,
-- 0
-- );
procedure define (Self : in out Item; surface_Profile : in openGL.surface_Profile.item'Class;
Display : in openGL.Display.Item;
Window_Id : in Natural)
is
pragma Unreferenced (Window_Id);
the_surface_Profile : constant openGL.surface_Profile.item'Class := surface_Profile;
begin
Self.Display := Display;
end define;
-- Operations
--
procedure swap_Buffers (Self : in Item)
is
begin
null;
end swap_Buffers;
end openGL.Surface;

47
3-mid/opengl/source/platform/osmesa/opengl-surface.ads Normal file
View File

@@ -0,0 +1,47 @@
with
openGL.surface_Profile,
openGL.Display;
-- private
-- with
-- Glx;
limited
with
openGL.Context;
package openGL.Surface
--
-- Models an openGL surface.
--
is
type Item is tagged private;
type Items is array (Positive range <>) of aliased Item;
type View is access all Item'class;
type Views is array (Positive range <>) of View;
procedure define (Self : in out Item; surface_Profile : in openGL.surface_Profile.item'Class;
Display : in openGL.Display.Item;
Window_Id : in Natural);
-- Operations
--
procedure swap_Buffers (Self : in Item);
private
type Item is tagged
record
-- glx_Surface : glx.GLXDrawable;
Context : access openGL.Context.item'Class;
Display : openGL.Display.item;
end record;
end openGL.Surface;

112
3-mid/opengl/source/platform/osmesa/opengl-surface_profile.adb Normal file
View File

@@ -0,0 +1,112 @@
with
interfaces.C,
ada.unchecked_Conversion;
package body openGL.surface_Profile
is
use Interfaces,
OSMesa_c;
-- visual_attribs : array (Positive range <>) of aliased C.int := (GLX_X_RENDERABLE, 1,
-- GLX_DRAWABLE_TYPE, GLX_WINDOW_BIT,
-- GLX_RENDER_TYPE, GLX_RGBA_BIT,
-- GLX_X_VISUAL_TYPE, GLX_TRUE_COLOR,
-- GLX_RED_SIZE, 8,
-- GLX_GREEN_SIZE, 8,
-- GLX_BLUE_SIZE, 8,
-- GLX_ALPHA_SIZE, 8,
-- GLX_DEPTH_SIZE, 24,
-- GLX_STENCIL_SIZE, 8,
-- GLX_DOUBLEBUFFER, 1,
-- -- GLX_SAMPLE_BUFFERS , 1,
-- -- GLX_SAMPLES , 4,
-- 0
-- );
procedure define (Self : in out Item; the_Display : access openGL.Display.item'Class;
Screen : access openGL.Screen .item'Class;
Desired : in Qualities := default_Qualities)
is
pragma Unreferenced (Desired);
use openGL.Screen;
default_screen : constant C.int := the_Display.screen_Id;
num_fb_configs : aliased C.int := 0;
visual_Id : aliased C.int;
unused : C.int; pragma Unreferenced (unused);
begin
Self.Display := the_Display;
end define;
-- function get_Visual (Self : in Item) return access GLX.XVisualInfo
-- is
-- begin
-- return Self.Visual;
-- end get_Visual;
function fetch_All (the_Display : access openGL.Display.item'class) return surface_Profile.items
is
begin
raise Program_Error with "TBD";
return (1 .. 0 => <>);
end fetch_All;
function Quality (Self : in Item) return Qualities
is
pragma Unreferenced (Self);
begin
raise Program_Error with "TBD";
return (others => <>);
end Quality;
function value_Image (Value : in Natural) return String
is
begin
if Value = Irrelevant then
return "Irrelevant";
else
return Natural'Image (Value);
end if;
end value_Image;
function Image (Self : in color_Buffer) return String
is
begin
return
"Bits_red =>" & value_Image (Self.Bits_red)
& " Bits_green =>" & value_Image (Self.Bits_green)
& " Bits_blue =>" & value_Image (Self.Bits_blue)
& " Bits_luminence =>" & value_Image (Self.Bits_luminence)
& " Bits_alpha =>" & value_Image (Self.Bits_alpha)
& " Bits_alpha_mask =>" & value_Image (Self.Bits_alpha_mask);
end Image;
function Image (Self : in Qualities) return String
is
begin
return
Image (Self.color_Buffer)
& " depth_buffer_Bits =>" & value_Image (Self.depth_buffer_Bits)
& " stencil_buffer_Bits => " & value_Image (Self.stencil_buffer_Bits);
end Image;
end openGL.surface_Profile;

100
3-mid/opengl/source/platform/osmesa/opengl-surface_profile.ads Normal file
View File

@@ -0,0 +1,100 @@
with
openGL.Display,
openGL.Screen,
OSMesa_C;
package openGL.surface_Profile
--
-- Models an openGL surface profile.
--
is
type Item is tagged private;
type View is access all Item'Class;
type Items is array (Positive range <>) of Item;
-------------------
-- Surface Quality
--
Irrelevant : constant Natural := Natural'Last;
type color_Buffer is
record
Bits_red : Natural := Irrelevant;
Bits_green : Natural := Irrelevant;
Bits_blue : Natural := Irrelevant;
Bits_luminence : Natural := Irrelevant;
Bits_alpha : Natural := Irrelevant;
Bits_alpha_mask : Natural := Irrelevant;
end record;
function Image (Self : in color_Buffer) return String;
type Qualities is
record
color_Buffer : surface_Profile.color_Buffer;
depth_buffer_Bits : Natural := Irrelevant;
stencil_buffer_Bits : Natural := Irrelevant;
end record;
default_Qualities : constant Qualities;
function Image (Self : in Qualities) return String;
---------
-- Forge
--
desired_Qualitites_unavailable : exception;
procedure define (Self : in out Item; the_Display : access openGL.Display.item'Class;
Screen : access openGL.Screen .item'Class;
Desired : in Qualities := default_Qualities);
function fetch_All (the_Display : access openGL.Display.item'class) return surface_Profile.items;
--------------
-- Attributes
--
function Quality (Self : in Item) return Qualities;
-- function get_Visual (Self : in Item) return access GLX.XVisualInfo;
private
type Item is tagged
record
-- glx_Config : GLX.GLXFBConfig;
Display : access openGL.Display.item'Class;
-- Visual : access GLX.XVisualInfo;
end record;
default_Qualities : constant Qualities := (color_Buffer => (Bits_red => 8,
Bits_green => 8,
Bits_blue => 8,
Bits_luminence => Irrelevant,
Bits_alpha => Irrelevant,
Bits_alpha_mask => Irrelevant),
depth_buffer_Bits => 24,
stencil_buffer_Bits => Irrelevant);
end openGL.surface_Profile;

13
3-mid/opengl/source/platform/osmesa/private/opengl-surface-privvy.adb Normal file
View File

@@ -0,0 +1,13 @@
package body openGL.Surface.privvy
is
-- function to_glx (Self : in Surface.item'Class) return glx.GLXDrawable
-- is
-- begin
-- return Self.glx_Surface;
-- end to_glx;
procedure dummy is begin null; end;
end openGL.Surface.privvy;

11
3-mid/opengl/source/platform/osmesa/private/opengl-surface-privvy.ads Normal file
View File

@@ -0,0 +1,11 @@
-- with
-- Glx;
package openGL.Surface.privvy
is
-- function to_glx (Self : in Surface.item'Class) return glx.GLXDrawable;
procedure dummy;
end openGL.Surface.privvy;

14
3-mid/opengl/source/platform/osmesa/private/opengl-surface_profile-privvy.adb Normal file
View File

@@ -0,0 +1,14 @@
package body openGL.surface_Profile.privvy
is
-- function to_glx (Self : in Item'Class) return GLX.GLXFBConfig
-- is
-- begin
-- return Self.glx_Config;
-- end to_glx;
procedure dummy is begin null; end;
end openGL.surface_Profile.privvy;

8
3-mid/opengl/source/platform/osmesa/private/opengl-surface_profile-privvy.ads Normal file
View File

@@ -0,0 +1,8 @@
package openGL.surface_Profile.privvy
is
-- function to_glx (Self : in Item'Class) return glx.GLXFBConfig;
procedure dummy;
end openGL.surface_Profile.privvy;

81
3-mid/opengl/source/platform/osmesa/private/thin/osmesa_c-binding.ads Normal file
View File

@@ -0,0 +1,81 @@
-- This file is generated by SWIG. Please do *not* modify by hand.
--
with Interfaces.C;
with Interfaces.C.Strings;
with osmesa_c.Pointers;
with Swig;
with Swig.Pointers;
with Interfaces.C;
package osmesa_c.Binding is
function OSMesaCreateContext
(format : in osmesa_c.GLenum;
sharelist : in osmesa_c.OSMesaContext) return osmesa_c.OSMesaContext;
function OSMesaCreateContextExt
(format : in osmesa_c.GLenum;
depthBits : in osmesa_c.GLint;
stencilBits : in osmesa_c.GLint;
accumBits : in osmesa_c.GLint;
sharelist : in osmesa_c.OSMesaContext) return osmesa_c.OSMesaContext;
procedure OSMesaDestroyContext (ctx : in osmesa_c.OSMesaContext);
function OSMesaMakeCurrent
(ctx : in osmesa_c.OSMesaContext;
buffer : in Swig.void_ptr;
the_type : in osmesa_c.GLenum;
width : in osmesa_c.GLsizei;
height : in osmesa_c.GLsizei) return osmesa_c.GLboolean;
function OSMesaGetCurrentContext return osmesa_c.OSMesaContext;
procedure OSMesaPixelStore
(pname : in osmesa_c.GLint;
value : in osmesa_c.GLint);
procedure OSMesaGetIntegerv
(pname : in osmesa_c.GLint;
value : in osmesa_c.Pointers.GLint_Pointer);
function OSMesaGetDepthBuffer
(c : in osmesa_c.OSMesaContext;
width : in osmesa_c.Pointers.GLint_Pointer;
height : in osmesa_c.Pointers.GLint_Pointer;
bytesPerValue : in osmesa_c.Pointers.GLint_Pointer;
buffer : in Swig.Pointers.void_ptr_Pointer) return osmesa_c.GLboolean;
function OSMesaGetColorBuffer
(c : in osmesa_c.OSMesaContext;
width : in osmesa_c.Pointers.GLint_Pointer;
height : in osmesa_c.Pointers.GLint_Pointer;
format : in osmesa_c.Pointers.GLint_Pointer;
buffer : in Swig.Pointers.void_ptr_Pointer) return osmesa_c.GLboolean;
function OSMesaGetProcAddress
(funcName : in Interfaces.C.Strings.chars_ptr) return osmesa_c.OSMESAproc;
procedure OSMesaColorClamp (enable : in osmesa_c.GLboolean);
procedure OSMesaPostprocess
(osmesa : in osmesa_c.OSMesaContext;
filter : in Interfaces.C.Strings.chars_ptr;
enable_value : in Interfaces.C.unsigned);
private
pragma Import (C, OSMesaCreateContext, "Ada_OSMesaCreateContext");
pragma Import (C, OSMesaCreateContextExt, "Ada_OSMesaCreateContextExt");
pragma Import (C, OSMesaDestroyContext, "Ada_OSMesaDestroyContext");
pragma Import (C, OSMesaMakeCurrent, "Ada_OSMesaMakeCurrent");
pragma Import (C, OSMesaGetCurrentContext, "Ada_OSMesaGetCurrentContext");
pragma Import (C, OSMesaPixelStore, "Ada_OSMesaPixelStore");
pragma Import (C, OSMesaGetIntegerv, "Ada_OSMesaGetIntegerv");
pragma Import (C, OSMesaGetDepthBuffer, "Ada_OSMesaGetDepthBuffer");
pragma Import (C, OSMesaGetColorBuffer, "Ada_OSMesaGetColorBuffer");
pragma Import (C, OSMesaGetProcAddress, "Ada_OSMesaGetProcAddress");
pragma Import (C, OSMesaColorClamp, "Ada_OSMesaColorClamp");
pragma Import (C, OSMesaPostprocess, "Ada_OSMesaPostprocess");
end osmesa_c.Binding;

36
3-mid/opengl/source/platform/osmesa/private/thin/osmesa_c-pointer_pointers.ads Normal file
View File

@@ -0,0 +1,36 @@
-- This file is generated by SWIG. Please do *not* modify by hand.
--
with osmesa_c.Pointers;
with Interfaces.C;
package osmesa_c.pointer_Pointers is
-- GLenum_Pointer_Pointer
--
type GLenum_Pointer_Pointer is access all osmesa_c.Pointers.GLenum_Pointer;
-- GLint_Pointer_Pointer
--
type GLint_Pointer_Pointer is access all osmesa_c.Pointers.GLint_Pointer;
-- GLsizei_Pointer_Pointer
--
type GLsizei_Pointer_Pointer is
access all osmesa_c.Pointers.GLsizei_Pointer;
-- GLboolean_Pointer_Pointer
--
type GLboolean_Pointer_Pointer is
access all osmesa_c.Pointers.GLboolean_Pointer;
-- OSMesaContext_Pointer_Pointer
--
type OSMesaContext_Pointer_Pointer is
access all osmesa_c.Pointers.OSMesaContext_Pointer;
-- OSMESAproc_Pointer_Pointer
--
type OSMESAproc_Pointer_Pointer is
access all osmesa_c.Pointers.OSMESAproc_Pointer;
end osmesa_c.pointer_Pointers;

73
3-mid/opengl/source/platform/osmesa/private/thin/osmesa_c-pointers.ads Normal file
View File

@@ -0,0 +1,73 @@
-- This file is generated by SWIG. Please do *not* modify by hand.
--
with Interfaces.C;
package osmesa_c.Pointers is
-- GLenum_Pointer
--
type GLenum_Pointer is access all osmesa_c.GLenum;
-- GLenum_Pointers
--
type GLenum_Pointers is
array
(Interfaces.C
.size_t range <>) of aliased osmesa_c.Pointers.GLenum_Pointer;
-- GLint_Pointer
--
type GLint_Pointer is access all osmesa_c.GLint;
-- GLint_Pointers
--
type GLint_Pointers is
array
(Interfaces.C
.size_t range <>) of aliased osmesa_c.Pointers.GLint_Pointer;
-- GLsizei_Pointer
--
type GLsizei_Pointer is access all osmesa_c.GLsizei;
-- GLsizei_Pointers
--
type GLsizei_Pointers is
array
(Interfaces.C
.size_t range <>) of aliased osmesa_c.Pointers.GLsizei_Pointer;
-- GLboolean_Pointer
--
type GLboolean_Pointer is access all osmesa_c.GLboolean;
-- GLboolean_Pointers
--
type GLboolean_Pointers is
array
(Interfaces.C
.size_t range <>) of aliased osmesa_c.Pointers.GLboolean_Pointer;
-- OSMesaContext_Pointer
--
type OSMesaContext_Pointer is access all osmesa_c.OSMesaContext;
-- OSMesaContext_Pointers
--
type OSMesaContext_Pointers is
array
(Interfaces.C
.size_t range <>) of aliased osmesa_c.Pointers.OSMesaContext_Pointer;
-- OSMESAproc_Pointer
--
type OSMESAproc_Pointer is access all osmesa_c.OSMESAproc;
-- OSMESAproc_Pointers
--
type OSMESAproc_Pointers is
array
(Interfaces.C
.size_t range <>) of aliased osmesa_c.Pointers.OSMESAproc_Pointer;
end osmesa_c.Pointers;

79
3-mid/opengl/source/platform/osmesa/private/thin/osmesa_c.ads Normal file
View File

@@ -0,0 +1,79 @@
-- This file is generated by SWIG. Please do *not* modify by hand.
--
with Interfaces.C;
with Swig;
with Interfaces.C;
package osmesa_c is
-- GLenum
--
subtype GLenum is Interfaces.C.unsigned;
type GLenum_array is
array (Interfaces.C.size_t range <>) of aliased osmesa_c.GLenum;
-- GLint
--
subtype GLint is Interfaces.C.int;
type GLint_array is
array (Interfaces.C.size_t range <>) of aliased osmesa_c.GLint;
-- GLsizei
--
subtype GLsizei is Interfaces.C.int;
type GLsizei_array is
array (Interfaces.C.size_t range <>) of aliased osmesa_c.GLsizei;
-- GLboolean
--
subtype GLboolean is Interfaces.C.unsigned_char;
type GLboolean_array is
array (Interfaces.C.size_t range <>) of aliased osmesa_c.GLboolean;
-- OSMesaContext
--
subtype OSMesaContext is Swig.opaque_structure;
type OSMesaContext_array is
array (Interfaces.C.size_t range <>) of aliased osmesa_c.OSMesaContext;
-- OSMESAproc
--
type OSMESAproc is access
procedure;
pragma Convention (C, OSMESAproc);
-- OSMESAprocs
--
type OSMESAprocs is
array (Interfaces.C.size_t range <>) of aliased osmesa_c.OSMESAproc;
OSMESA_MAJOR_VERSION : constant := 11;
OSMESA_MINOR_VERSION : constant := 2;
OSMESA_PATCH_VERSION : constant := 0;
OSMESA_BGRA : constant := 16#1#;
OSMESA_ARGB : constant := 16#2#;
OSMESA_BGR : constant := 16#4#;
OSMESA_RGB_565 : constant := 16#5#;
OSMESA_ROW_LENGTH : constant := 16#10#;
OSMESA_Y_UP : constant := 16#11#;
OSMESA_WIDTH : constant := 16#20#;
OSMESA_HEIGHT : constant := 16#21#;
OSMESA_FORMAT : constant := 16#22#;
OSMESA_TYPE : constant := 16#23#;
OSMESA_MAX_WIDTH : constant := 16#24#;
OSMESA_MAX_HEIGHT : constant := 16#25#;
OSMESA_DEPTH_BITS : constant := 16#30#;
OSMESA_STENCIL_BITS : constant := 16#31#;
OSMESA_ACCUM_BITS : constant := 16#32#;
OSMESA_PROFILE : constant := 16#33#;
OSMESA_CORE_PROFILE : constant := 16#34#;
OSMESA_COMPAT_PROFILE : constant := 16#35#;
OSMESA_CONTEXT_MAJOR_VERSION : constant := 16#36#;
OSMESA_CONTEXT_MINOR_VERSION : constant := 16#37#;
end osmesa_c;

445
3-mid/opengl/source/platform/osmesa/private/thin/osmesa_wrap.c Normal file
View File

@@ -0,0 +1,445 @@
/* ----------------------------------------------------------------------------
* This file was automatically generated by SWIG (http://www.swig.org).
* Version 1.3.36
*
* This file is not intended to be easily readable and contains a number of
* coding conventions designed to improve portability and efficiency. Do not make
* changes to this file unless you know what you are doing--modify the SWIG
* interface file instead.
* ----------------------------------------------------------------------------- */
#ifdef __cplusplus
template < typename T > class SwigValueWrapper
{
T *tt;
public:
SwigValueWrapper ():tt (0)
{
}
SwigValueWrapper (const SwigValueWrapper < T > &rhs):tt (new T (*rhs.tt))
{
}
SwigValueWrapper (const T & t):tt (new T (t))
{
}
~SwigValueWrapper ()
{
delete tt;
}
SwigValueWrapper & operator= (const T & t)
{
delete tt;
tt = new T (t);
return *this;
}
operator T & () const
{
return *tt;
}
T *operator& ()
{
return tt;
}
private:
SwigValueWrapper & operator= (const SwigValueWrapper < T > &rhs);
};
template < typename T > T SwigValueInit ()
{
return T ();
}
#endif
/* -----------------------------------------------------------------------------
* This section contains generic SWIG labels for method/variable
* declarations/attributes, and other compiler dependent labels.
* ----------------------------------------------------------------------------- */
/* template workaround for compilers that cannot correctly implement the C++ standard */
#ifndef SWIGTEMPLATEDISAMBIGUATOR
#if defined(__SUNPRO_CC) && (__SUNPRO_CC <= 0x560)
#define SWIGTEMPLATEDISAMBIGUATOR template
#elif defined(__HP_aCC)
/* Needed even with `aCC -AA' when `aCC -V' reports HP ANSI C++ B3910B A.03.55 */
/* If we find a maximum version that requires this, the test would be __HP_aCC <= 35500 for A.03.55 */
#define SWIGTEMPLATEDISAMBIGUATOR template
#else
#define SWIGTEMPLATEDISAMBIGUATOR
#endif
#endif
/* inline attribute */
#ifndef SWIGINLINE
#if defined(__cplusplus) || (defined(__GNUC__) && !defined(__STRICT_ANSI__))
#define SWIGINLINE inline
#else
#define SWIGINLINE
#endif
#endif
/* attribute recognised by some compilers to avoid 'unused' warnings */
#ifndef SWIGUNUSED
#if defined(__GNUC__)
#if !(defined(__cplusplus)) || (__GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4))
#define SWIGUNUSED __attribute__ ((__unused__))
#else
#define SWIGUNUSED
#endif
#elif defined(__ICC)
#define SWIGUNUSED __attribute__ ((__unused__))
#else
#define SWIGUNUSED
#endif
#endif
#ifndef SWIGUNUSEDPARM
#ifdef __cplusplus
#define SWIGUNUSEDPARM(p)
#else
#define SWIGUNUSEDPARM(p) p SWIGUNUSED
#endif
#endif
/* internal SWIG method */
#ifndef SWIGINTERN
#define SWIGINTERN static SWIGUNUSED
#endif
/* internal inline SWIG method */
#ifndef SWIGINTERNINLINE
#define SWIGINTERNINLINE SWIGINTERN SWIGINLINE
#endif
/* exporting methods */
#if (__GNUC__ >= 4) || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4)
#ifndef GCC_HASCLASSVISIBILITY
#define GCC_HASCLASSVISIBILITY
#endif
#endif
#ifndef SWIGEXPORT
#if defined(_WIN32) || defined(__WIN32__) || defined(__CYGWIN__)
#if defined(STATIC_LINKED)
#define SWIGEXPORT
#else
#define SWIGEXPORT __declspec(dllexport)
#endif
#else
#if defined(__GNUC__) && defined(GCC_HASCLASSVISIBILITY)
#define SWIGEXPORT __attribute__ ((visibility("default")))
#else
#define SWIGEXPORT
#endif
#endif
#endif
/* calling conventions for Windows */
#ifndef SWIGSTDCALL
#if defined(_WIN32) || defined(__WIN32__) || defined(__CYGWIN__)
#define SWIGSTDCALL __stdcall
#else
#define SWIGSTDCALL
#endif
#endif
/* Deal with Microsoft's attempt at deprecating C standard runtime functions */
#if !defined(SWIG_NO_CRT_SECURE_NO_DEPRECATE) && defined(_MSC_VER) && !defined(_CRT_SECURE_NO_DEPRECATE)
#define _CRT_SECURE_NO_DEPRECATE
#endif
/* Deal with Microsoft's attempt at deprecating methods in the standard C++ library */
#if !defined(SWIG_NO_SCL_SECURE_NO_DEPRECATE) && defined(_MSC_VER) && !defined(_SCL_SECURE_NO_DEPRECATE)
#define _SCL_SECURE_NO_DEPRECATE
#endif
#include <stdlib.h>
#include <string.h>
#include <stdio.h>
#if defined(_WIN32) || defined(__CYGWIN32__)
#define DllExport __declspec( dllexport )
#define SWIGSTDCALL __stdcall
#else
#define DllExport
#define SWIGSTDCALL
#endif
#ifdef __cplusplus
#include <new>
#endif
/* Callback for returning strings to Ada without leaking memory */
typedef char *(SWIGSTDCALL * SWIG_AdaStringHelperCallback) (const char *);
static SWIG_AdaStringHelperCallback SWIG_ada_string_callback = NULL;
/* probably obsolete ...
#ifdef __cplusplus
extern "C"
#endif
DllExport void SWIGSTDCALL SWIGRegisterStringCallback_CORE_MODULE(SWIG_AdaStringHelperCallback callback) {
SWIG_ada_string_callback = callback;
}
*/
/* Contract support */
/*
#define SWIG_contract_assert(nullreturn, expr, msg) if (!(expr)) {SWIG_AdaThrowException(SWIG_AdaArgumentOutOfRangeException, msg); return nullreturn; } else
*/
#define protected public
#define private public
#include "GL/osmesa.h"
#undef protected
#undef private
#ifdef __cplusplus
extern "C"
{
#endif
DllExport void *SWIGSTDCALL Ada_OSMesaCreateContext (unsigned int jarg1,
void *jarg2)
{
void *jresult;
GLenum arg1;
OSMesaContext arg2 = (OSMesaContext) 0;
OSMesaContext result;
arg1 = (GLenum) jarg1;
arg2 = (OSMesaContext) jarg2;
result = (OSMesaContext) OSMesaCreateContext (arg1, arg2);
jresult = (void *) result;
return jresult;
}
DllExport void *SWIGSTDCALL Ada_OSMesaCreateContextExt (unsigned int jarg1,
int jarg2,
int jarg3,
int jarg4,
void *jarg5)
{
void *jresult;
GLenum arg1;
GLint arg2;
GLint arg3;
GLint arg4;
OSMesaContext arg5 = (OSMesaContext) 0;
OSMesaContext result;
arg1 = (GLenum) jarg1;
arg2 = (GLint) jarg2;
arg3 = (GLint) jarg3;
arg4 = (GLint) jarg4;
arg5 = (OSMesaContext) jarg5;
result =
(OSMesaContext) OSMesaCreateContextExt (arg1, arg2, arg3, arg4, arg5);
jresult = (void *) result;
return jresult;
}
DllExport void SWIGSTDCALL Ada_OSMesaDestroyContext (void *jarg1)
{
OSMesaContext arg1 = (OSMesaContext) 0;
arg1 = (OSMesaContext) jarg1;
OSMesaDestroyContext (arg1);
}
DllExport unsigned char SWIGSTDCALL Ada_OSMesaMakeCurrent (void *jarg1,
void *jarg2,
unsigned int
jarg3, int jarg4,
int jarg5)
{
unsigned char jresult;
OSMesaContext arg1 = (OSMesaContext) 0;
void *arg2 = (void *) 0;
GLenum arg3;
GLsizei arg4;
GLsizei arg5;
GLboolean result;
arg1 = (OSMesaContext) jarg1;
arg2 = (void *) jarg2;
arg3 = (GLenum) jarg3;
arg4 = (GLsizei) jarg4;
arg5 = (GLsizei) jarg5;
result = (GLboolean) OSMesaMakeCurrent (arg1, arg2, arg3, arg4, arg5);
jresult = result;
return jresult;
}
DllExport void *SWIGSTDCALL Ada_OSMesaGetCurrentContext ()
{
void *jresult;
OSMesaContext result;
result = (OSMesaContext) OSMesaGetCurrentContext ();
jresult = (void *) result;
return jresult;
}
DllExport void SWIGSTDCALL Ada_OSMesaPixelStore (int jarg1, int jarg2)
{
GLint arg1;
GLint arg2;
arg1 = (GLint) jarg1;
arg2 = (GLint) jarg2;
OSMesaPixelStore (arg1, arg2);
}
DllExport void SWIGSTDCALL Ada_OSMesaGetIntegerv (int jarg1, int *jarg2)
{
GLint arg1;
GLint *arg2 = (GLint *) 0;
arg1 = (GLint) jarg1;
arg2 = (GLint *) jarg2;
OSMesaGetIntegerv (arg1, arg2);
}
DllExport unsigned char SWIGSTDCALL Ada_OSMesaGetDepthBuffer (void *jarg1,
int *jarg2,
int *jarg3,
int *jarg4,
void *jarg5)
{
unsigned char jresult;
OSMesaContext arg1 = (OSMesaContext) 0;
GLint *arg2 = (GLint *) 0;
GLint *arg3 = (GLint *) 0;
GLint *arg4 = (GLint *) 0;
void **arg5 = (void **) 0;
GLboolean result;
arg1 = (OSMesaContext) jarg1;
arg2 = (GLint *) jarg2;
arg3 = (GLint *) jarg3;
arg4 = (GLint *) jarg4;
arg5 = (void **) jarg5;
result = (GLboolean) OSMesaGetDepthBuffer (arg1, arg2, arg3, arg4, arg5);
jresult = result;
return jresult;
}
DllExport unsigned char SWIGSTDCALL Ada_OSMesaGetColorBuffer (void *jarg1,
int *jarg2,
int *jarg3,
int *jarg4,
void *jarg5)
{
unsigned char jresult;
OSMesaContext arg1 = (OSMesaContext) 0;
GLint *arg2 = (GLint *) 0;
GLint *arg3 = (GLint *) 0;
GLint *arg4 = (GLint *) 0;
void **arg5 = (void **) 0;
GLboolean result;
arg1 = (OSMesaContext) jarg1;
arg2 = (GLint *) jarg2;
arg3 = (GLint *) jarg3;
arg4 = (GLint *) jarg4;
arg5 = (void **) jarg5;
result = (GLboolean) OSMesaGetColorBuffer (arg1, arg2, arg3, arg4, arg5);
jresult = result;
return jresult;
}
DllExport void *SWIGSTDCALL Ada_OSMesaGetProcAddress (char *jarg1)
{
void *jresult;
char *arg1 = (char *) 0;
OSMESAproc result;
arg1 = jarg1;
result = (OSMESAproc) OSMesaGetProcAddress ((char const *) arg1);
jresult = (void *) result;
return jresult;
}
DllExport void SWIGSTDCALL Ada_OSMesaColorClamp (unsigned char jarg1)
{
GLboolean arg1;
arg1 = (GLboolean) jarg1;
OSMesaColorClamp (arg1);
}
DllExport void SWIGSTDCALL Ada_OSMesaPostprocess (void *jarg1,
char *jarg2,
unsigned int jarg3)
{
OSMesaContext arg1 = (OSMesaContext) 0;
char *arg2 = (char *) 0;
unsigned int arg3;
arg1 = (OSMesaContext) jarg1;
arg2 = jarg2;
arg3 = (unsigned int) jarg3;
OSMesaPostprocess (arg1, (char const *) arg2, arg3);
}
#ifdef __cplusplus
}
#endif
#ifdef __cplusplus
extern "C"
{
#endif
#ifdef __cplusplus
}
#endif

368
3-mid/opengl/source/platform/osmesa/private/thin/swig-pointers.ads Normal file
View File

@@ -0,0 +1,368 @@
with
interfaces.C.Pointers,
interfaces.C.Strings,
system.Address_To_Access_Conversions;
package swig.Pointers
--
-- Contains pointers to Swig related C type definitions not found in the 'interfaces.C' family.
--
is
-- void_ptr
--
package C_void_ptr_Pointers is new interfaces.c.Pointers (Index => interfaces.c.size_t,
Element => swig.void_ptr,
element_Array => void_ptr_Array,
default_Terminator => system.null_Address);
subtype void_ptr_Pointer is C_void_ptr_Pointers.Pointer;
-- opaque struct_ptr
--
type opaque_structure_ptr is access swig.opaque_structure;
type opaque_structure_ptr_array is array (interfaces.c.Size_t range <>) of aliased opaque_structure_ptr;
package C_opaque_structure_ptr_Pointers is new interfaces.c.Pointers (Index => interfaces.c.size_t,
Element => opaque_structure_ptr,
element_Array => opaque_structure_ptr_array,
default_Terminator => null);
subtype opaque_structure_ptr_Pointer is C_opaque_structure_ptr_Pointers.Pointer;
-- incomplete class
--
type incomplete_class_ptr is access swig.incomplete_class;
type incomplete_class_ptr_array is array (interfaces.c.Size_t range <>) of aliased incomplete_class_ptr;
package C_incomplete_class_ptr_Pointers is new interfaces.c.Pointers (Index => interfaces.c.size_t,
Element => incomplete_class_ptr,
element_Array => incomplete_class_ptr_array,
default_Terminator => null);
subtype incomplete_class_ptr_Pointer is C_incomplete_class_ptr_Pointers.Pointer;
-- bool*
--
package c_bool_Pointers is new interfaces.c.Pointers (Index => interfaces.c.size_t,
Element => swig.bool,
element_Array => bool_Array,
default_Terminator => 0);
subtype bool_Pointer is c_bool_Pointers.Pointer;
type bool_Pointer_array is array (interfaces.c.Size_t range <>) of aliased bool_Pointer;
-- bool**
--
package C_bool_pointer_Pointers is new interfaces.c.Pointers (Index => interfaces.c.size_t,
Element => bool_Pointer,
element_Array => bool_Pointer_array,
default_Terminator => null);
subtype bool_pointer_Pointer is C_bool_pointer_Pointers.Pointer;
-- char* []
--
type chars_ptr_array is array (interfaces.c.Size_t range <>) of aliased interfaces.c.strings.chars_Ptr; -- standard Ada does not have 'aliased'
package C_chars_ptr_Pointers is new interfaces.c.Pointers (Index => interfaces.c.size_t,
Element => interfaces.c.strings.chars_ptr,
element_Array => chars_ptr_array,
default_Terminator => interfaces.c.strings.Null_Ptr);
subtype chars_ptr_Pointer is C_chars_ptr_Pointers.Pointer;
-- char** []
--
type chars_ptr_Pointer_array is array (interfaces.c.Size_t range <>) of aliased chars_ptr_Pointer;
package C_chars_ptr_pointer_Pointers is new interfaces.c.Pointers (Index => interfaces.c.size_t,
Element => chars_ptr_Pointer,
element_Array => chars_ptr_Pointer_array,
default_Terminator => null);
subtype chars_ptr_pointer_Pointer is C_chars_ptr_pointer_Pointers.Pointer;
-- wchar_t*
--
package c_wchar_t_Pointers is new interfaces.c.Pointers (Index => interfaces.c.size_t,
Element => interfaces.c.wchar_t,
element_Array => interfaces.c.wchar_array,
default_Terminator => interfaces.c.wchar_t'First);
subtype wchar_t_Pointer is c_wchar_t_Pointers.Pointer;
-- signed char*
--
package c_signed_char_Pointers is new interfaces.c.Pointers (Index => interfaces.c.size_t,
Element => interfaces.c.signed_Char,
element_Array => swig.signed_char_Array,
default_Terminator => 0);
subtype signed_char_Pointer is c_signed_char_Pointers.Pointer;
-- unsigned char*
--
package c_unsigned_char_Pointers is new interfaces.c.Pointers (Index => interfaces.c.size_t,
Element => interfaces.c.unsigned_Char,
element_Array => unsigned_char_Array,
default_Terminator => 0);
subtype unsigned_char_Pointer is c_unsigned_char_Pointers.Pointer;
-- short*
--
package c_short_Pointers is new interfaces.c.Pointers (Index => interfaces.c.size_t,
Element => interfaces.c.Short,
element_Array => short_Array,
default_Terminator => 0);
subtype short_Pointer is c_short_Pointers.Pointer;
-- unsigned short*
--
package c_unsigned_short_Pointers is new interfaces.c.Pointers (Index => interfaces.c.size_t,
Element => interfaces.c.unsigned_Short,
element_Array => unsigned_short_Array,
default_Terminator => 0);
subtype unsigned_short_Pointer is c_unsigned_short_Pointers.Pointer;
-- int*
--
package c_int_Pointers is new interfaces.c.Pointers (Index => interfaces.c.size_t,
Element => interfaces.c.Int,
element_Array => int_Array,
default_Terminator => 0);
subtype int_Pointer is c_int_Pointers.Pointer;
-- int**
--
type int_pointer_Array is array (interfaces.c.size_t range <>) of aliased int_Pointer;
package c_int_pointer_Pointers is new interfaces.c.Pointers (Index => interfaces.c.size_t,
Element => int_Pointer,
element_Array => int_pointer_Array,
default_Terminator => null);
subtype int_pointer_Pointer is c_int_pointer_Pointers.Pointer;
-- size_t*
--
package c_size_t_Pointers is new interfaces.c.Pointers (Index => interfaces.c.size_t,
Element => interfaces.c.Size_t,
element_Array => size_t_Array,
default_Terminator => 0);
subtype size_t_Pointer is c_size_t_Pointers.Pointer;
-- unsigned*
--
package c_unsigned_Pointers is new interfaces.c.Pointers (Index => interfaces.c.size_t,
Element => interfaces.c.Unsigned,
element_Array => unsigned_Array,
default_Terminator => 0);
subtype unsigned_Pointer is c_unsigned_Pointers.Pointer;
-- long*
--
package c_long_Pointers is new interfaces.c.Pointers (Index => interfaces.c.size_t,
Element => interfaces.c.Long,
element_Array => long_Array,
default_Terminator => 0);
subtype long_Pointer is c_long_Pointers.Pointer;
-- unsigned long*
--
package c_unsigned_long_Pointers is new interfaces.c.Pointers (Index => interfaces.c.size_t,
Element => interfaces.c.unsigned_Long,
element_Array => unsigned_long_Array,
default_Terminator => 0);
subtype unsigned_long_Pointer is c_unsigned_long_Pointers.Pointer;
-- long long*
--
package c_long_long_Pointers is new interfaces.c.Pointers (Index => interfaces.c.size_t,
Element => swig.long_Long,
element_Array => long_long_Array,
default_Terminator => 0);
subtype long_long_Pointer is c_long_long_Pointers.Pointer;
-- unsigned long long*
--
package c_unsigned_long_long_Pointers is new interfaces.c.Pointers (Index => interfaces.c.size_t,
Element => swig.unsigned_long_Long,
element_Array => unsigned_long_long_Array,
default_Terminator => 0);
subtype unsigned_long_long_Pointer is c_unsigned_long_long_Pointers.Pointer;
-- int8_t*
--
package c_int8_t_Pointers is new interfaces.c.Pointers (Index => interfaces.c.size_t,
Element => swig.int8_t,
element_Array => swig.int8_t_Array,
default_Terminator => 0);
subtype int8_t_Pointer is c_int8_t_Pointers.Pointer;
-- int16_t*
--
package c_int16_t_Pointers is new interfaces.c.Pointers (Index => interfaces.c.size_t,
Element => swig.int16_t,
element_Array => swig.int16_t_Array,
default_Terminator => 0);
subtype int16_t_Pointer is c_int16_t_Pointers.Pointer;
-- int32_t*
--
package c_int32_t_Pointers is new interfaces.c.Pointers (Index => interfaces.c.size_t,
Element => swig.int32_t,
element_Array => swig.int32_t_Array,
default_Terminator => 0);
subtype int32_t_Pointer is c_int32_t_Pointers.Pointer;
-- int64_t*
--
package c_int64_t_Pointers is new interfaces.c.Pointers (Index => interfaces.c.size_t,
Element => swig.int64_t,
element_Array => swig.int64_t_Array,
default_Terminator => 0);
subtype int64_t_Pointer is c_int64_t_Pointers.Pointer;
-- uint8_t*'
--
package c_uint8_t_Pointers is new interfaces.c.Pointers (Index => interfaces.c.size_t,
Element => swig.uint8_t,
element_Array => swig.uint8_t_Array,
default_Terminator => 0);
subtype uint8_t_Pointer is c_uint8_t_Pointers.Pointer;
-- uint16_t*'
--
package c_uint16_t_Pointers is new interfaces.c.Pointers (Index => interfaces.c.size_t,
Element => swig.uint16_t,
element_Array => swig.uint16_t_Array,
default_Terminator => 0);
subtype uint16_t_Pointer is c_uint16_t_Pointers.Pointer;
-- uint32_t*'
--
package c_uint32_t_Pointers is new interfaces.c.Pointers (Index => interfaces.c.size_t,
Element => swig.uint32_t,
element_Array => swig.uint32_t_Array,
default_Terminator => 0);
subtype uint32_t_Pointer is c_uint32_t_Pointers.Pointer;
-- uint64_t*'
--
package c_uint64_t_Pointers is new interfaces.c.Pointers (Index => interfaces.c.size_t,
Element => swig.uint64_t,
element_Array => swig.uint64_t_Array,
default_Terminator => 0);
subtype uint64_t_Pointer is c_uint64_t_Pointers.Pointer;
-- float*'
package c_float_Pointers is new interfaces.c.Pointers (Index => interfaces.c.size_t,
Element => interfaces.c.c_Float,
element_Array => float_Array,
default_Terminator => 0.0);
subtype float_Pointer is c_float_Pointers.Pointer;
-- float**
--
type float_pointer_Array is array (interfaces.C.size_t range <>) of aliased float_Pointer;
package c_float_pointer_Pointers is new interfaces.c.Pointers (Index => interfaces.c.size_t,
Element => float_Pointer,
element_Array => float_pointer_Array,
default_Terminator => null);
subtype float_pointer_Pointer is c_float_pointer_Pointers.Pointer;
-- double*'
--
package c_double_Pointers is new interfaces.c.Pointers (Index => interfaces.c.size_t,
Element => interfaces.c.Double,
element_Array => double_Array,
default_Terminator => 0.0);
subtype double_Pointer is c_double_Pointers.Pointer;
-- double**
--
type double_pointer_Array is array (interfaces.C.size_t range <>) of aliased double_Pointer;
package c_double_pointer_Pointers is new interfaces.c.Pointers (Index => interfaces.c.size_t,
Element => double_Pointer,
element_Array => double_pointer_Array,
default_Terminator => null);
subtype double_pointer_Pointer is c_double_pointer_Pointers.Pointer;
-- long double*'
--
package c_long_double_Pointers is new interfaces.c.Pointers (Index => interfaces.c.size_t,
Element => interfaces.c.long_Double,
element_Array => long_double_Array,
default_Terminator => 0.0);
subtype long_double_Pointer is c_long_double_Pointers.Pointer;
-- long double**
--
type long_double_pointer_Array is array (interfaces.C.size_t range <>) of aliased long_double_Pointer;
package c_long_double_pointer_Pointers is new interfaces.c.Pointers (Index => interfaces.c.size_t,
Element => long_double_Pointer,
element_Array => long_double_pointer_Array,
default_Terminator => null);
subtype long_double_pointer_Pointer is c_long_double_pointer_Pointers.Pointer;
-- std::string
--
type std_string is private;
type std_string_Pointer is access all std_String;
type std_string_Array is array (interfaces.c.size_t range <>) of aliased std_String;
-- Utility
--
package void_Conversions is new system.Address_To_Access_Conversions (swig.Void);
private
type std_String is
record
M_dataplus : swig.void_ptr; -- which is a subtype of system.Address
end record;
end Swig.Pointers;
-- tbd: use sensible default_Terminator's.

80
3-mid/opengl/source/platform/osmesa/private/thin/swig.ads Normal file
View File

@@ -0,0 +1,80 @@
with
interfaces.C,
System;
package Swig
--
-- Contains Swig related C type definitions not found in the 'interfaces.C' family.
--
is
pragma Pure;
-- Elementary types.
--
subtype void is System.Address;
subtype void_ptr is System.Address;
subtype opaque_structure is System.Address;
subtype incomplete_class is System.Address;
subtype long_Long is long_long_Integer;
type unsigned_long_Long is mod 2 ** 64;
type intptr_t is range -(2 ** (Standard'Address_Size - Integer'(1))) .. +(2 ** (Standard'Address_Size - Integer'(1)) - 1);
type uintptr_t is mod 2 ** Standard'Address_Size;
subtype int8_t is interfaces.Integer_8;
subtype int16_t is interfaces.Integer_16;
subtype int32_t is interfaces.Integer_32;
subtype int64_t is interfaces.Integer_64;
subtype uint8_t is interfaces.unSigned_8;
subtype uint16_t is interfaces.unSigned_16;
subtype uint32_t is interfaces.unSigned_32;
subtype uint64_t is interfaces.unSigned_64;
subtype bool is interfaces.c.plain_char;
-- Elementary Arrays
--
type void_ptr_Array is array (interfaces.c.size_t range <>) of aliased swig.void_ptr;
type size_t_Array is array (interfaces.c.size_t range <>) of aliased interfaces.c.Size_t;
type bool_Array is array (interfaces.c.size_t range <>) of aliased swig.bool;
type signed_char_Array is array (interfaces.c.size_t range <>) of aliased interfaces.c.signed_Char;
type unsigned_char_Array is array (interfaces.c.size_t range <>) of aliased interfaces.c.unsigned_Char;
type short_Array is array (interfaces.c.size_t range <>) of aliased interfaces.c.Short;
type int_Array is array (interfaces.c.size_t range <>) of aliased interfaces.c.Int;
type long_Array is array (interfaces.c.size_t range <>) of aliased interfaces.c.Long;
type long_long_Array is array (interfaces.c.size_t range <>) of aliased swig.long_Long;
type unsigned_short_Array is array (interfaces.c.size_t range <>) of aliased interfaces.c.unsigned_Short;
type unsigned_Array is array (interfaces.c.size_t range <>) of aliased interfaces.c.Unsigned;
type unsigned_long_Array is array (interfaces.c.size_t range <>) of aliased interfaces.c.unsigned_Long;
type unsigned_long_long_Array is array (interfaces.c.size_t range <>) of aliased swig.unsigned_long_Long;
type int8_t_Array is array (interfaces.c.size_t range <>) of aliased swig.int8_t;
type int16_t_Array is array (interfaces.c.size_t range <>) of aliased swig.int16_t;
type int32_t_Array is array (interfaces.c.size_t range <>) of aliased swig.int32_t;
type int64_t_Array is array (interfaces.c.size_t range <>) of aliased swig.int64_t;
type uint8_t_Array is array (interfaces.c.size_t range <>) of aliased swig.uint8_t;
type uint16_t_Array is array (interfaces.c.size_t range <>) of aliased swig.uint16_t;
type uint32_t_Array is array (interfaces.c.size_t range <>) of aliased swig.uint32_t;
type uint64_t_Array is array (interfaces.c.size_t range <>) of aliased swig.uint64_t;
type float_Array is array (interfaces.c.size_t range <>) of aliased interfaces.c.c_Float;
type double_Array is array (interfaces.c.size_t range <>) of aliased interfaces.c.Double;
type long_double_Array is array (interfaces.c.size_t range <>) of aliased interfaces.c.long_Double;
end Swig;