Add initial prototype.

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

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;

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;

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;

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;

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;

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;

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;

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;

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;

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;

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;

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;

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;

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;

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;

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;

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;

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

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.

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;