Add initial prototype.

3-mid/opengl/private/freetype/applet/test/linkage/freetype_linkage_test.gpr

@@ -0,0 +1,16 @@
+with 
+     "../../../library/freetype",
+     "lace_shared";
+
+project freetype_linkage_Test
+is
+   for Object_Dir use "build";
+   for Exec_Dir   use ".";
+   for Main       use ("launch_freetype_linkage_test.adb");
+
+   package Ide      renames Lace_shared.Ide;
+   package Builder  renames Lace_shared.Builder;
+   package Compiler renames Lace_shared.Compiler;
+   package Binder   renames Lace_shared.Binder;
+
+end freetype_linkage_Test;

3-mid/opengl/private/freetype/applet/test/linkage/launch_freetype_linkage_test.adb

@@ -0,0 +1,126 @@
+with
+     freetype_C.Binding,
+     freetype_C.FT_Vector,
+     freetype_C.FT_Bitmap,
+     freetype_C.FT_Size_Metrics,
+     freetype_C.FT_BBox,
+     freetype_C.FT_CharMapRec,
+     interfaces.C.Strings;
+
+procedure launch_freetype_linkage_Test
+--
+--  Tests linkage to Freetype functions.
+--  Is not meant to be run.
+--
+is
+   use Freetype_C,
+       freetype_C.Binding,
+       Interfaces;
+
+   an_Error           :        FT_Error;
+   pragma Unreferenced (an_Error);
+   an_FT_UShort       :        FT_UShort;
+   pragma Unreferenced (an_FT_UShort);
+   an_FT_Uint         :        FT_Uint;
+   pragma Unreferenced (an_FT_Uint);
+   an_FT_Int          :        FT_Int;
+   pragma Unreferenced (an_FT_Int);
+   an_FT_Long         :        FT_Long;
+   pragma Unreferenced (an_FT_Long);
+   an_FT_Outline      : access FT_Outline;
+   pragma Unreferenced (an_FT_Outline);
+   an_FT_Vector       :        FT_Vector.Item;
+   pragma Unreferenced (an_FT_Vector);
+   an_FT_Bitmap       :        FT_Bitmap.Item;
+   pragma Unreferenced (an_FT_Bitmap);
+   an_Unsigned        :        interfaces.c.unsigned;
+   pragma Unreferenced (an_Unsigned);
+   an_FT_Size_Metrics :        FT_Size_Metrics.Item;
+   pragma Unreferenced (an_FT_Size_Metrics);
+   an_FT_Face         : access freetype_c.FT_FaceRec;
+   pragma Unreferenced (an_FT_Face);
+   an_FT_SizeRec      : access freetype_c.FT_SizeRec;
+   pragma Unreferenced (an_FT_SizeRec);
+   an_FT_BBox         :        FT_BBox.item;
+   pragma Unreferenced (an_FT_BBox);
+   an_FT_CharMap      : access freetype_c.FT_CharMapRec.Item;
+   pragma Unreferenced (an_FT_CharMap);
+   an_FT_GlyphSlot    : access freetype_c.FT_GlyphSlotRec;
+   pragma Unreferenced (an_FT_GlyphSlot);
+
+begin
+   FT_Outline_Get_CBox (null, null);
+
+   an_Error      := FT_Init_FreeType  (null);
+   an_Error      := FT_Done_FreeType  (null);
+   an_Error      := FT_Render_Glyph   (null, FT_RENDER_MODE_NORMAL);
+   an_Error      := FT_Set_Char_Size  (null, 0, 0, 0, 0);
+   an_Error      := FT_Done_Face      (null);
+   an_Error      := FT_Attach_File    (null, Interfaces.C.Strings.null_ptr);
+   an_Error      := FT_Set_Charmap    (null, null);
+   an_Error      := FT_Select_Charmap (null, 0);
+
+   an_FT_uint    := FT_Get_Char_Index (null, 0);
+   an_Error      := FT_Get_Kerning    (null, 0, 0, 0, null);
+
+   an_Error      := FT_Load_Glyph                 (null, 0, 0);
+   an_FT_Outline := FT_GlyphSlot_Get_Outline      (null);
+   an_FT_Vector  := FT_GlyphSlot_Get_Advance      (null);
+   an_FT_Bitmap  := FT_GlyphSlot_Get_Bitmap       (null);
+   an_FT_Int     := FT_GlyphSlot_Get_bitmap_left  (null);
+   an_FT_Int     := FT_GlyphSlot_Get_bitmap_top   (null);
+   an_Unsigned   := FT_GlyphSlot_Get_Format       (null);
+
+   an_FT_Size_Metrics := FT_Size_Get_Metrics      (null);
+   an_FT_Face         := new_FT_Face              (null, C.Strings.null_ptr);
+   an_FT_Face         := new_FT_Memory_Face       (null, null, 0);
+   an_FT_SizeRec      := FT_Face_Get_Size         (null);
+   an_FT_Long         := FT_Face_IS_SCALABLE      (null);
+   an_FT_Long         := FT_Face_HAS_KERNING      (null);
+   an_FT_BBox         := FT_Face_Get_BBox         (null);
+   an_FT_UShort       := FT_Face_Get_units_per_EM (null);
+   an_FT_Long         := FT_Face_Get_num_glyphs   (null);
+   an_FT_CharMap      := FT_Face_Get_charmap      (null);
+   an_FT_CharMap      := FT_Face_Get_charmap_at   (null, 0);
+   an_FT_Int          := FT_Face_Get_num_charmaps (null);
+   an_FT_GlyphSlot    := FT_Face_Get_glyph        (null);
+   an_Error           := FT_Face_Attach_Stream    (null, null, 0);
+
+   an_Unsigned := get_FT_GLYPH_FORMAT_NONE;
+   an_Unsigned := get_FT_GLYPH_FORMAT_COMPOSITE;
+   an_Unsigned := get_FT_GLYPH_FORMAT_BITMAP;
+   an_Unsigned := get_FT_GLYPH_FORMAT_OUTLINE;
+   an_Unsigned := get_FT_GLYPH_FORMAT_PLOTTER;
+
+   an_Unsigned := FT_ENCODING_NONE_enum;
+   an_Unsigned := FT_ENCODING_MS_SYMBOL_enum;
+   an_Unsigned := FT_ENCODING_UNICODE_enum;
+   an_Unsigned := FT_ENCODING_SJIS_enum;
+   an_Unsigned := FT_ENCODING_GB2312_enum;
+   an_Unsigned := FT_ENCODING_BIG5_enum;
+   an_Unsigned := FT_ENCODING_WANSUNG_enum;
+   an_Unsigned := FT_ENCODING_JOHAB_enum;
+   an_Unsigned := FT_ENCODING_ADOBE_STANDARD_enum;
+   an_Unsigned := FT_ENCODING_ADOBE_EXPERT_enum;
+   an_Unsigned := FT_ENCODING_ADOBE_CUSTOM_enum;
+   an_Unsigned := FT_ENCODING_ADOBE_LATIN_1_enum;
+   an_Unsigned := FT_ENCODING_OLD_LATIN_2_enum;
+   an_Unsigned := FT_ENCODING_APPLE_ROMAN_enum;
+
+   an_Unsigned := FT_LOAD_DEFAULT_flag;
+   an_Unsigned := FT_LOAD_NO_SCALE_flag;
+   an_Unsigned := FT_LOAD_NO_HINTING_flag;
+   an_Unsigned := FT_LOAD_RENDER_flag;
+   an_Unsigned := FT_LOAD_NO_BITMAP_flag;
+   an_Unsigned := FT_LOAD_VERTICAL_LAYOUT_flag;
+   an_Unsigned := FT_LOAD_FORCE_AUTOHINT_flag;
+   an_Unsigned := FT_LOAD_CROP_BITMAP_flag;
+   an_Unsigned := FT_LOAD_PEDANTIC_flag;
+   an_Unsigned := FT_LOAD_IGNORE_GLOBAL_ADVANCE_WIDTH_flag;
+   an_Unsigned := FT_LOAD_NO_RECURSE_flag;
+   an_Unsigned := FT_LOAD_IGNORE_TRANSFORM_flag;
+   an_Unsigned := FT_LOAD_MONOCHROME_flag;
+   an_Unsigned := FT_LOAD_LINEAR_DESIGN_flag;
+   an_Unsigned := FT_LOAD_NO_AUTOHINT_flag;
+
+end launch_freetype_linkage_Test;

3-mid/opengl/private/freetype/library/freetype.gpr

@@ -0,0 +1,22 @@
+with
+     "freetype_thin",
+     "lace_shared";
+
+--library
+project Freetype
+is
+   for Source_Dirs  use ("../source");
+   for Object_Dir   use "build";
+   for Library_Dir  use "lib";
+--   for Library_Name use "freetype_ada";
+
+   package Ide      renames Lace_shared.Ide;
+   package Builder  renames Lace_shared.Builder;
+   package Compiler renames Lace_shared.Compiler;
+   package Binder   renames Lace_shared.Binder;
+   
+   package Linker is
+      for Linker_Options use ("-g");
+   end Linker;
+  
+end Freetype;

3-mid/opengl/private/freetype/library/freetype_c.gpr

@@ -0,0 +1,23 @@
+project FreeType_C
+is
+   for Languages       use ("C");
+   for Source_Dirs     use ("../source/**");
+   for Object_Dir      use "build";
+   for Library_Dir     use "lib";
+   for Library_Ali_Dir use "objects";
+--   for Library_Name    use "freetype_c";
+
+   package Naming is
+      for Spec_Suffix ("c") use ".h";
+      for Body_Suffix ("c") use ".c";
+   end Naming;
+
+   package Compiler is
+      for Default_Switches ("c") use ("-g", "-I/usr/include/freetype2");
+   end Compiler;
+
+   package Linker is
+      for Linker_Options use ("-g", "-lfreetype");
+   end Linker;
+
+end FreeType_C;

3-mid/opengl/private/freetype/library/freetype_thin.gpr

@@ -0,0 +1,20 @@
+with
+     "freetype_c",
+     "lace_shared";
+
+project FreeType_thin
+is
+   for Languages   use ("Ada");
+   for Source_Dirs use (".", "../source/thin");
+   for Object_Dir  use "build";
+
+   package Ide      renames Lace_shared.Ide;
+   package Builder  renames Lace_shared.Builder;
+   package Compiler renames Lace_shared.Compiler;
+   package Binder   renames Lace_shared.Binder;
+
+   package Linker is
+      for Linker_Options use ("-g");
+   end Linker;
+
+end FreeType_thin;

3-mid/opengl/private/freetype/source/freetype-charmap.adb

@@ -0,0 +1,148 @@
+with
+     freetype.Face,
+     freeType_C.Binding;
+
+package body freetype.charMap
+is
+   use freeType_C;
+
+   -----------
+   --  Utility
+   --
+
+   function to_characterCode (From : in Character) return characterCode
+   is
+   begin
+      return Character'Pos (From) + 1;
+   end to_characterCode;
+
+
+   ---------
+   --  Forge
+   --
+
+   function to_charMap (parent_Face : access Face.item'Class) return Item
+   is
+      use freetype_c.Binding;
+      use type FT_int;
+
+      Self : Item;
+
+   begin
+      Self.ftFace := parent_Face.freetype_Face;
+      Self.Err    := 0;
+
+      if FT_Face_Get_charmap (Self.ftFace) = null
+      then
+         if FT_Face_Get_num_charmaps (Self.ftFace) = 0
+         then
+            Self.Err := 16#96#;
+            return Self;
+         end if;
+
+         Self.Err := FT_Set_Charmap (Self.ftFace,
+                                     FT_Face_Get_charmap_at (Self.ftFace, 0));
+      end if;
+
+      Self.ftEncoding := FT_Face_Get_charmap (Self.ftFace).Encoding;
+
+      for i in characterCode'(1) .. max_Precomputed
+      loop
+         Self.charIndexCache (i) := FT_Get_Char_Index (Self.ftFace,
+                                                       FT_ULong (i - 1));
+      end loop;
+
+      return Self;
+   end to_charMap;
+
+
+
+   procedure destruct (Self : in out Item)
+   is
+   begin
+      Self.charMap.clear;
+   end destruct;
+
+
+   --------------
+   --  Attributes
+   --
+
+   function Encoding (Self : in Item) return FT_Encoding
+   is
+   begin
+      return Self.ftEncoding;
+   end Encoding;
+
+
+
+   function CharMap (Self : access Item;   Encoding : in FT_Encoding) return Boolean
+   is
+      use freeType_C.Binding;
+      use type FT_Encoding,
+               FT_Error;
+   begin
+      if Self.ftEncoding = Encoding
+      then
+         Self.Err := 0;
+         return True;
+      end if;
+
+      Self.Err := FT_Select_Charmap (Self.ftFace, Encoding);
+
+      if Self.Err = 0
+      then
+         Self.ftEncoding := Encoding;
+         Self.charMap.clear;
+      end if;
+
+      return Self.Err = 0;
+   end CharMap;
+
+
+
+   function GlyphListIndex (Self : in Item;   Character : in CharacterCode) return GlyphIndex
+   is
+   begin
+      return Self.charMap.Element (Character);
+
+   exception
+      when Constraint_Error =>
+         return -1;
+   end GlyphListIndex;
+
+
+
+   function FontIndex (Self : in Item;   Character : in characterCode) return GlyphIndex
+   is
+      use freeType_C.Binding;
+   begin
+      if Character < max_Precomputed
+      then
+         return GlyphIndex (Self.charIndexCache (Character));
+      end if;
+
+      return GlyphIndex (FT_Get_Char_Index (Self.ftFace,
+                                            Character));
+   end FontIndex;
+
+
+
+   procedure insertIndex (Self : in out Item;   Character      : in characterCode;
+                                                containerIndex : in ada.Containers.Count_type)
+   is
+   begin
+      Self.charMap.insert (Character,
+                           GlyphIndex (containerIndex));
+   end insertIndex;
+
+
+
+   function Error (Self : in Item) return FT_Error
+   is
+   begin
+      return Self.Err;
+   end Error;
+
+
+end freetype.charMap;

3-mid/opengl/private/freetype/source/freetype-charmap.ads

@@ -0,0 +1,150 @@
+with
+     freeType_C,
+     interfaces.C,
+     ada.Containers.hashed_Maps;
+
+limited
+with
+     freetype.Face;
+
+private
+with
+     freeType_C.FT_Face,
+     ada.unchecked_Conversion;
+
+package freetype.charMap
+--
+--   'charMap' takes care of specifying the encoding for a font and mapping
+--   character codes to glyph indices.
+--
+--   It doesn't preprocess all indices, only on an as needed basis. This may
+--   seem like a performance penalty but it is quicker than using the 'raw'
+--   freetype calls and will save significant amounts of memory when dealing
+--   with unicode encoding.
+--
+is
+   type Item is tagged private;
+
+
+   ---------
+   --  Types
+   --
+   use Interfaces;
+
+   subtype GlyphIndex    is C.long;
+   subtype CharacterCode is C.unsigned_long;
+
+   function to_characterCode (From : in Character) return characterCode;
+
+
+   ---------
+   --  Forge
+   --
+
+   function  to_charMap (parent_Face : access Face.item'Class) return Item;
+   procedure destruct   (Self        : in out Item);
+
+
+   --------------
+   --  Attributes
+   --
+
+   function  Encoding (Self : in     Item) return freeType_C.FT_Encoding;
+   --
+   --  Queries for the current character map code.
+   --
+   --  Returns the current character map code.
+
+
+   function  CharMap  (Self : access Item;   Encoding : in freeType_C.FT_Encoding) return Boolean;
+   --
+   --  Sets the character map for the face. If an error occurs the object is not modified.
+   --
+   --  Valid encodings as at Freetype 2.0.4
+   --  - ft_encoding_none
+   --  - ft_encoding_symbol
+   --  - ft_encoding_unicode
+   --  - ft_encoding_latin_2
+   --  - ft_encoding_sjis
+   --  - ft_encoding_gb2312
+   --  - ft_encoding_big5
+   --  - ft_encoding_wansung
+   --  - ft_encoding_johab
+   --  - ft_encoding_adobe_standard
+   --  - ft_encoding_adobe_expert
+   --  - ft_encoding_adobe_custom
+   --  - ft_encoding_apple_roman
+   --
+   --  Encoding: The Freetype encoding symbol.
+   --
+   --  Returns true if charmap was valid and set correctly.
+
+
+   function  GlyphListIndex (Self : in    Item;   Character : in CharacterCode) return GlyphIndex;
+   --
+   --  Get the Glyph Container index of the input character.
+   --
+   --  Character: The character code of the requested glyph in the current encoding (eg apple roman).
+   --
+   --  Returns the FTGlyphContainer index for the character or zero if it wasn't found.
+
+
+   function  FontIndex      (Self : in     Item;   Character : in characterCode) return GlyphIndex;
+   --
+   --  Get the font glyph index of the input character.
+   --
+   --  Character: The character code of the requested glyph in the current encoding (eg apple roman).
+   --
+   --  Returns the glyph index for the character.
+
+
+   procedure insertIndex    (Self : in out Item;   Character      : in characterCode;
+                                                   ContainerIndex : in ada.Containers.Count_type);
+   --
+   --  Set the FTGlyphContainer index of the character code.
+   --
+   --  Character:      The character code of the requested glyph in the current encoding eg apple roman.
+   --  containerIndex: The index into the Glyph Container of the character code.
+
+
+   function  Error (Self : in Item) return freeType_C.FT_Error;
+   --
+   --  Queries for errors.
+   --
+   --  Returns the current error code. Zero means no error.
+
+
+
+private
+
+   function Hash is new ada.unchecked_Conversion (CharacterCode, ada.Containers.Hash_type);
+
+   use type CharacterCode,
+            GlyphIndex;
+
+   package char_Maps_of_glyph_index is new ada.Containers.hashed_Maps (CharacterCode,
+                                                                       GlyphIndex,
+                                                                       Hash,
+                                                                       "=");
+   subtype char_Map_of_glyph_index is char_Maps_of_glyph_index.Map;
+   --
+   --  A structure that maps glyph indices to character codes/
+
+
+   max_Precomputed : constant := 128;
+
+   type Cache is array (characterCode range 1 .. max_Precomputed) of freeType_C.FT_UInt;
+
+
+   type Item is tagged
+      record
+         ftEncoding     : freeType_C.FT_Encoding;           -- Current character map code.
+         ftFace         : freeType_C.FT_Face.item;          -- The current Freetype face.
+
+         charMap        : char_Maps_of_glyph_index.Map;
+         charIndexCache : Cache;                            -- Precomputed font indices.
+
+         Err            : freeType_C.FT_Error;              -- Current error code.
+      end record;
+
+end freetype.charMap;

3-mid/opengl/private/freetype/source/freetype-face.adb

@@ -0,0 +1,369 @@
+with
+     freeType_C.Binding,
+     freeType_C.FT_Library,
+     freeType_C.FT_Vector,
+     freeType_C.Pointers,
+
+     interfaces.C.Strings,
+
+     ada.unchecked_Conversion,
+     ada.unchecked_Deallocation,
+     ada.Finalization;
+
+package body freetype.Face
+is
+   -----------
+   --- Globals
+   --
+
+   the_FT_Library : aliased FT_Library.item;
+
+
+   -----------
+   --- Utility
+   --
+
+   function  to_Flag    is new ada.unchecked_Conversion   (FT_Kerning_Mode, C.unsigned);
+   procedure deallocate is new ada.Unchecked_Deallocation (float_Array,     float_Array_view);
+
+
+   ---------
+   --- Forge
+   --
+
+   package body Forge
+   is
+      function to_Face (fontFilePath      : in String;
+                        precomputeKerning : in Boolean) return Face.item
+      is
+         use freeType_C.Binding,
+             freeType_C.Pointers,
+             C.Strings;
+         use type freeType_C.FT_Long;
+
+         Self          : Item;
+         the_font_Path : chars_ptr := new_String (fontFilePath);
+
+      begin
+         Self.numGlyphs := 0;
+         Self.Err       := 0;
+
+         Self.ftFace := new_FT_Face (the_FT_Library, the_font_Path);
+
+         free (the_font_Path);
+
+         if Self.ftFace = null
+         then
+            raise freetype.Error with "Failed to create a freeType face for '" & fontFilePath & "'.";
+         end if;
+
+         Self.numGlyphs       := Integer (FT_Face_Get_num_glyphs (Self.ftFace));
+         Self.hasKerningTable := FT_Face_HAS_KERNING (Self.ftFace) /= 0;
+
+         if    Self.hasKerningTable
+           and precomputeKerning
+         then
+            Self.BuildKerningCache;
+         end if;
+
+         return Self;
+      end to_Face;
+
+
+
+      function to_Face (pBufferBytes      : access C.unsigned_char;
+                        bufferSizeInBytes : in     Positive;
+                        precomputeKerning : in     Boolean) return Face.item
+      is
+         use freeType_C.Binding,
+             freeType_C.Pointers;
+         use type FT_Long;
+
+         Self : Face.item;
+
+      begin
+         Self.numGlyphs := 0;
+         Self.Err       := 0;
+
+         Self.ftFace := new_FT_Memory_Face (the_FT_Library,
+                                            pBufferBytes.all'Access,
+                                            C.int (bufferSizeInBytes));
+         if Self.ftFace = null
+         then
+            raise freetype.Error with "Failed to create a freeType memory face.";
+         end if;
+
+         Self.numGlyphs       := Integer (FT_Face_Get_num_glyphs (Self.ftFace));
+         Self.hasKerningTable := FT_Face_HAS_KERNING (Self.ftFace) /= 0;
+
+         if    Self.hasKerningTable
+           and precomputeKerning
+         then
+            Self.BuildKerningCache;
+         end if;
+
+         return Self;
+      end to_Face;
+
+
+
+      procedure destruct (Self : in out Item)
+      is
+         use freeType_C.Binding;
+         use type Pointers.FT_FaceRec_Pointer;
+      begin
+         if Self.kerningCache /= null
+         then
+            deallocate (Self.kerningCache);
+         end if;
+
+         if Self.ftFace /= null
+         then
+            Self.Err    := FT_Done_Face (Self.ftFace);
+            Self.ftFace := null;
+         end if;
+      end destruct;
+
+   end Forge;
+
+
+
+   function attach (Self : access Item;   fontFilePath : in String) return Boolean
+   is
+      use freeType_C.Binding,
+          C.Strings;
+      use type FT_Error;
+
+      the_font_Path : chars_ptr := new_String (fontFilePath);
+   begin
+      Self.Err := FT_Attach_File (Self.ftFace, the_font_Path);
+      free (the_font_Path);
+
+      return Self.Err = 0;
+   end attach;
+
+
+
+   function attach (Self : access Item;   pBufferBytes      : access C.unsigned_char;
+                                          bufferSizeInBytes : in     Positive) return Boolean
+   is
+      use freeType_C.Binding;
+      use type FT_Error;
+   begin
+      Self.Err := FT_Face_Attach_Stream (Self.ftFace,
+                                         pBufferBytes.all'Access,
+                                         C.size_t (bufferSizeInBytes));
+      return Self.Err = 0;
+   end Attach;
+
+
+
+   function freetype_Face (Self : in Item) return FT_Face.item
+   is
+   begin
+      return Self.ftFace;
+   end freetype_Face;
+
+
+
+   function Size (Self : access Item;   Size         : in Natural;
+                                        x_Res, y_Res : in Natural) return freetype.face_Size.item
+   is
+      Success : Boolean;
+      pragma unreferenced (Success);
+   begin
+      Success  := Self.charSize.CharSize (Self.ftFace,
+                                          Size,
+                                          x_Res, y_Res);
+      Self.Err := Self.charSize.Error;
+
+      return Self.charSize;
+   end Size;
+
+
+
+   function CharMapCount (Self : in Item) return Natural
+   is
+      use freeType_C.Binding;
+   begin
+      return Natural (FT_Face_Get_num_charmaps (Self.ftFace));
+   end CharMapCount;
+
+
+
+   function CharMapList (Self : access Item) return FT_Encodings_view
+   is
+      use freeType_C.Binding;
+   begin
+      if Self.fontEncodingList = null
+      then
+         Self.fontEncodingList := new FT_Encodings (1 .. Self.CharMapCount);
+
+         for i in 1 .. Self.CharMapCount
+         loop
+            Self.fontEncodingList (i) := FT_Face_Get_charmap_at (Self.ftFace,
+                                                                 C.int (i)  ).Encoding;
+         end loop;
+      end if;
+
+      return Self.fontEncodingList;
+   end CharMapList;
+
+
+
+   function KernAdvance (Self : access Item;   Index1 : in Natural;
+                                               Index2 : in Natural) return Vector_3
+   is
+      use freeType_C.Binding;
+      use type FT_Error;
+
+      X, Y        :         Float;
+      kernAdvance : aliased FT_Vector.item;
+
+   begin
+      if   not Self.hasKerningTable
+        or Index1 = 0
+        or Index2 = 0
+      then
+         return [0.0, 0.0, 0.0];
+      end if;
+
+      if    Self.kerningCache /= null
+        and Index1 < max_Precomputed     -- TODO: Check this whole function matches C code.
+        and Index2 < max_Precomputed
+      then
+         declare
+            max_Index : C.ptrdiff_t := C.ptrdiff_t (2 * (Index2 * max_Precomputed + Index1) + 1);     -- TODO: Check this against C code.
+         begin
+            X := Float (Self.kerningCache (C.size_t (2 * (Index2 * max_Precomputed + Index1))));
+            Y := Float (Self.kerningCache (C.size_t (2 * (Index2 * max_Precomputed + Index1) + 1)));
+
+            return [X, Y, 0.0];
+         end;
+      end if;
+
+      kernAdvance.X := 0;
+      kernAdvance.Y := 0;
+
+      Self.Err := FT_Get_Kerning (Self.ftFace,
+                                  C.unsigned (index1),
+                                  C.unsigned (index2),
+                                  to_Flag    (ft_Kerning_unfitted),
+                                  kernAdvance'unchecked_Access);
+      if Self.Err /= 0
+      then
+         return [0.0, 0.0, 0.0];
+      end if;
+
+      X := Float (kernAdvance.x) / 64.0;
+      Y := Float (kernAdvance.y) / 64.0;
+
+      return [X, Y, 0.0];
+   end KernAdvance;
+
+
+
+   function GlyphCount (Self : in Item) return Natural
+   is
+   begin
+      return Self.numGlyphs;
+   end GlyphCount;
+
+
+
+   function Glyph (Self : access Item;   Index      : in freetype.charMap.glyphIndex;
+                                         load_Flags : in freeType_C.FT_Int) return FT_GlyphSlot.item
+   is
+      use freeType_C.Binding;
+      use type FT_Error,
+               FT_Face.item;
+   begin
+      if Self.ftFace = null
+      then
+         raise freetype.Error with "Face is null.";
+      end if;
+
+      Self.Err := FT_Load_Glyph (Self.ftFace,  FT_UInt (Index),  load_Flags);
+
+      if Self.Err /= 0 then
+         return null;
+      end if;
+
+      return FT_GlyphSlot.item (FT_Face_Get_glyph (Self.ftFace));
+   end Glyph;
+
+
+
+   function Error (Self : in Item) return FT_Error
+   is
+   begin
+      return Self.Err;
+   end Error;
+
+
+
+   procedure BuildKerningCache (Self : in out Item)
+   is
+      use freeType_C.Binding;
+      use type FT_UInt,
+               FT_Error,
+               C.C_float;
+
+      max_Index   : constant C.ptrdiff_t   := C.ptrdiff_t (max_Precomputed * max_Precomputed * 2);
+      kernAdvance : aliased  FT_Vector.item;
+
+   begin
+      kernAdvance.x     := 0;
+      kernAdvance.y     := 0;
+      Self.kerningCache := new float_Array' (1 .. C.size_t (max_Index) => <>);
+
+      for j in 1 .. FT_UInt' (max_Precomputed)
+      loop
+         for i in 1 .. FT_UInt' (max_Precomputed)
+         loop
+            Self.Err := FT_Get_Kerning (Self.ftFace,
+                                        i, j,
+                                        to_Flag (ft_Kerning_unfitted),
+                                        kernAdvance'unchecked_Access);
+            if Self.Err /= 0
+            then
+               deallocate (Self.kerningCache);
+               return;
+            end if;
+
+            Self.kerningCache (C.size_t (2 * (j * max_Precomputed + i)    )) := C.C_float (kernAdvance.X) / 64.0;
+            Self.kerningCache (C.size_t (2 * (j * max_Precomputed + i) + 1)) := C.C_float (kernAdvance.Y) / 64.0;
+         end loop;
+      end loop;
+
+   end BuildKerningCache;
+
+
+
+   -------------------
+   --  Package Closure
+   --
+   type Closure is new ada.Finalization.controlled with null record;
+
+   overriding
+   procedure finalize (Object : in out Closure)
+   is
+      use freeType_C.Binding;
+      Status : FT_Error with unreferenced;
+   begin
+      Status := FT_Done_FreeType (the_FT_Library);
+   end finalize;
+
+   the_Closure : Closure with Unreferenced;
+
+
+
+   --------------------------
+   --  Package Initialisation
+   --
+   use freeType_C.Binding;
+   Status : FT_Error with unreferenced;
+
+begin
+   Status := FT_init_FreeType (the_FT_Library'Access);
+end freetype.Face;

3-mid/opengl/private/freetype/source/freetype-face.ads

@@ -0,0 +1,150 @@
+with
+     freetype.face_Size,
+     freetype.charMap,
+
+     freeType_C.FT_Face,
+     freeType_C.FT_GlyphSlot,
+
+     interfaces.C;
+
+package freetype.Face
+--
+--  The Face class provides an abstraction layer for the Freetype Face.
+--
+is
+   type Item is tagged private;
+   type View is access all Item'Class;
+
+
+   ---------
+   --  Types
+   --
+   type FT_Encodings      is array (Positive range <>) of freeType_C.FT_Encoding;
+   type FT_Encodings_view is access all FT_Encodings;
+
+
+   ---------
+   --  Forge
+   --
+   use Interfaces;
+
+   package Forge
+   is
+      function to_Face (fontFilePath      : in String;
+                        precomputeKerning : in Boolean) return Face.item;
+      --
+      --  Opens and reads a face file. Error is set.
+
+      function to_Face (pBufferBytes      : access C.unsigned_char;              -- The in-memory buffer.
+                        bufferSizeInBytes : in     Positive;                     -- The length of the buffer in bytes.
+                        precomputeKerning : in     Boolean) return Face.item;
+      --
+      --  Read face data from an in-memory buffer. Error is set.
+
+      procedure destruct (Self : in out Item);   -- Disposes of the current Freetype face.
+   end Forge;
+
+
+   --------------
+   --  Attributes
+   --
+
+   function attach (Self : access Item;   fontFilePath : in String) return Boolean;
+   --
+   --  Attach auxilliary file to font (e.g., font metrics).
+   --
+   --  fontFilePath: Auxilliary font file path.
+   --
+   --  Returns true if file has opened successfully.
+
+
+   function attach (Self : access Item;   pBufferBytes      : access C.unsigned_char;
+                                          bufferSizeInBytes : in     Positive) return Boolean;
+   --
+   --  Attach auxilliary data to font (e.g., font metrics) from memory.
+   --
+   --  pBufferBytes:      The in-memory buffer.
+   --  bufferSizeInBytes: The length of the buffer in bytes.
+   --
+   --  Returns true if file has opened successfully.
+
+
+   function freetype_Face (Self : in     Item) return freeType_C.FT_Face.item;
+   --
+   --  Get the freetype face object.
+   --
+   --  Returns a pointer to an FT_Face.
+
+
+   function Size (Self : access Item;   Size         : in Natural;
+                                        x_Res, y_Res : in Natural) return freetype.face_Size.item;
+   --
+   --  Sets the char size for the current face.
+   --  This doesn't guarantee that the size was set correctly. Clients should check errors.
+   --
+   --  Size:         The face size in points (1/72 inch).
+   --  x_Res, y_Res: The resolution of the target device.
+   --
+   --  Returns FTSize object.
+
+
+   function CharMapCount (Self : in     Item) return Natural;
+   --
+   --  Get the number of character maps in this face.
+   --
+   -- Return character map count.
+
+
+   function CharMapList  (Self : access Item) return FT_Encodings_view;
+   --
+   --  Get a list of character maps in this face.
+   --
+   --  Returns a pointer to the first encoding.
+
+
+   function KernAdvance  (Self : access Item;   Index1 : in Natural;
+                                                Index2 : in Natural) return Vector_3;
+   --
+   --  Gets the kerning vector between two glyphs.
+
+
+   function GlyphCount   (Self : in     Item) return Natural;
+   --
+   --  Gets the number of glyphs in the current face.
+
+
+   function Glyph (Self : access Item;   Index      : in freetype.charMap.glyphIndex;
+                                         load_Flags : in freeType_C.FT_Int) return freeType_C.FT_GlyphSlot.item;
+
+   function Error (Self : in     Item) return freeType_C.FT_Error;
+   --
+   --  Return the current error code.
+
+
+
+private
+
+   use freeType_C;
+
+   type Float_array      is array (C.size_t range <>) of aliased C.c_float;
+   type Float_array_view is access all Float_array;
+
+
+   type Item is tagged
+      record
+        ftFace           :         FT_Face  .item;      -- The Freetype face.
+        charSize         : aliased face_Size.item;      -- The size object associated with this face.
+        numGlyphs        :         Natural;             -- The number of glyphs in this face.
+        fontEncodingList :         FT_Encodings_view;
+        hasKerningTable  :         Boolean;             -- This face has kerning tables.
+        kerningCache     :         Float_array_view;    -- If this face has kerning tables, we can cache them.
+        Err              :         FT_Error;            -- Current error code. Zero means no error.
+      end record;
+
+
+      max_Precomputed : constant := 128;
+
+      procedure BuildKerningCache (Self : in out Item);
+
+
+end freetype.Face;

3-mid/opengl/private/freetype/source/freetype-face_size.adb

@@ -0,0 +1,142 @@
+with
+     freeType_C.Binding,
+     freeType_C.Pointers;
+
+package body freetype.face_Size
+is
+   use freeType_C;
+
+
+   --------------
+   --- Attributes
+   --
+
+   function CharSize (Self : access Item;   Face         : in FT_Face.item;
+                                            point_Size   : in Natural;
+                                            x_Resolution,
+                                            y_Resolution : in Natural) return Boolean
+   is
+      use      freeType_C.Binding;
+      use type FT_Error,
+               FT_F26Dot6;
+   begin
+      if        Self.Size        /= point_Size
+        or else Self.xResolution /= x_Resolution
+        or else Self.yResolution /= y_Resolution
+      then
+         Self.Err := FT_Set_Char_Size (Face,
+                                       0,
+                                       FT_F26Dot6 (point_size) * 64,
+                                       FT_UInt (Self.xResolution),
+                                       FT_UInt (Self.yResolution));
+         if Self.Err = 0
+         then
+            Self.ftFace      := Face;
+            Self.Size        := point_Size;
+            Self.xResolution := x_Resolution;
+            Self.yResolution := y_Resolution;
+            Self.ftSize      := FT_Face_Get_Size (Self.ftFace);
+         end if;
+      end if;
+
+      return Self.Err = 0;
+   end CharSize;
+
+
+
+   function CharSize (Self : in Item) return Natural
+   is
+   begin
+      return Self.Size;
+   end CharSize;
+
+
+
+   function Ascender (Self : in Item) return Float
+   is
+      use freeType_C.Binding,
+          freeType_C.Pointers;
+   begin
+      if Self.ftSize = null
+      then   return 0.0;
+      else   return Float (FT_Size_Get_Metrics (Self.ftSize).Ascender) / 64.0;
+      end if;
+   end Ascender;
+
+
+
+   function Descender (Self : in Item) return Float
+   is
+      use freeType_C.Binding,
+          freeType_C.Pointers;
+   begin
+      if Self.ftSize = null
+      then   return 0.0;
+      else   return Float (FT_Size_Get_Metrics (Self.ftSize).Descender) / 64.0;
+      end if;
+   end Descender;
+
+
+
+   function Height (Self : in Item) return Float
+   is
+      use      freeType_C.Binding,
+               freeType_C.Pointers;
+      use type FT_Long;
+
+   begin
+      if Self.ftSize = null
+      then
+         return 0.0;
+      end if;
+
+      if FT_Face_IS_SCALABLE (Self.ftFace) /= 0
+      then
+         return    Float (FT_Face_get_BBox    (Self.ftFace).yMax     -         FT_Face_get_BBox (Self.ftFace).yMin)
+                * (Float (FT_Size_get_Metrics (Self.ftSize).y_ppem)  /  Float (FT_Face_get_Units_per_EM (Self.ftFace)));
+      else
+         return Float (FT_Size_get_Metrics (Self.ftSize).Height) / 64.0;
+      end if;
+   end Height;
+
+
+
+   function Width (Self : in Item) return Float
+   is
+      use      freeType_C.Binding,
+               freeType_C.Pointers;
+      use type FT_Long;
+   begin
+      if Self.ftSize = null
+      then
+         return 0.0;
+      end if;
+
+      if FT_Face_IS_SCALABLE (Self.ftFace) /= 0
+      then
+         return    Float (FT_Face_get_BBox    (Self.ftFace).xMax     -         FT_Face_get_BBox         (Self.ftFace).xMin)
+                * (Float (FT_Size_get_Metrics (Self.ftSize).x_ppem)  /  Float (FT_Face_get_Units_per_EM (Self.ftFace)));
+      else
+         return Float (FT_Size_get_Metrics (Self.ftSize).max_Advance) / 64.0;
+      end if;
+   end Width;
+
+
+
+   function Underline (Self : in Item) return Float
+   is
+      pragma unreferenced (Self);
+   begin
+      return 0.0;
+   end Underline;
+
+
+
+   function Error (Self : in Item) return FT_Error
+   is
+   begin
+      return Self.Err;
+   end Error;
+
+
+end freetype.face_Size;

3-mid/opengl/private/freetype/source/freetype-face_size.ads

@@ -0,0 +1,103 @@
+with
+     freeType_C.FT_Face,
+     freeType_C.FT_Size;
+
+package freetype.face_Size
+--
+--  The face_Size class provides an abstraction layer for the Freetype Size type.
+--
+is
+   type Item is tagged private;
+   type View is access all Item'Class;
+
+
+   ---------
+   --- Forge
+   --
+
+   procedure destruct (Self : in out Item) is null;
+
+
+   --------------
+   --- Attributes
+   --
+
+   function CharSize  (Self : access Item;   Face         : in freeType_C.FT_Face.item;
+                                             point_Size   : in Natural;
+                                             x_Resolution,
+                                             y_Resolution : in Natural) return Boolean;
+   --
+   --  Sets the char size for the current face.
+   --
+   --  This doesn't guarantee that the size was set correctly. Clients should call 'check Error' for
+   --  more information if this function returns false. If an error does occur the size object isn't modified.
+   --
+   --  Face:         Parent face for this size object.
+   --  point_Size:   The face size in points (1/72 inch).
+   --  x_Resolution: The horizontal resolution of the target device.
+   --  y_Resolution: The vertical resolution of the target device.
+   --
+   --  Returns true if the size has been set.
+
+
+   function CharSize  (Self : in Item) return Natural;   -- Returns the char size in points.
+   --
+   --  Get the char size for the current face.
+
+
+   function Ascender  (Self : in Item) return Float;     -- Returns the Ascender height.
+   --
+   --  Gets the global ascender height for the face in pixels.
+
+
+   function Descender (Self : in Item) return Float;     -- Returns the Descender height.
+   --
+   --  Gets the global descender height for the face in pixels.
+
+
+   function Height    (Self : in Item) return Float;     -- Returns the height in pixels.
+   --
+   --  Gets the global face height for the face.
+   --
+   --  If the face is scalable this returns the height of the global
+   --  bounding box which ensures that any glyph will be less than or
+   --  equal to this height. If the font isn't scalable there is no
+   --  guarantee that glyphs will not be taller than this value.
+
+
+   function Width     (Self : in Item) return Float;   -- Returns the width in pixels.
+   --
+   --  Gets the global face width for the face.
+   --
+   --  If the face is scalable this returns the width of the global
+   --  bounding box which ensures that any glyph will be less than or
+   --  equal to this width. If the font isn't scalable this value is
+   --  the max_advance for the face.
+
+
+   function Underline (Self : in Item) return Float;   -- Returns the underline position in pixels.
+   --
+   --  Gets the underline position for the face.
+
+
+   function Error     (Self : in Item) return freeType_C.FT_Error;   -- Returns the current error code.
+   --
+   --  Queries for errors.
+
+
+
+private
+
+   type Item is tagged
+      record
+         ftFace      : freeType_C.FT_Face.item;    -- The current Freetype face that this FTSize object relates to.
+         ftSize      : freeType_C.FT_Size.item;    -- The freetype Size.
+
+         Size        : Natural := 0;               -- The size in points.
+         xResolution,                              -- The horizontal resolution.
+         yResolution : Natural := 0;               -- The vertical resolution.
+
+         Err         : freeType_C.FT_Error := 0;   -- Current error code. Zero means no error.
+      end record;
+
+end freetype.face_Size;

3-mid/opengl/private/freetype/source/freetype.ads

@@ -0,0 +1,12 @@
+package Freetype
+--
+-- A thick bindng to the 'Freetype' font library.
+--
+is
+   pragma Pure;
+
+   Error : exception;
+
+   type Vector_3 is array (Positive range 1 .. 3) of Float;
+
+end Freetype;

3-mid/opengl/private/freetype/source/thin/freetype_c-binding.ads

@@ -0,0 +1,220 @@
+with
+     freetype_c.FT_BBox,
+     freetype_c.FT_Face,
+     freetype_c.FT_Bitmap,
+     freetype_c.FT_Library,
+     freetype_c.FT_Size_Metrics,
+     freetype_c.FT_CharMapRec,
+     freetype_c.FT_Size,
+     freetype_c.FT_Vector,
+     freetype_c.FT_GlyphSlot,
+     freetype_c.FT_CharMap,
+     freetype_c.Pointers,
+
+     Interfaces.C.Pointers,
+     Interfaces.C.Strings;
+
+package freetype_c.Binding
+--
+--  Provides the Freetype library functions.
+--
+is
+   use freetype_c.Pointers;
+
+
+   --  unsigned_char_Pointer
+   --
+   type    unsigned_char_Array      is array (C.size_t range <>) of aliased C.unsigned_Char;
+   package c_unsigned_char_Pointers is new C.Pointers (Index              => C.size_t,
+                                                       Element            => C.unsigned_Char,
+                                                       element_Array      => unsigned_char_Array,
+                                                       default_Terminator => 0);
+   subtype unsigned_char_Pointer is c_unsigned_char_Pointers.Pointer;
+
+
+   ---------------
+   --  Subprograms
+   --
+
+   procedure FT_Outline_Get_CBox (Outline     : in FT_Outline_Pointer;
+                                  acBox       : in FT_BBox.Pointer);
+
+   function  FT_Init_FreeType    (aLibrary    : in FT_Library.Pointer)   return FT_Error;
+
+   function  FT_Done_FreeType    (aLibrary    : in FT_Library.Item)      return FT_Error;
+
+   function  FT_Render_Glyph     (Slot        : in FT_GlyphSlot.Item;
+                                  render_Mode : in FT_Render_Mode)       return FT_Error;
+
+   function  FT_Set_Char_Size    (Face            : in FT_Face.Item;
+                                  char_Width      : in FT_F26Dot6;
+                                  char_Height     : in FT_F26Dot6;
+                                  horz_Resolution : in FT_UInt;
+                                  vert_Resolution : in FT_UInt)          return FT_Error;
+
+   function  FT_Done_Face        (Face         : in FT_Face.Item)        return FT_Error;
+
+   function  FT_Attach_File      (Face         : in FT_Face.Item;
+                                  FilePathname : in C.strings.chars_ptr) return FT_Error;
+
+   function  FT_Set_Charmap      (Face         : in FT_Face.Item;
+                                  charMap      : in FT_CharMap.Item)     return FT_Error;
+
+   function  FT_Select_Charmap   (Face         : in FT_Face.Item;
+                                  Encoding     : in FT_Encoding)         return FT_Error;
+
+   function  FT_Get_Char_Index   (Face         : in FT_Face.Item;
+                                  charCode     : in FT_ULong)            return FT_UInt;
+
+   function  FT_Get_Kerning      (Face         : in FT_Face.Item;
+                                  left_Glyph   : in FT_UInt;
+                                  right_Glyph  : in FT_UInt;
+                                  kern_Mode    : in FT_UInt;
+                                  aKerning     : in FT_Vector.Pointer)   return FT_Error;
+
+   function  FT_Load_Glyph       (Face         : in FT_Face.Item;
+                                  Glyph_Index  : in FT_UInt;
+                                  Load_Flags   : in FT_Int32)            return FT_Error;
+
+   function  FT_GlyphSlot_Get_Outline     (Self : in FT_GlyphSlot.Item) return access FT_Outline;
+   function  FT_GlyphSlot_Get_Advance     (Self : in FT_GlyphSlot.Item) return FT_Vector.Item;
+   function  FT_GlyphSlot_Get_Bitmap      (Self : in FT_GlyphSlot.Item) return FT_Bitmap.Item;
+   function  FT_GlyphSlot_Get_bitmap_left (Self : in FT_GlyphSlot.Item) return FT_Int;
+   function  FT_GlyphSlot_Get_bitmap_top  (Self : in FT_GlyphSlot.Item) return FT_Int;
+   function  FT_GlyphSlot_Get_Format      (Self : in FT_GlyphSlot.Item) return C.unsigned;
+   function  FT_Size_Get_Metrics          (Self : in FT_Size.Item)      return FT_Size_Metrics.Item;
+
+   function  new_FT_Face              (Library           : in FT_Library.Item;
+                                       FontFilePath      : in C.strings.chars_ptr) return access FT_FaceRec;
+
+   function  new_FT_Memory_Face       (Library           : in FT_Library.Item;
+                                       pBufferBytes      : in unsigned_char_Pointer;
+                                       BufferSizeInBytes : in C.int) return access FT_FaceRec;
+
+   function  FT_Face_Get_Size         (Self : in FT_Face.Item) return access FT_SizeRec;
+   function  FT_Face_IS_SCALABLE      (Self : in FT_Face.Item) return FT_Long;
+   function  FT_Face_HAS_KERNING      (Self : in FT_Face.Item) return FT_Long;
+   function  FT_Face_Get_BBox         (Self : in FT_Face.Item) return FT_BBox.Item;
+   function  FT_Face_Get_units_per_EM (Self : in FT_Face.Item) return FT_UShort;
+   function  FT_Face_Get_num_glyphs   (Self : in FT_Face.Item) return FT_Long;
+
+   function  FT_Face_Get_charmap      (Self : in FT_Face.Item)                     return  access FT_CharMapRec.Item;
+   function  FT_Face_Get_charmap_at   (Self : in FT_Face.Item;   Index : in C.int) return  access FT_CharMapRec.Item;
+
+   function  FT_Face_Get_num_charmaps (Self : in FT_Face.Item) return FT_Int;
+   function  FT_Face_Get_glyph        (Self : in FT_Face.Item) return access FT_GlyphSlotRec;
+
+   function  FT_Face_Attach_Stream    (Self : in FT_Face.Item;   pBufferBytes      : in unsigned_char_Pointer;
+                                                                 BufferSizeInBytes : in C.size_t) return FT_Error;
+
+   function  get_FT_GLYPH_FORMAT_NONE         return C.unsigned;
+   function  get_FT_GLYPH_FORMAT_COMPOSITE    return C.unsigned;
+   function  get_FT_GLYPH_FORMAT_BITMAP       return C.unsigned;
+   function  get_FT_GLYPH_FORMAT_OUTLINE      return C.unsigned;
+   function  get_FT_GLYPH_FORMAT_PLOTTER      return C.unsigned;
+
+   function  FT_ENCODING_NONE_enum            return FT_Encoding;
+   function  FT_ENCODING_MS_SYMBOL_enum       return FT_Encoding;
+   function  FT_ENCODING_UNICODE_enum         return FT_Encoding;
+   function  FT_ENCODING_SJIS_enum            return FT_Encoding;
+   function  FT_ENCODING_GB2312_enum          return FT_Encoding;
+   function  FT_ENCODING_BIG5_enum            return FT_Encoding;
+   function  FT_ENCODING_WANSUNG_enum         return FT_Encoding;
+   function  FT_ENCODING_JOHAB_enum           return FT_Encoding;
+   function  FT_ENCODING_ADOBE_STANDARD_enum  return FT_Encoding;
+   function  FT_ENCODING_ADOBE_EXPERT_enum    return FT_Encoding;
+   function  FT_ENCODING_ADOBE_CUSTOM_enum    return FT_Encoding;
+   function  FT_ENCODING_ADOBE_LATIN_1_enum   return FT_Encoding;
+   function  FT_ENCODING_OLD_LATIN_2_enum     return FT_Encoding;
+   function  FT_ENCODING_APPLE_ROMAN_enum     return FT_Encoding;
+
+   function  FT_LOAD_DEFAULT_flag             return C.unsigned;
+   function  FT_LOAD_NO_SCALE_flag            return C.unsigned;
+   function  FT_LOAD_NO_HINTING_flag          return C.unsigned;
+   function  FT_LOAD_RENDER_flag              return C.unsigned;
+   function  FT_LOAD_NO_BITMAP_flag           return C.unsigned;
+   function  FT_LOAD_VERTICAL_LAYOUT_flag     return C.unsigned;
+   function  FT_LOAD_FORCE_AUTOHINT_flag      return C.unsigned;
+   function  FT_LOAD_CROP_BITMAP_flag         return C.unsigned;
+   function  FT_LOAD_PEDANTIC_flag            return C.unsigned;
+   function  FT_LOAD_IGNORE_GLOBAL_ADVANCE_WIDTH_flag
+                                              return C.unsigned;
+   function  FT_LOAD_NO_RECURSE_flag          return C.unsigned;
+   function  FT_LOAD_IGNORE_TRANSFORM_flag    return C.unsigned;
+   function  FT_LOAD_MONOCHROME_flag          return C.unsigned;
+   function  FT_LOAD_LINEAR_DESIGN_flag       return C.unsigned;
+   function  FT_LOAD_NO_AUTOHINT_flag         return C.unsigned;
+
+
+
+private
+
+   pragma Import (C, FT_Outline_Get_CBox,             "FT_Outline_Get_CBox");
+   pragma Import (C, FT_Init_FreeType,                "FT_Init_FreeType");
+   pragma Import (C, FT_Done_FreeType,                "FT_Done_FreeType");
+   pragma Import (C, FT_Render_Glyph,                 "FT_Render_Glyph");
+   pragma Import (C, FT_Set_Char_Size,                "FT_Set_Char_Size");
+   pragma Import (C, FT_Done_Face,                    "FT_Done_Face");
+   pragma Import (C, FT_Attach_File,                  "FT_Attach_File");
+   pragma Import (C, FT_Set_Charmap,                  "FT_Set_Charmap");
+   pragma Import (C, FT_Select_Charmap,               "FT_Select_Charmap");
+   pragma Import (C, FT_Get_Char_Index,               "FT_Get_Char_Index");
+   pragma Import (C, FT_Get_Kerning,                  "FT_Get_Kerning");
+   pragma Import (C, FT_Load_Glyph,                   "FT_Load_Glyph");
+   pragma Import (C, FT_GlyphSlot_Get_Outline,        "FT_GlyphSlot_Get_Outline");
+   pragma Import (C, FT_GlyphSlot_Get_Advance,        "FT_GlyphSlot_Get_Advance");
+   pragma Import (C, FT_GlyphSlot_Get_Bitmap,         "FT_GlyphSlot_Get_Bitmap");
+   pragma Import (C, FT_GlyphSlot_Get_bitmap_left,    "FT_GlyphSlot_Get_bitmap_left");
+   pragma Import (C, FT_GlyphSlot_Get_bitmap_top,     "FT_GlyphSlot_Get_bitmap_top");
+   pragma Import (C, FT_GlyphSlot_Get_Format,         "FT_GlyphSlot_Get_Format");
+   pragma Import (C, FT_Size_Get_Metrics,             "FT_Size_Get_Metrics");
+   pragma Import (C, new_FT_Face,                     "new_FT_Face");
+   pragma Import (C, new_FT_Memory_Face,              "new_FT_Memory_Face");
+   pragma Import (C, FT_Face_Get_Size,                "FT_Face_Get_Size");
+   pragma Import (C, FT_Face_IS_SCALABLE,             "FT_Face_IS_SCALABLE");
+   pragma Import (C, FT_Face_HAS_KERNING,             "FT_Face_HAS_KERNING");
+   pragma Import (C, FT_Face_Get_BBox,                "FT_Face_Get_BBox");
+   pragma Import (C, FT_Face_Get_units_per_EM,        "FT_Face_Get_units_per_EM");
+   pragma Import (C, FT_Face_Get_num_glyphs,          "FT_Face_Get_num_glyphs");
+   pragma Import (C, FT_Face_Get_charmap,             "FT_Face_Get_charmap");
+   pragma Import (C, FT_Face_Get_charmap_at,          "FT_Face_Get_charmap_at");
+   pragma Import (C, FT_Face_Get_num_charmaps,        "FT_Face_Get_num_charmaps");
+   pragma Import (C, FT_Face_Get_glyph,               "FT_Face_Get_glyph");
+   pragma Import (C, FT_Face_Attach_Stream,           "FT_Face_Attach_Stream");
+   pragma Import (C, get_FT_GLYPH_FORMAT_NONE,        "get_FT_GLYPH_FORMAT_NONE");
+   pragma Import (C, get_FT_GLYPH_FORMAT_COMPOSITE,   "get_FT_GLYPH_FORMAT_COMPOSITE");
+   pragma Import (C, get_FT_GLYPH_FORMAT_BITMAP,      "get_FT_GLYPH_FORMAT_BITMAP");
+   pragma Import (C, get_FT_GLYPH_FORMAT_OUTLINE,     "get_FT_GLYPH_FORMAT_OUTLINE");
+   pragma Import (C, get_FT_GLYPH_FORMAT_PLOTTER,     "get_FT_GLYPH_FORMAT_PLOTTER");
+   pragma Import (C, FT_ENCODING_NONE_enum,           "FT_ENCODING_NONE_enum");
+   pragma Import (C, FT_ENCODING_MS_SYMBOL_enum,      "FT_ENCODING_MS_SYMBOL_enum");
+   pragma Import (C, FT_ENCODING_UNICODE_enum,        "FT_ENCODING_UNICODE_enum");
+   pragma Import (C, FT_ENCODING_SJIS_enum,           "FT_ENCODING_SJIS_enum");
+   pragma Import (C, FT_ENCODING_GB2312_enum,         "FT_ENCODING_GB2312_enum");
+   pragma Import (C, FT_ENCODING_BIG5_enum,           "FT_ENCODING_BIG5_enum");
+   pragma Import (C, FT_ENCODING_WANSUNG_enum,        "FT_ENCODING_WANSUNG_enum");
+   pragma Import (C, FT_ENCODING_JOHAB_enum,          "FT_ENCODING_JOHAB_enum");
+   pragma Import (C, FT_ENCODING_ADOBE_STANDARD_enum, "FT_ENCODING_ADOBE_STANDARD_enum");
+   pragma Import (C, FT_ENCODING_ADOBE_EXPERT_enum,   "FT_ENCODING_ADOBE_EXPERT_enum");
+   pragma Import (C, FT_ENCODING_ADOBE_CUSTOM_enum,   "FT_ENCODING_ADOBE_CUSTOM_enum");
+   pragma Import (C, FT_ENCODING_ADOBE_LATIN_1_enum,  "FT_ENCODING_ADOBE_LATIN_1_enum");
+   pragma Import (C, FT_ENCODING_OLD_LATIN_2_enum,    "FT_ENCODING_OLD_LATIN_2_enum");
+   pragma Import (C, FT_ENCODING_APPLE_ROMAN_enum,    "FT_ENCODING_APPLE_ROMAN_enum");
+   pragma Import (C, FT_LOAD_DEFAULT_flag,            "FT_LOAD_DEFAULT_flag");
+   pragma Import (C, FT_LOAD_NO_SCALE_flag,           "FT_LOAD_NO_SCALE_flag");
+   pragma Import (C, FT_LOAD_NO_HINTING_flag,         "FT_LOAD_NO_HINTING_flag");
+   pragma Import (C, FT_LOAD_RENDER_flag,             "FT_LOAD_RENDER_flag");
+   pragma Import (C, FT_LOAD_NO_BITMAP_flag,          "FT_LOAD_NO_BITMAP_flag");
+   pragma Import (C, FT_LOAD_VERTICAL_LAYOUT_flag,    "FT_LOAD_VERTICAL_LAYOUT_flag");
+   pragma Import (C, FT_LOAD_FORCE_AUTOHINT_flag,     "FT_LOAD_FORCE_AUTOHINT_flag");
+   pragma Import (C, FT_LOAD_CROP_BITMAP_flag,        "FT_LOAD_CROP_BITMAP_flag");
+   pragma Import (C, FT_LOAD_PEDANTIC_flag,           "FT_LOAD_PEDANTIC_flag");
+   pragma Import (C, FT_LOAD_IGNORE_GLOBAL_ADVANCE_WIDTH_flag,
+                                                      "FT_LOAD_IGNORE_GLOBAL_ADVANCE_WIDTH_flag");
+   pragma Import (C, FT_LOAD_NO_RECURSE_flag,         "FT_LOAD_NO_RECURSE_flag");
+   pragma Import (C, FT_LOAD_IGNORE_TRANSFORM_flag,   "FT_LOAD_IGNORE_TRANSFORM_flag");
+   pragma Import (C, FT_LOAD_MONOCHROME_flag,         "FT_LOAD_MONOCHROME_flag");
+   pragma Import (C, FT_LOAD_LINEAR_DESIGN_flag,      "FT_LOAD_LINEAR_DESIGN_flag");
+   pragma Import (C, FT_LOAD_NO_AUTOHINT_flag,        "FT_LOAD_NO_AUTOHINT_flag");
+
+end freetype_c.Binding;

3-mid/opengl/private/freetype/source/thin/freetype_c-ft_bbox.ads

@@ -0,0 +1,20 @@
+package freetype_c.FT_BBox
+is
+
+   type Item is
+      record
+         xMin : aliased FT_Pos;
+         yMin : aliased FT_Pos;
+         xMax : aliased FT_Pos;
+         yMax : aliased FT_Pos;
+      end record;
+
+   type Item_array is array (C.Size_t range <>) of aliased FT_BBox.Item;
+
+
+   type Pointer       is access all FT_BBox.Item;
+   type Pointer_array is array (C.Size_t range <>) of aliased FT_BBox.Pointer;
+
+   type pointer_Pointer is access all FT_BBox.Pointer;
+
+end freetype_c.FT_BBox;

3-mid/opengl/private/freetype/source/thin/freetype_c-ft_bitmap.ads

@@ -0,0 +1,24 @@
+package freetype_c.FT_Bitmap
+is
+
+   type Item is
+      record
+         Rows         : aliased c.int;
+         Width        : aliased c.int;
+         Pitch        : aliased c.int;
+         Buffer       : access  c.unsigned_char;
+         num_Grays    : aliased c.short;
+         pixel_Mode   : aliased c.char;
+         palette_Mode : aliased c.char;
+         Palette      : aliased System.Address;
+      end record;
+
+   type Item_array is array (C.Size_t range <>) of aliased FT_Bitmap.Item;
+
+
+   type Pointer       is access all FT_Bitmap.Item;
+   type Pointer_array is array (C.Size_t range <>) of aliased FT_Bitmap.Pointer;
+
+   type pointer_Pointer is access all freetype_c.FT_Bitmap.Pointer;
+
+end freetype_c.FT_Bitmap;

3-mid/opengl/private/freetype/source/thin/freetype_c-ft_charmap.ads

@@ -0,0 +1,15 @@
+with
+     freetype_c.FT_CharMapRec;
+
+package freetype_c.FT_CharMap
+is
+
+   subtype Item       is FT_CharMapRec.Pointer;
+   type    Item_array is array (interfaces.C.Size_t range <>) of aliased FT_CharMap.Item;
+
+   type Pointer       is access all FT_CharMap.Item;
+   type Pointer_array is array (C.Size_t range <>) of aliased FT_CharMap.Pointer;
+
+   type pointer_Pointer is access all freetype_c.FT_CharMap.Pointer;
+
+end freetype_c.FT_CharMap;

3-mid/opengl/private/freetype/source/thin/freetype_c-ft_charmaprec.ads

@@ -0,0 +1,20 @@
+package freetype_c.FT_CharMapRec
+is
+
+   type Item is
+      record
+         Face        : access  FT_FaceRec;
+         Encoding    : aliased FT_Encoding;
+         Platform_Id : aliased FT_UShort;
+         Encoding_Id : aliased FT_UShort;
+      end record;
+
+   type Item_array is array (C.Size_t range <>) of aliased FT_CharMapRec.Item;
+
+
+   type Pointer       is access all FT_CharMapRec.Item;
+   type Pointer_array is array (C.Size_t range <>) of aliased FT_CharMapRec.Pointer;
+
+   type pointer_Pointer is access all FT_CharMapRec.Pointer;
+
+end freetype_c.FT_CharMapRec;

3-mid/opengl/private/freetype/source/thin/freetype_c-ft_face.ads

@@ -0,0 +1,16 @@
+with
+     freetype_c.Pointers;
+
+package freetype_c.FT_Face
+is
+
+   subtype Item       is Pointers.FT_FaceRec_Pointer;
+   type    Item_array is array (C.Size_t range <>) of aliased FT_Face.Item;
+
+
+   type Pointer       is access all FT_Face.Item;
+   type Pointer_array is array (C.Size_t range <>) of aliased FT_Face.Pointer;
+
+   type pointer_Pointer is access all FT_Face.Pointer;
+
+end freetype_c.FT_Face;

3-mid/opengl/private/freetype/source/thin/freetype_c-ft_glyphslot.ads

@@ -0,0 +1,16 @@
+with
+     freetype_c.Pointers;
+
+package freetype_c.FT_GlyphSlot
+is
+
+   subtype Item       is freetype_c.Pointers.FT_GlyphSlotRec_Pointer;
+   type    Item_array is array (C.Size_t range <>) of aliased freetype_c.FT_GlyphSlot.Item;
+
+
+   type Pointer       is access all freetype_c.FT_GlyphSlot.Item;
+   type Pointer_array is array (C.Size_t range <>) of aliased freetype_c.FT_GlyphSlot.Pointer;
+
+   type pointer_Pointer is access all freetype_c.FT_GlyphSlot.Pointer;
+
+end freetype_c.FT_GlyphSlot;

3-mid/opengl/private/freetype/source/thin/freetype_c-ft_library.ads

@@ -0,0 +1,16 @@
+with
+     freetype_c.Pointers;
+
+package freetype_c.FT_Library
+is
+
+   subtype Item       is Pointers.FT_LibraryRec_Pointer;
+   type    Item_array is array (C.Size_t range <>) of aliased FT_Library.Item;
+
+
+   type Pointer       is access all freetype_c.FT_Library.Item;
+   type Pointer_array is array (C.Size_t range <>) of aliased freetype_c.FT_Library.Pointer;
+
+   type pointer_Pointer is access all freetype_c.FT_Library.Pointer;
+
+end freetype_c.FT_Library;

3-mid/opengl/private/freetype/source/thin/freetype_c-ft_size.ads

@@ -0,0 +1,16 @@
+with
+     freetype_c.Pointers;
+
+package freetype_c.FT_Size
+is
+
+   subtype Item       is Pointers.FT_SizeRec_Pointer;
+   type    Item_array is array (C.Size_t range <>) of aliased FT_Size.Item;
+
+
+   type Pointer       is access all freetype_c.FT_Size.Item;
+   type Pointer_array is array (C.Size_t range <>) of aliased FT_Size.Pointer;
+
+   type pointer_Pointer is access all FT_Size.Pointer;
+
+end freetype_c.FT_Size;

3-mid/opengl/private/freetype/source/thin/freetype_c-ft_size_metrics.ads

@@ -0,0 +1,24 @@
+package freetype_c.FT_Size_Metrics
+is
+
+   type Item is
+      record
+         X_ppem      : aliased FT_UShort;
+         Y_ppem      : aliased FT_UShort;
+         X_Scale     : aliased FT_Fixed;
+         Y_Scale     : aliased FT_Fixed;
+         Ascender    : aliased FT_Pos;
+         Descender   : aliased FT_Pos;
+         Height      : aliased FT_Pos;
+         max_Advance : aliased FT_Pos;
+      end record;
+
+   type Item_array is array (C.Size_t range <>) of aliased FT_Size_Metrics.Item;
+
+
+   type Pointer       is access all freetype_c.FT_Size_Metrics.Item;
+   type Pointer_array is array (C.Size_t range <>) of aliased freetype_c.FT_Size_Metrics.Pointer;
+
+   type pointer_Pointer is access all freetype_c.FT_Size_Metrics.Pointer;
+
+end freetype_c.FT_Size_Metrics;

3-mid/opengl/private/freetype/source/thin/freetype_c-ft_vector.ads

@@ -0,0 +1,17 @@
+package freetype_c.FT_Vector
+is
+
+   type Item is
+      record
+         X : aliased FT_Pos;
+         Y : aliased FT_Pos;
+      end record;
+
+   type Item_array is array (C.Size_t range <>) of aliased FT_Vector.Item;
+
+   type Pointer       is access all FT_Vector.Item;
+   type Pointer_array is array (C.Size_t range <>) of aliased FT_Vector.Pointer;
+
+   type pointer_Pointer is access all freetype_c.FT_Vector.Pointer;
+
+end freetype_c.FT_Vector;

3-mid/opengl/private/freetype/source/thin/freetype_c-pointer_pointers.ads

@@ -0,0 +1,28 @@
+with
+     freetype_c.Pointers;
+
+package freetype_c.pointer_Pointers 
+is
+   use freetype_c.Pointers;
+
+   type FT_UShort_Pointer_Pointer       is access all FT_UShort_Pointer;
+   type FT_Int_Pointer_Pointer          is access all FT_Int_Pointer;
+   type FT_UInt_Pointer_Pointer         is access all FT_UInt_Pointer;
+   type FT_Long_Pointer_Pointer         is access all FT_Long_Pointer;
+   type FT_ULong_Pointer_Pointer        is access all FT_ULong_Pointer;
+   type FT_Fixed_Pointer_Pointer        is access all FT_Fixed_Pointer;
+   type FT_Pos_Pointer_Pointer          is access all FT_Pos_Pointer;
+   type FT_Error_Pointer_Pointer        is access all FT_Error_Pointer;
+   type FT_Encoding_Pointer_Pointer     is access all FT_Encoding_Pointer;
+   type FT_F26Dot6_Pointer_Pointer      is access all FT_F26Dot6_Pointer;
+   type FT_Int32_Pointer_Pointer        is access all FT_Int32_Pointer;
+   type FT_UInt32_Pointer_Pointer       is access all FT_UInt32_Pointer;
+   type FT_Render_Mode_Pointer_Pointer  is access all FT_Render_Mode_Pointer;
+   type FT_Outline_Pointer_Pointer      is access all FT_Outline_Pointer;
+   type FT_LibraryRec_Pointer_Pointer   is access all FT_LibraryRec_Pointer;
+   type FT_GlyphSlotRec_Pointer_Pointer is access all FT_GlyphSlotRec_Pointer;
+   type FT_FaceRec_Pointer_Pointer      is access all FT_FaceRec_Pointer;
+   type FT_Kerning_Mode_Pointer_Pointer is access all FT_Kerning_Mode_Pointer;
+   type FT_SizeRec_Pointer_Pointer      is access all FT_SizeRec_Pointer;
+
+end freetype_c.pointer_Pointers;

3-mid/opengl/private/freetype/source/thin/freetype_c-pointers.ads

@@ -0,0 +1,45 @@
+package freetype_c.Pointers
+is
+
+   type FT_UShort_Pointer       is access all FT_UShort;
+   type FT_Int_Pointer          is access all FT_Int;
+   type FT_UInt_Pointer         is access all FT_UInt;
+   type FT_Long_Pointer         is access all FT_Long;
+   type FT_ULong_Pointer        is access all FT_ULong;
+   type FT_Fixed_Pointer        is access all FT_Fixed;
+   type FT_Pos_Pointer          is access all FT_Pos;
+   type FT_Error_Pointer        is access all FT_Error;
+   type FT_Encoding_Pointer     is access all FT_Encoding;
+   type FT_Int32_Pointer        is access all FT_Int32;
+   type FT_F26Dot6_Pointer      is access all FT_F26Dot6;
+   type FT_UInt32_Pointer       is access all FT_UInt32;
+   type FT_Render_Mode_Pointer  is access all FT_Render_Mode;
+   type FT_Outline_Pointer      is access all FT_Outline;
+   type FT_LibraryRec_Pointer   is access all FT_LibraryRec;
+   type FT_GlyphSlotRec_Pointer is access all FT_GlyphSlotRec;
+   type FT_FaceRec_Pointer      is access all FT_FaceRec;
+   type FT_Kerning_Mode_Pointer is access all FT_Kerning_Mode;
+   type FT_SizeRec_Pointer      is access all FT_SizeRec;
+
+
+   type FT_UShort_Pointer_array       is array (C.Size_t range <>) of aliased FT_UShort_Pointer;
+   type FT_Int_Pointer_array          is array (C.Size_t range <>) of aliased FT_Int_Pointer;
+   type FT_UInt_Pointer_array         is array (C.Size_t range <>) of aliased FT_UInt_Pointer;
+   type FT_Long_Pointer_array         is array (C.Size_t range <>) of aliased FT_Long_Pointer;
+   type FT_ULong_Pointer_array        is array (C.Size_t range <>) of aliased FT_ULong_Pointer;
+   type FT_Fixed_Pointer_array        is array (C.Size_t range <>) of aliased FT_Fixed_Pointer;
+   type FT_Pos_Pointer_array          is array (C.Size_t range <>) of aliased FT_Pos_Pointer;
+   type FT_Error_Pointer_array        is array (C.Size_t range <>) of aliased FT_Error_Pointer;
+   type FT_Encoding_Pointer_array     is array (C.Size_t range <>) of aliased FT_Encoding_Pointer;
+   type FT_F26Dot6_Pointer_array      is array (C.Size_t range <>) of aliased FT_F26Dot6_Pointer;
+   type FT_Int32_Pointer_array        is array (C.Size_t range <>) of aliased FT_Int32_Pointer;
+   type FT_UInt32_Pointer_array       is array (C.Size_t range <>) of aliased FT_UInt32_Pointer;
+   type FT_Render_Mode_Pointer_array  is array (C.Size_t range <>) of aliased FT_Render_Mode_Pointer;
+   type FT_Outline_Pointer_array      is array (C.Size_t range <>) of aliased FT_Outline_Pointer;
+   type FT_LibraryRec_Pointer_array   is array (C.Size_t range <>) of aliased FT_LibraryRec_Pointer;
+   type FT_GlyphSlotRec_Pointer_array is array (C.Size_t range <>) of aliased FT_GlyphSlotRec_Pointer;
+   type FT_FaceRec_Pointer_array      is array (C.Size_t range <>) of aliased FT_FaceRec_Pointer;
+   type FT_Kerning_Mode_Pointer_array is array (C.Size_t range <>) of aliased FT_Kerning_Mode_Pointer;
+   type FT_SizeRec_Pointer_array      is array (C.Size_t range <>) of aliased FT_SizeRec_Pointer;
+
+end freetype_c.Pointers;

3-mid/opengl/private/freetype/source/thin/freetype_c.ads

@@ -0,0 +1,135 @@
+with
+     interfaces.C,
+     System;
+
+
+package Freetype_C
+--
+--  Provides core types for the Freetype C library.
+--
+is
+   use Interfaces;
+
+
+   -- FT_UShort
+   --
+   subtype FT_UShort       is C.unsigned_short;
+   type    FT_UShort_array is array (C.Size_t range <>) of aliased FT_UShort;
+
+   -- FT_Int
+   --
+   subtype FT_Int       is C.int;
+   type    FT_Int_array is array (C.Size_t range <>) of aliased FT_Int;
+
+   -- FT_UInt
+   --
+   subtype FT_UInt       is C.unsigned;
+   type    FT_UInt_array is array (C.Size_t range <>) of aliased FT_UInt;
+
+   -- FT_Long
+   --
+   subtype FT_Long       is C.long;
+   type    FT_Long_array is array (C.Size_t range <>) of aliased FT_Long;
+
+   -- FT_ULong
+   --
+   subtype FT_ULong       is C.unsigned_long;
+   type    FT_ULong_array is array (C.Size_t range <>) of aliased FT_ULong;
+
+   -- FT_Fixed
+   --
+   subtype FT_Fixed       is C.long;
+   type    FT_Fixed_array is array (C.Size_t range <>) of aliased FT_Fixed;
+
+   -- FT_Pos
+   --
+   subtype FT_Pos       is C.long;
+   type    FT_Pos_array is array (C.Size_t range <>) of aliased FT_Pos;
+
+   -- FT_Error
+   --
+   subtype FT_Error       is C.int;
+   type    FT_Error_array is array (C.Size_t range <>) of aliased FT_Error;
+
+   -- FT_Encoding
+   --
+   subtype FT_Encoding       is C.unsigned;
+   type    FT_Encoding_array is array (C.Size_t range <>) of aliased FT_Encoding;
+
+   -- FT_F26Dot6
+   --
+   subtype FT_F26Dot6       is C.long;
+   type    FT_F26Dot6_array is array (C.Size_t range <>) of aliased FT_F26Dot6;
+
+   -- FT_Int32
+   --
+   subtype FT_Int32       is C.int;
+   type    FT_Int32_array is array (C.Size_t range <>) of aliased FT_Int32;
+
+   -- FT_UInt32
+   --
+   subtype FT_UInt32       is C.unsigned;
+   type    FT_UInt32_array is array (C.Size_t range <>) of aliased FT_UInt32;
+
+   -- FT_Render_Mode
+   --
+   type FT_Render_Mode is (FT_RENDER_MODE_NORMAL,
+                           FT_RENDER_MODE_LIGHT,
+                           FT_RENDER_MODE_MONO,
+                           FT_RENDER_MODE_LCD,
+                           FT_RENDER_MODE_LCD_V,
+                           FT_RENDER_MODE_MAX);
+   type FT_Render_Mode_array is array (C.Size_t range <>) of aliased FT_Render_Mode;
+
+   -- FT_Outline
+   --
+   subtype FT_Outline       is System.Address;
+   type    FT_Outline_array is array (C.Size_t range <>) of aliased FT_Outline;
+
+   -- FT_LibraryRec
+   --
+   subtype FT_LibraryRec       is System.Address;
+   type    FT_LibraryRec_array is array (C.Size_t range <>) of aliased FT_LibraryRec;
+
+   -- FT_GlyphSlotRec
+   --
+   subtype FT_GlyphSlotRec       is System.Address;
+   type    FT_GlyphSlotRec_array is array (C.Size_t range <>) of aliased FT_GlyphSlotRec;
+
+   -- FT_FaceRec
+   --
+   subtype FT_FaceRec       is System.Address;
+   type    FT_FaceRec_array is array (C.Size_t range <>) of aliased FT_FaceRec;
+
+   -- FT_Kerning_Mode
+   --
+   type FT_Kerning_Mode is (FT_KERNING_DEFAULT,
+                            FT_KERNING_UNFITTED,
+                            FT_KERNING_UNSCALED);
+   type FT_Kerning_Mode_array is array (C.Size_t range <>) of aliased FT_Kerning_Mode;
+
+   -- FT_SizeRec
+   --
+   subtype FT_SizeRec       is System.Address;
+   type    FT_SizeRec_array is array (C.Size_t range <>) of aliased FT_SizeRec;
+
+
+
+private
+
+   for FT_Render_Mode use (FT_RENDER_MODE_NORMAL => 0,
+                           FT_RENDER_MODE_LIGHT  => 1,
+                           FT_RENDER_MODE_MONO   => 2,
+                           FT_RENDER_MODE_LCD    => 3,
+                           FT_RENDER_MODE_LCD_V  => 4,
+                           FT_RENDER_MODE_MAX    => 5);
+   pragma Convention (C, FT_Render_Mode);
+
+
+   for FT_Kerning_Mode use (FT_KERNING_DEFAULT  => 0,
+                            FT_KERNING_UNFITTED => 1,
+                            FT_KERNING_UNSCALED => 2);
+   pragma Convention (C, FT_Kerning_Mode);
+
+
+end Freetype_C;

3-mid/opengl/private/freetype/source/thin/freetype_wrap.c

@@ -0,0 +1,360 @@
+#include <stdlib.h>
+#include <string.h>
+#include <stdio.h>
+
+
+#ifdef __cplusplus
+  #include <new>
+  extern "C"
+  {
+#endif
+
+
+#include <ft2build.h>
+#include FT_FREETYPE_H
+
+
+  /// FT_GlyphSlot
+  //
+
+  FT_Outline *FT_GlyphSlot_Get_Outline (const FT_GlyphSlot Self)
+  {
+    return &((struct FT_GlyphSlotRec_ *) Self)->outline;
+  }
+
+
+  FT_Vector FT_GlyphSlot_Get_Advance (const FT_GlyphSlot Self)
+  {
+    return ((struct FT_GlyphSlotRec_ *) Self)->advance;
+  }
+
+
+  FT_Bitmap FT_GlyphSlot_Get_Bitmap (const FT_GlyphSlot Self)
+  {
+    return ((struct FT_GlyphSlotRec_ *) Self)->bitmap;
+  }
+
+
+  FT_Int FT_GlyphSlot_Get_bitmap_left (const FT_GlyphSlot Self)
+  {
+    return ((struct FT_GlyphSlotRec_ *) Self)->bitmap_left;
+  }
+
+
+  FT_Int FT_GlyphSlot_Get_bitmap_top (const FT_GlyphSlot Self)
+  {
+    return ((struct FT_GlyphSlotRec_ *) Self)->bitmap_top;
+  }
+
+
+  unsigned FT_GlyphSlot_Get_Format (const FT_GlyphSlot Self)
+  {
+    return ((struct FT_GlyphSlotRec_ *) Self)->format;
+  }
+
+
+
+  // Size
+  //
+
+  FT_Size_Metrics FT_Size_Get_Metrics (const FT_Size Self)
+  {
+    return Self->metrics;
+  }
+
+
+
+
+  // Face
+  //
+
+  FT_Face new_FT_Face (FT_Library Library, const char *fontFilePath)
+  {
+    FT_Face the_Face;
+    const int DEFAULT_FACE_INDEX = 0;
+
+    FT_New_Face (Library, fontFilePath, DEFAULT_FACE_INDEX, &the_Face);
+
+    return the_Face;
+  }
+
+
+  FT_Face
+    new_FT_Memory_Face (FT_Library Library,
+			const unsigned char *pBufferBytes,
+			int bufferSizeInBytes)
+  {
+    FT_Face the_Face;
+    const int DEFAULT_FACE_INDEX = 0;
+
+    FT_New_Memory_Face (Library,
+			(FT_Byte const *) pBufferBytes,
+			(FT_Long) bufferSizeInBytes,
+			DEFAULT_FACE_INDEX, &the_Face);
+
+    return the_Face;
+  }
+
+
+  FT_Size FT_Face_Get_Size (const FT_Face Self)
+  {
+    return Self->size;
+  }
+
+
+  FT_Long FT_Face_IS_SCALABLE (const FT_Face Self)
+  {
+    return FT_IS_SCALABLE (Self);
+  }
+
+
+  FT_Long FT_Face_HAS_KERNING (const FT_Face Self)
+  {
+    return FT_HAS_KERNING (Self);
+  }
+
+
+  FT_BBox FT_Face_Get_BBox (const FT_Face Self)
+  {
+    return Self->bbox;
+  }
+
+
+  FT_UShort FT_Face_Get_units_per_EM (const FT_Face Self)
+  {
+    return Self->units_per_EM;
+  }
+
+
+  FT_Long FT_Face_Get_num_glyphs (const FT_Face Self)
+  {
+    return Self->num_glyphs;
+  }
+
+
+  FT_CharMap FT_Face_Get_charmap (const FT_Face Self)
+  {
+    return Self->charmap;
+  }
+
+
+  FT_CharMap FT_Face_Get_charmap_at (const FT_Face Self, int index)
+  {
+    return Self->charmaps[index];
+  }
+
+
+  FT_Int FT_Face_Get_num_charmaps (const FT_Face Self)
+  {
+    return Self->num_charmaps;
+  }
+
+
+  FT_GlyphSlot FT_Face_Get_glyph (const FT_Face Self)
+  {
+    return Self->glyph;
+  }
+
+
+  FT_Error
+    FT_Face_Attach_Stream (const FT_Face Self,
+			   const unsigned char *pBufferBytes,
+			   size_t bufferSizeInBytes)
+  {
+    FT_Open_Args open;
+    FT_Error err;
+
+    open.flags = FT_OPEN_MEMORY;
+    open.memory_base = (FT_Byte const *) pBufferBytes;
+    open.memory_size = (FT_Long) bufferSizeInBytes;
+
+    err = FT_Attach_Stream (Self, &open);
+    return err;
+  }
+
+
+  // Glyph Format
+  //
+
+  unsigned get_FT_GLYPH_FORMAT_NONE ()
+  {
+    return FT_GLYPH_FORMAT_NONE;
+  }
+
+  unsigned get_FT_GLYPH_FORMAT_COMPOSITE ()
+  {
+    return FT_GLYPH_FORMAT_COMPOSITE;
+  }
+
+  unsigned get_FT_GLYPH_FORMAT_BITMAP ()
+  {
+    return FT_GLYPH_FORMAT_BITMAP;
+  }
+
+  unsigned get_FT_GLYPH_FORMAT_OUTLINE ()
+  {
+    return FT_GLYPH_FORMAT_OUTLINE;
+  }
+
+  unsigned get_FT_GLYPH_FORMAT_PLOTTER ()
+  {
+    return FT_GLYPH_FORMAT_PLOTTER;
+  }
+
+
+  // Font Encoding
+  //
+
+  FT_Encoding FT_ENCODING_NONE_enum ()
+  {
+    return FT_ENCODING_NONE;
+  }
+
+  FT_Encoding FT_ENCODING_MS_SYMBOL_enum ()
+  {
+    return FT_ENCODING_MS_SYMBOL;
+  }
+
+  FT_Encoding FT_ENCODING_UNICODE_enum ()
+  {
+    return FT_ENCODING_UNICODE;
+  }
+
+  FT_Encoding FT_ENCODING_SJIS_enum ()
+  {
+    return FT_ENCODING_SJIS;
+  }
+
+  FT_Encoding FT_ENCODING_GB2312_enum ()
+  {
+    return FT_ENCODING_GB2312;
+  }
+
+  FT_Encoding FT_ENCODING_BIG5_enum ()
+  {
+    return FT_ENCODING_BIG5;
+  }
+
+  FT_Encoding FT_ENCODING_WANSUNG_enum ()
+  {
+    return FT_ENCODING_WANSUNG;
+  }
+
+  FT_Encoding FT_ENCODING_JOHAB_enum ()
+  {
+    return FT_ENCODING_JOHAB;
+  }
+
+  FT_Encoding FT_ENCODING_ADOBE_STANDARD_enum ()
+  {
+    return FT_ENCODING_ADOBE_STANDARD;
+  }
+
+  FT_Encoding FT_ENCODING_ADOBE_EXPERT_enum ()
+  {
+    return FT_ENCODING_ADOBE_EXPERT;
+  }
+
+  FT_Encoding FT_ENCODING_ADOBE_CUSTOM_enum ()
+  {
+    return FT_ENCODING_ADOBE_CUSTOM;
+  }
+
+  FT_Encoding FT_ENCODING_ADOBE_LATIN_1_enum ()
+  {
+    return FT_ENCODING_ADOBE_LATIN_1;
+  }
+
+  FT_Encoding FT_ENCODING_OLD_LATIN_2_enum ()
+  {
+    return FT_ENCODING_OLD_LATIN_2;
+  }
+
+  FT_Encoding FT_ENCODING_APPLE_ROMAN_enum ()
+  {
+    return FT_ENCODING_APPLE_ROMAN;
+  }
+
+
+  // Load Flags
+  //
+
+  unsigned int FT_LOAD_DEFAULT_flag ()
+  {
+    return FT_LOAD_DEFAULT;
+  }
+
+  unsigned int FT_LOAD_NO_SCALE_flag ()
+  {
+    return FT_LOAD_NO_SCALE;
+  }
+
+  unsigned int FT_LOAD_NO_HINTING_flag ()
+  {
+    return FT_LOAD_NO_HINTING;
+  }
+
+  unsigned int FT_LOAD_RENDER_flag ()
+  {
+    return FT_LOAD_RENDER;
+  }
+
+  unsigned int FT_LOAD_NO_BITMAP_flag ()
+  {
+    return FT_LOAD_NO_BITMAP;
+  }
+
+  unsigned int FT_LOAD_VERTICAL_LAYOUT_flag ()
+  {
+    return FT_LOAD_VERTICAL_LAYOUT;
+  }
+
+  unsigned int FT_LOAD_FORCE_AUTOHINT_flag ()
+  {
+    return FT_LOAD_FORCE_AUTOHINT;
+  }
+
+  unsigned int FT_LOAD_CROP_BITMAP_flag ()
+  {
+    return FT_LOAD_CROP_BITMAP;
+  }
+
+  unsigned int FT_LOAD_PEDANTIC_flag ()
+  {
+    return FT_LOAD_PEDANTIC;
+  }
+
+  unsigned int FT_LOAD_IGNORE_GLOBAL_ADVANCE_WIDTH_flag ()
+  {
+    return FT_LOAD_IGNORE_GLOBAL_ADVANCE_WIDTH;
+  }
+
+  unsigned int FT_LOAD_NO_RECURSE_flag ()
+  {
+    return FT_LOAD_NO_RECURSE;
+  }
+
+  unsigned int FT_LOAD_IGNORE_TRANSFORM_flag ()
+  {
+    return FT_LOAD_IGNORE_TRANSFORM;
+  }
+
+  unsigned int FT_LOAD_MONOCHROME_flag ()
+  {
+    return FT_LOAD_MONOCHROME;
+  }
+
+  unsigned int FT_LOAD_LINEAR_DESIGN_flag ()
+  {
+    return FT_LOAD_LINEAR_DESIGN;
+  }
+
+  unsigned int FT_LOAD_NO_AUTOHINT_flag ()
+  {
+    return FT_LOAD_NO_AUTOHINT;
+  }
+
+
+#ifdef __cplusplus
+}				// end extern "C"
+#endif

3-mid/opengl/private/gid/debug.pra

@@ -0,0 +1,3 @@
+pragma Initialize_Scalars;
+-- pragma Normalize_Scalars; -- For all units!
+

3-mid/opengl/private/gid/gid-buffering.adb

@@ -0,0 +1,79 @@
+with Ada.IO_Exceptions;
+
+package body GID.Buffering is
+
+  procedure Fill_Buffer(b: in out Input_buffer);
+  -- ^ Spec here to avoid warning by 'Get_Byte' below (GNAT 2009):
+  -- warning: call to subprogram with no separate spec prevents inlining
+
+  procedure Fill_Buffer(b: in out Input_buffer)
+  is
+    --
+    procedure BlockRead(
+      buffer       :    out Byte_Array;
+      actually_read:    out Natural
+    )
+    is
+      use Ada.Streams;
+      Last_Read: Stream_Element_Offset;
+    begin
+      if is_mapping_possible then
+        declare
+          SE_Buffer_mapped: Stream_Element_Array (1 .. buffer'Length);
+          -- direct mapping: buffer = SE_Buffer_mapped
+          for SE_Buffer_mapped'Address use buffer'Address;
+          pragma Import (Ada, SE_Buffer_mapped);
+        begin
+          Read(b.stream.all, SE_Buffer_mapped, Last_Read);
+        end;
+      else
+        declare
+          SE_Buffer: Stream_Element_Array (1 .. buffer'Length);
+          -- need to copy array (slightly slower)
+        begin
+          Read(b.stream.all, SE_Buffer, Last_Read);
+          for i in buffer'Range loop
+            buffer(i):= U8(SE_Buffer(Stream_Element_Offset(i-buffer'First)+SE_buffer'First));
+          end loop;
+        end;
+      end if;
+      actually_read:= Natural(Last_Read);
+    end BlockRead;
+    --
+  begin
+    BlockRead(
+      buffer        => b.data,
+      actually_read => b.MaxInBufIdx
+    );
+    b.InputEoF:= b.MaxInBufIdx = 0;
+    b.InBufIdx := 1;
+  end Fill_Buffer;
+
+  procedure Attach_Stream(
+    b   :    out Input_buffer;
+    stm : in     Stream_Access
+  )
+  is
+  begin
+    b.stream:= stm;
+    -- Fill_Buffer(b) will be performed on first call of Get_Byte
+  end Attach_Stream;
+
+  function Is_stream_attached(b: Input_buffer) return Boolean is
+  begin
+    return b.stream /= null;
+  end Is_stream_attached;
+
+  procedure Get_Byte(b: in out Input_buffer; byte: out U8) is
+  begin
+    if b.InBufIdx > b.MaxInBufIdx then
+      Fill_Buffer(b);
+      if b.InputEoF then
+        raise Ada.IO_Exceptions.End_Error;
+      end if;
+    end if;
+    byte:= b.data(b.InBufIdx);
+    b.InBufIdx:= b.InBufIdx + 1;
+  end Get_Byte;
+
+end GID.Buffering;

3-mid/opengl/private/gid/gid-buffering.ads

@@ -0,0 +1,28 @@
+private package GID.Buffering is
+
+  -- Attach a buffer to a stream.
+  procedure Attach_Stream(
+    b   :    out Input_buffer;
+    stm : in     Stream_Access
+  );
+
+  function Is_stream_attached(b: Input_buffer) return Boolean;
+
+  -- From the first call to Get_Byte, subsequent bytes must be read
+  -- through Get_Byte as well since the stream is partly read in advance
+  procedure Get_Byte(b: in out Input_buffer; byte: out U8);
+  pragma Inline(Get_Byte);
+
+private
+
+  subtype Size_test_a is Byte_Array(1..19);
+  subtype Size_test_b is Ada.Streams.Stream_Element_Array(1..19);
+
+  -- is_mapping_possible: Compile-time test for checking if
+  -- a Byte_Array is equivalemnt to a Ada.Streams.Stream_Element_Array.
+  --
+  is_mapping_possible: constant Boolean:=
+    Size_test_a'Size = Size_test_b'Size and
+    Size_test_a'Alignment = Size_test_b'Alignment;
+
+end GID.Buffering;

3-mid/opengl/private/gid/gid-color_tables.adb

@@ -0,0 +1,71 @@
+with GID.Buffering;
+
+with Ada.Exceptions;
+
+package body GID.Color_tables is
+
+  procedure Convert(c, d: in U8; rgb: out RGB_Color) is
+  begin
+    rgb.red  := (d and 127) / 4;
+    rgb.green:= (d and 3) * 8 + c / 32;
+    rgb.blue := c and 31;
+    --
+    rgb.red  := U8((U16(rgb.red  ) * 255) / 31);
+    rgb.green:= U8((U16(rgb.green) * 255) / 31);
+    rgb.blue := U8((U16(rgb.blue ) * 255) / 31);
+  end Convert;
+
+  procedure Load_palette (image: in out Image_descriptor) is
+    c, d: U8;
+    use GID.Buffering;
+  begin
+    if image.palette = null then
+      return;
+    end if;
+    declare
+      palette: Color_Table renames image.palette.all;
+    begin
+      for i in palette'Range loop
+        case image.format is
+          when BMP =>
+            -- order is BGRx
+            U8'Read(image.stream, Palette(i).blue);
+            U8'Read(image.stream, Palette(i).green);
+            U8'Read(image.stream, Palette(i).red);
+            U8'Read(image.stream, c);
+            -- x discarded
+          when GIF | PNG =>
+            -- buffered; order is RGB
+            Get_Byte(image.buffer, Palette(i).red);
+            Get_Byte(image.buffer, Palette(i).green);
+            Get_Byte(image.buffer, Palette(i).blue);
+          when TGA =>
+            case image.subformat_id is -- = palette's bit depth
+              when 8 => -- Grey
+                U8'Read(image.stream, c);
+                Palette(i).Red  := c;
+                Palette(i).Green:= c;
+                Palette(i).Blue := c;
+              when 15 | 16 => -- RGB, 5 bit per channel
+                U8'Read(image.stream, c);
+                U8'Read(image.stream, d);
+                Convert(c, d, Palette(i));
+              when 24 | 32 => -- RGB | RGBA, 8 bit per channel
+                U8'Read(image.stream, Palette(i).blue);
+                U8'Read(image.stream, Palette(i).green);
+                U8'Read(image.stream, Palette(i).red);
+              when others =>
+                null;
+            end case;
+          when others =>
+            Ada.Exceptions.Raise_exception(
+              unsupported_image_subformat'Identity,
+              "Palette loading not implemented for " &
+              Image_format_type'Image(image.format)
+            );
+        end case;
+      end loop;
+    end;
+  end Load_palette;
+
+end GID.Color_tables;

3-mid/opengl/private/gid/gid-color_tables.ads

@@ -0,0 +1,18 @@
+--
+-- Color tables, known as "palettes"
+--
+
+private package GID.Color_tables is
+
+  -- Load a palette on its defined range, according to
+  -- the format and subformats loaded by initial
+  -- steps in GID.Load_image_header
+  procedure Load_palette (image: in out Image_descriptor);
+  -- if image.palette = null, nothing happens.
+
+  -- Convert a RGB value packed in 2 bytes
+  -- (15 bit, 5 bit each channel) into a RGB_Color
+  -- This is for the TGA format.
+  procedure Convert(c, d: in U8; rgb: out RGB_Color);
+
+end GID.Color_tables;

3-mid/opengl/private/gid/gid-decoding_bmp.adb

@@ -0,0 +1,122 @@
+with GID.Buffering;                     use GID.Buffering;
+
+package body GID.Decoding_BMP is
+
+  procedure Load (image: in out Image_descriptor) is
+    b01, b, br, bg, bb: U8:= 0;
+    x, x_max, y: Natural;
+    --
+    procedure Pixel_with_palette is
+      pragma Inline(Pixel_with_palette);
+    begin
+      case Primary_color_range'Modulus is
+        when 256 =>
+          Put_Pixel(
+            Primary_color_range(image.palette(Integer(b)).red),
+            Primary_color_range(image.palette(Integer(b)).green),
+            Primary_color_range(image.palette(Integer(b)).blue),
+            255
+          );
+        when 65_536 =>
+          Put_Pixel(
+            16#101# * Primary_color_range(image.palette(Integer(b)).red),
+            16#101# * Primary_color_range(image.palette(Integer(b)).green),
+            16#101# * Primary_color_range(image.palette(Integer(b)).blue),
+            65_535
+            -- 16#101# because max intensity FF goes to FFFF
+          );
+        when others =>
+          raise invalid_primary_color_range;
+      end case;
+    end Pixel_with_palette;
+    --
+    pair: Boolean;
+    bit: Natural range 0..7;
+    --
+    line_bits: constant Float:= Float(image.width * image.bits_per_pixel);
+    padded_line_size: constant Positive:= 4 * Integer(Float'Ceiling(line_bits / 32.0));
+    unpadded_line_size: constant Positive:= Integer(Float'Ceiling(line_bits / 8.0));
+    -- (in bytes)
+  begin
+    Attach_Stream(image.buffer, image.stream);
+    y:= 0;
+    while y <= image.height-1 loop
+      x:= 0;
+      x_max:= image.width-1;
+      case image.bits_per_pixel is
+        when 1 => -- B/W
+          bit:= 0;
+          Set_X_Y(x,y);
+          while x <= x_max loop
+            if bit=0 then
+              Get_Byte(image.buffer, b01);
+            end if;
+            b:= (b01 and 16#80#) / 16#80#;
+            Pixel_with_palette;
+            b01:= b01 * 2; -- cannot overflow.
+            if bit=7 then
+              bit:= 0;
+            else
+              bit:= bit + 1;
+            end if;
+            x:= x + 1;
+          end loop;
+        when 4 => -- 16 colour image
+          pair:= True;
+          Set_X_Y(x,y);
+          while x <= x_max loop
+            if pair then
+              Get_Byte(image.buffer, b01);
+              b:= (b01 and 16#F0#) / 16#10#;
+            else
+              b:= (b01 and 16#0F#);
+            end if;
+            pair:= not pair;
+            Pixel_with_palette;
+            x:= x + 1;
+          end loop;
+        when 8 => -- 256 colour image
+          Set_X_Y(x,y);
+          while x <= x_max loop
+            Get_Byte(image.buffer, b);
+            Pixel_with_palette;
+            x:= x + 1;
+          end loop;
+        when 24 => -- RGB, 256 colour per primary colour
+          Set_X_Y(x,y);
+          while x <= x_max loop
+            Get_Byte(image.buffer, bb);
+            Get_Byte(image.buffer, bg);
+            Get_Byte(image.buffer, br);
+            case Primary_color_range'Modulus is
+              when 256 =>
+                Put_Pixel(
+                  Primary_color_range(br),
+                  Primary_color_range(bg),
+                  Primary_color_range(bb),
+                  255
+                );
+              when 65_536 =>
+                Put_Pixel(
+                  256 * Primary_color_range(br),
+                  256 * Primary_color_range(bg),
+                  256 * Primary_color_range(bb),
+                  65_535
+                );
+              when others =>
+                raise invalid_primary_color_range;
+            end case;
+            x:= x + 1;
+          end loop;
+        when others =>
+          null;
+      end case;
+      for i in unpadded_line_size + 1 .. padded_line_size loop
+        Get_Byte(image.buffer, b);
+      end loop;
+      y:= y + 1;
+      Feedback((y*100)/image.height);
+    end loop;
+  end Load;
+
+end GID.Decoding_BMP;

3-mid/opengl/private/gid/gid-decoding_bmp.ads

@@ -0,0 +1,18 @@
+private package GID.Decoding_BMP is
+
+  --------------------
+  -- Image decoding --
+  --------------------
+
+  generic
+    type Primary_color_range is mod <>;
+    with procedure Set_X_Y (x, y: Natural);
+    with procedure Put_Pixel (
+      red, green, blue : Primary_color_range;
+      alpha            : Primary_color_range
+    );
+    with procedure Feedback (percents: Natural);
+  --
+  procedure Load (image: in out Image_descriptor);
+
+end GID.Decoding_BMP;

3-mid/opengl/private/gid/gid-decoding_gif.adb

@@ -0,0 +1,597 @@
+-- A GIF stream is made of several "blocks".
+-- The image itself is contained in an Image Descriptor block.
+--
+with GID.Buffering, GID.Color_tables;
+
+with Ada.Exceptions, Ada.Text_IO;
+
+package body GID.Decoding_GIF is
+
+  generic
+    type Number is mod <>;
+  procedure Read_Intel_x86_number(
+    from : in out Input_buffer;
+    n    :    out Number
+  );
+    pragma Inline(Read_Intel_x86_number);
+
+  procedure Read_Intel_x86_number(
+    from : in out Input_buffer;
+    n    :    out Number
+  )
+  is
+    b: U8;
+    m: Number:= 1;
+  begin
+    n:= 0;
+    for i in 1..Number'Size/8 loop
+      GID.Buffering.Get_Byte(from, b);
+      n:= n + m * Number(b);
+      m:= m * 256;
+    end loop;
+  end Read_Intel_x86_number;
+
+  procedure Read_Intel is new Read_Intel_x86_number( U16 );
+
+  ----------
+  -- Load --
+  ----------
+
+  procedure Load (
+    image     : in out Image_descriptor;
+    next_frame:    out Ada.Calendar.Day_Duration
+  )
+  is
+    local: Image_descriptor;
+    -- With GIF, each frame is a local image with an eventual
+    -- palette, different dimensions, etc. ...
+
+    use GID.Buffering, Ada.Exceptions;
+
+    type GIFDescriptor is record
+      ImageLeft,
+      ImageTop,
+      ImageWidth,
+      ImageHeight : U16;
+      Depth       : U8;
+    end record;
+
+    -- For loading from the GIF file
+    Descriptor : GIFDescriptor;
+
+    -- Coordinates
+    X, tlX, brX : Natural;
+    Y, tlY, brY : Natural;
+
+    -- Code information
+    subtype Code_size_range is Natural range 2..12;
+    CurrSize : Code_size_range;
+
+    subtype Color_type is U8;
+    Transp_color   : Color_type:= 0;
+
+    -- GIF data is stored in blocks and sub-blocks.
+    -- We initialize block_read and block_size to force
+    -- reading and buffering the next sub-block
+    block_size   : Natural:= 0;
+    block_read   : Natural:= 0;
+
+    function Read_Byte return U8 is
+    pragma Inline(Read_Byte);
+      b: U8;
+      use Ada.Streams;
+    begin
+      if block_read >= block_size then
+        Get_Byte(image.buffer, b);
+        block_size:= Natural(b);
+        block_read:= 0;
+      end if;
+      Get_Byte(image.buffer, b);
+      block_read:= block_read + 1;
+      return b;
+    end Read_Byte;
+
+    -- Used while reading the codes
+    bits_in : U8:= 8;
+    bits_buf: U8;
+
+    -- Local procedure to read the next code from the file
+    function Read_Code return Natural is
+      bit_mask: Natural:= 1;
+      code: Natural:= 0;
+    begin
+      -- Read the code, bit by bit
+      for Counter  in reverse  0..CurrSize - 1  loop
+        -- Next bit
+        bits_in:= bits_in + 1;
+        -- Maybe, a new byte needs to be loaded with a further 8 bits
+        if bits_in = 9 then
+          bits_buf:= Read_Byte;
+          bits_in := 1;
+        end if;
+        -- Add the current bit to the code
+        if (bits_buf  and  1) > 0 then
+          code:= code + bit_mask;
+        end if;
+        bit_mask := bit_mask * 2;
+        bits_buf := bits_buf / 2;
+      end loop;
+      return code;
+    end Read_Code;
+
+    generic
+      -- Parameter(s) that are constant through
+      -- the whole image. Macro-expanded generics and
+      -- some optimization will trim corresponding "if's"
+      interlaced     : Boolean;
+      transparency   : Boolean;
+      pixel_mask     : U32;
+      --
+    procedure GIF_Decode;
+
+    procedure GIF_Decode is
+
+      procedure Pixel_with_palette(b: U8) is
+      pragma Inline(Pixel_with_palette);
+      begin
+        if transparency and then b = Transp_color then
+          Put_Pixel(0,0,0, 0);
+          return;
+        end if;
+        case Primary_color_range'Modulus is
+          when 256 =>
+            Put_Pixel(
+              Primary_color_range(local.palette(Integer(b)).red),
+              Primary_color_range(local.palette(Integer(b)).green),
+              Primary_color_range(local.palette(Integer(b)).blue),
+              255
+            );
+          when 65_536 =>
+            Put_Pixel(
+              16#101# * Primary_color_range(local.palette(Integer(b)).red),
+              16#101# * Primary_color_range(local.palette(Integer(b)).green),
+              16#101# * Primary_color_range(local.palette(Integer(b)).blue),
+              -- 16#101# because max intensity FF goes to FFFF
+              65_535
+            );
+          when others =>
+            raise invalid_primary_color_range;
+        end case;
+      end Pixel_with_palette;
+
+      -- Interlacing
+      Interlace_pass : Natural range 1..4:= 1;
+      Span           : Natural:= 7;
+
+      -- Local procedure to draw a pixel
+      procedure Next_Pixel(code: Natural) is
+      pragma Inline(Next_Pixel);
+        c : constant Color_Type:= Color_type(U32(code) and pixel_mask);
+      begin
+        -- Actually draw the pixel on screen buffer
+        if X < image.width then
+          if interlaced and mode = nice then
+            for i in reverse 0..Span loop
+              if Y+i < image.height then
+                Set_X_Y(X, image.height - (Y+i) - 1);
+                Pixel_with_palette(c);
+              end if;
+            end loop;
+          elsif Y < image.height then
+            Pixel_with_palette(c);
+          end if;
+        end if;
+
+        -- Move on to next pixel
+        X:= X + 1;
+
+        -- Or next row, if necessary
+        if X = brX then
+          X:= tlX;
+          if interlaced then
+            case Interlace_pass is
+              when 1 =>
+                Y:= Y + 8;
+                if Y >= brY then
+                  Y:= 4;
+                  Interlace_pass:= 2;
+                  Span:= 3;
+                  Feedback((Interlace_pass*100)/4);
+                end if;
+              when 2 =>
+                Y:= Y + 8;
+                if Y >= brY then
+                  Y:= 2;
+                  Interlace_pass:= 3;
+                  Span:= 1;
+                  Feedback((Interlace_pass*100)/4);
+                end if;
+              when 3 =>
+                Y:= Y + 4;
+                if Y >= brY then
+                  Y:= 1;
+                  Interlace_pass:= 4;
+                  Span:= 0;
+                  Feedback((Interlace_pass*100)/4);
+                end if;
+              when 4 =>
+                Y:= Y + 2;
+            end case;
+            if mode = fast and then Y < image.height then
+              Set_X_Y(X, image.height - Y - 1);
+            end if;
+          else -- not interlaced
+            Y:= Y + 1;
+            if Y < image.height then
+              Set_X_Y(X, image.height - Y - 1);
+            end if;
+            if Y mod 32 = 0 then
+              Feedback((Y*100)/image.height);
+            end if;
+          end if;
+        end if;
+      end Next_Pixel;
+
+      -- The string table
+      Prefix : array ( 0..4096 ) of Natural:= (others => 0);
+      Suffix : array ( 0..4096 ) of Natural:= (others => 0);
+      Stack  : array ( 0..1024 ) of Natural;
+
+      -- Special codes (specific to GIF's flavour of LZW)
+      ClearCode : constant Natural:= 2 ** CurrSize; -- Reset code
+      EndingCode: constant Natural:= ClearCode + 1; -- End of file
+      FirstFree : constant Natural:= ClearCode + 2; -- Strings start here
+
+      Slot         : Natural:= FirstFree;  --  Last read code
+      InitCodeSize : constant Code_size_range:= CurrSize + 1;
+      TopSlot      : Natural:= 2 ** InitCodeSize; --  Highest code for current size
+      Code         : Natural;
+      StackPtr     : Integer:= 0;
+      Fc           : Integer:= 0;
+      Oc           : Integer:= 0;
+      C            : Integer;
+      BadCodeCount : Natural:= 0;  --  the number of bad codes found
+
+    begin -- GIF_Decode
+      -- The decoder source and the cool comments are kindly donated by
+      -- André van Splunter.
+      --
+      CurrSize:= InitCodeSize;
+      --  This is the main loop.  For each code we get we pass through the
+      --  linked list of prefix codes, pushing the corresponding "character"
+      --  for each code onto the stack.  When the list reaches a single
+      --  "character" we push that on the stack too, and then start unstacking
+      --  each character for output in the correct order.  Special handling is
+      --  included for the clear code, and the whole thing ends when we get
+      --  an ending code.
+      C := Read_Code;
+      while C /= EndingCode loop
+         --  If the code is a clear code, reinitialize all necessary items.
+         if C = ClearCode then
+            CurrSize := InitCodeSize;
+            Slot     := FirstFree;
+            TopSlot  := 2 ** CurrSize;
+            --  Continue reading codes until we get a non-clear code
+            --  (Another unlikely, but possible case...)
+            C := Read_Code;
+            while C = ClearCode loop
+               C := Read_Code;
+            end loop;
+            --  If we get an ending code immediately after a clear code
+            --  (Yet another unlikely case), then break out of the loop.
+            exit when C = EndingCode;
+            --  Finally, if the code is beyond the range of already set codes,
+            --  (This one had better NOT happen...  I have no idea what will
+            --  result from this, but I doubt it will look good...) then set
+            --  it to color zero.
+            if C >= Slot then
+               C := 0;
+            end if;
+            Oc := C;
+            Fc := C;
+            --  And let us not forget to output the char...
+            Next_Pixel(C);
+         else  --  C /= ClearCode
+            --  In this case, it's not a clear code or an ending code, so
+            --  it must be a code code...  So we can now decode the code into
+            --  a stack of character codes. (Clear as mud, right?)
+            Code := C;
+            --  Here we go again with one of those off chances...  If, on the
+            --  off chance, the code we got is beyond the range of those
+            --  already set up (Another thing which had better NOT happen...)
+            --  we trick the decoder into thinking it actually got the last
+            --  code read. (Hmmn... I'm not sure why this works...
+            --  But it does...)
+            if Code >= Slot then
+               if Code > Slot then
+                  BadCodeCount := BadCodeCount + 1;
+               end if;
+               Code := Oc;
+               Stack (StackPtr) := Fc rem 256;
+               StackPtr := StackPtr + 1;
+            end if;
+            --  Here we scan back along the linked list of prefixes, pushing
+            --  helpless characters (ie. suffixes) onto the stack as we do so.
+            while Code >= FirstFree loop
+               Stack (StackPtr) := Suffix (Code);
+               StackPtr := StackPtr + 1;
+               Code := Prefix (Code);
+            end loop;
+            --  Push the last character on the stack, and set up the new
+            --  prefix and suffix, and if the required slot number is greater
+            --  than that allowed by the current bit size, increase the bit
+            --  size.  (NOTE - If we are all full, we *don't* save the new
+            --  suffix and prefix...  I'm not certain if this is correct...
+            --  it might be more proper to overwrite the last code...
+            Stack (StackPtr) := Code rem 256;
+            if Slot < TopSlot then
+               Suffix (Slot) := Code rem 256;
+               Fc := Code;
+               Prefix (Slot) := Oc;
+               Slot := Slot + 1;
+               Oc := C;
+            end if;
+            if Slot >= TopSlot then
+               if CurrSize < 12 then
+                  TopSlot := TopSlot * 2;
+                  CurrSize := CurrSize + 1;
+               end if;
+            end if;
+            --  Now that we've pushed the decoded string (in reverse order)
+            --  onto the stack, lets pop it off and output it...
+            loop
+               Next_Pixel(Stack (StackPtr));
+               exit when StackPtr = 0;
+               StackPtr := StackPtr - 1;
+            end loop;
+         end if;
+         C := Read_Code;
+      end loop;
+      if full_trace and then BadCodeCount > 0 then
+        Ada.Text_IO.Put_Line(
+         "Found" & Integer'Image(BadCodeCount) &
+         " bad codes"
+        );
+      end if;
+    end GIF_Decode;
+
+    -- Here we have several specialized instances of GIF_Decode,
+    -- with parameters known at compile-time -> optimizing compilers
+    -- will skip expensive tests about interlacing, transparency.
+    --
+    procedure GIF_Decode_interlaced_transparent_8 is
+      new GIF_Decode(True, True, 255);
+    procedure GIF_Decode_straight_transparent_8 is
+      new GIF_Decode(False, True, 255);
+    procedure GIF_Decode_interlaced_opaque_8 is
+      new GIF_Decode(True, False, 255);
+    procedure GIF_Decode_straight_opaque_8 is
+      new GIF_Decode(False, False, 255);
+    --
+    procedure Skip_sub_blocks is
+      temp: U8;
+    begin
+       sub_blocks_sequence:
+       loop
+        Get_Byte(image.buffer, temp ); -- load sub-block length byte
+        exit sub_blocks_sequence when temp = 0;
+        -- null sub-block = end of sub-block sequence
+        for i in 1..temp loop
+          Get_Byte(image.buffer, temp ); -- load sub-block byte
+        end loop;
+      end loop sub_blocks_sequence;
+    end Skip_sub_blocks;
+
+    temp, temp2, label: U8;
+    delay_frame: U16;
+    c: Character;
+    frame_interlaced: Boolean;
+    frame_transparency: Boolean:= False;
+    local_palette  : Boolean;
+    --
+    separator :  Character ;
+    -- Colour information
+    new_num_of_colours : Natural;
+    pixel_mask : U32;
+    BitsPerPixel  : Natural;
+
+  begin -- Load
+    next_frame:= 0.0;
+    -- Scan various GIF blocks, until finding an image
+    loop
+      Get_Byte(image.buffer, temp);
+      separator:= Character'Val(temp);
+      if full_trace then
+        Ada.Text_IO.Put(
+          "GIF separator [" & separator &
+          "][" & U8'Image(temp) & ']'
+        );
+      end if;
+      case separator is
+        when ',' => -- 16#2C#
+          exit;
+          -- Image descriptor will begin
+          -- See: 20. Image Descriptor
+        when ';' => -- 16#3B#
+          if full_trace then
+            Ada.Text_IO.Put(" - End of GIF");
+          end if;
+          image.next_frame:= 0.0;
+          next_frame:= image.next_frame;
+          return; -- End of GIF image
+        when '!' => -- 16#21# Extensions
+          if full_trace then
+            Ada.Text_IO.Put(" - Extension");
+          end if;
+          Get_Byte(image.buffer, label );
+          case label is
+            when 16#F9# => -- See: 23. Graphic Control Extension
+              if full_trace then
+                Ada.Text_IO.Put_Line(" - Graphic Control Extension");
+              end if;
+              Get_Byte(image.buffer, temp );
+              if temp /= 4 then
+                Raise_Exception(
+                  error_in_image_data'Identity,
+                  "GIF: error in Graphic Control Extension"
+                );
+              end if;
+              Get_Byte(image.buffer, temp );
+              --  Reserved                      3 Bits
+              --  Disposal Method               3 Bits
+              --  User Input Flag               1 Bit
+              --  Transparent Color Flag        1 Bit
+              frame_transparency:= (temp and 1) = 1;
+              Read_Intel(image.buffer, delay_frame);
+              image.next_frame:=
+                image.next_frame + Ada.Calendar.Day_Duration(delay_frame) / 100.0;
+              next_frame:= image.next_frame;
+              Get_Byte(image.buffer, temp );
+              Transp_color:= Color_Type(temp);
+              -- zero sub-block:
+              Get_Byte(image.buffer, temp );
+            when 16#FE# => -- See: 24. Comment Extension
+              if full_trace then
+                Ada.Text_IO.Put_Line(" - Comment Extension");
+                sub_blocks_sequence:
+                loop
+                  Get_Byte(image.buffer, temp ); -- load sub-block length byte
+                  exit sub_blocks_sequence when temp = 0;
+                  -- null sub-block = end of sub-block sequence
+                  for i in 1..temp loop
+                    Get_Byte(image.buffer, temp2);
+                    c:= Character'Val(temp2);
+                    Ada.Text_IO.Put(c);
+                  end loop;
+                end loop sub_blocks_sequence;
+                Ada.Text_IO.New_Line;
+              else
+                Skip_sub_blocks;
+              end if;
+            when 16#01# => -- See: 25. Plain Text Extension
+              if full_trace then
+                Ada.Text_IO.Put_Line(" - Plain Text Extension");
+              end if;
+              Skip_sub_blocks;
+            when 16#FF# => -- See: 26. Application Extension
+              if full_trace then
+                Ada.Text_IO.Put_Line(" - Application Extension");
+              end if;
+              Skip_sub_blocks;
+            when others =>
+              if full_trace then
+                Ada.Text_IO.Put_Line(" - Unused:" & U8'Image(label));
+              end if;
+              Skip_sub_blocks;
+          end case;
+        when others =>
+          Raise_Exception(
+            error_in_image_data'Identity,
+            "Unknown GIF separator: " & separator
+          );
+      end case;
+    end loop;
+
+    -- Load the image descriptor
+    Read_Intel(image.buffer, Descriptor.ImageLeft);
+    Read_Intel(image.buffer, Descriptor.ImageTop);
+    Read_Intel(image.buffer, Descriptor.ImageWidth);
+    Read_Intel(image.buffer, Descriptor.ImageHeight);
+    Get_Byte(image.buffer, Descriptor.Depth);
+
+    -- Get image corner coordinates
+    tlX := Natural(Descriptor.ImageLeft);
+    tlY := Natural(Descriptor.ImageTop);
+    brX := tlX + Natural(Descriptor.ImageWidth);
+    brY := tlY + Natural(Descriptor.ImageHeight);
+
+    --  Local Color Table Flag        1 Bit
+    --  Interlace Flag                1 Bit
+    --  Sort Flag                     1 Bit
+    --  Reserved                      2 Bits
+    --  Size of Local Color Table     3 Bits
+    --
+    frame_interlaced:= (Descriptor.Depth and 64) = 64;
+    local_palette:= (Descriptor.Depth and 128) = 128;
+    local.format:= GIF;
+    local.stream:= image.stream;
+    local.buffer:= image.buffer;
+    if local_palette then
+      -- Get amount of colours in image
+      BitsPerPixel := 1 + Natural(Descriptor.Depth and 7);
+      New_num_of_colours:= 2 ** BitsPerPixel;
+      -- 21. Local Color Table
+      local.palette:= new Color_table(0..New_num_of_colours-1);
+      Color_tables.Load_palette(local);
+      image.buffer:= local.buffer;
+    elsif image.palette = null then
+      Raise_Exception(
+        error_in_image_data'Identity,
+        "GIF: neither local, nor global palette"
+      );
+    else
+      -- Use global palette
+      New_num_of_colours:= 2 ** image.subformat_id;
+      -- usually <= 2** image.bits_per_pixel
+      -- Just copy main palette
+      local.palette:= new Color_table'(image.palette.all);
+    end if;
+    Pixel_mask:= U32(New_num_of_colours - 1);
+
+    if full_trace then
+      Ada.Text_IO.Put_Line(
+        " - Image, interlaced: " & Boolean'Image(frame_interlaced) &
+        "; local palette: " & Boolean'Image(local_palette) &
+        "; transparency: " & Boolean'Image(frame_transparency) &
+        "; transparency index:" & Color_type'Image(Transp_color)
+      );
+    end if;
+
+    -- Get initial code size
+    Get_Byte(image.buffer, temp );
+    if Natural(temp) not in Code_size_range then
+      Raise_Exception(
+        error_in_image_data'Identity,
+        "GIF: wrong LZW code size (must be in 2..12), is" &
+        U8'Image(temp)
+      );
+    end if;
+    CurrSize := Natural(temp);
+
+    -- Start at top left of image
+    X := Natural(Descriptor.ImageLeft);
+    Y := Natural(Descriptor.ImageTop);
+    Set_X_Y(X, image.height - Y - 1);
+    --
+    if new_num_of_colours < 256 then
+      -- "Rare" formats -> no need of best speed
+      declare
+        -- We create an instance with dynamic parameters
+        procedure GIF_Decode_general is
+          new GIF_Decode(frame_interlaced, frame_transparency, pixel_mask);
+      begin
+        GIF_Decode_general;
+      end;
+    else
+      -- 8 bit, usual format: we try to make things
+      -- faster with specialized instanciations...
+      if frame_interlaced then
+        if frame_transparency then
+          GIF_Decode_interlaced_transparent_8;
+        else
+          GIF_Decode_interlaced_opaque_8;
+        end if;
+      else -- straight (non-interlaced)
+        if frame_transparency then
+          GIF_Decode_straight_transparent_8;
+        else
+          GIF_Decode_straight_opaque_8;
+        end if;
+      end if;
+    end if;
+    Feedback(100);
+    --
+    Get_Byte(image.buffer, temp ); -- zero-size sub-block
+  end Load;
+
+end GID.Decoding_GIF;

3-mid/opengl/private/gid/gid-decoding_gif.ads

@@ -0,0 +1,22 @@
+private package GID.Decoding_GIF is
+
+  --------------------
+  -- Image decoding --
+  --------------------
+
+  generic
+    type Primary_color_range is mod <>;
+    with procedure Set_X_Y (x, y: Natural);
+    with procedure Put_Pixel (
+      red, green, blue : Primary_color_range;
+      alpha            : Primary_color_range
+    );
+    with procedure Feedback (percents: Natural);
+    mode: Display_mode;
+  --
+  procedure Load (
+    image     : in out Image_descriptor;
+    next_frame:    out Ada.Calendar.Day_Duration
+  );
+
+end GID.Decoding_GIF;

3-mid/opengl/private/gid/gid-decoding_jpg.ads

@@ -0,0 +1,89 @@
+private package GID.Decoding_JPG is
+
+  use JPEG_defs;
+
+  type JPEG_marker is
+  (
+    SOI      , --  Start Of Image
+    --
+    SOF_0    , --  Start Of Frame - Baseline DCT
+    SOF_1    , --  Extended sequential DCT
+    SOF_2    , --  Progressive DCT
+    SOF_3    , --  Lossless (sequential)
+    SOF_5    , --  Differential sequential DCT
+    SOF_6    , --  Differential progressive DCT
+    SOF_7    , --  Differential lossless (sequential)
+    SOF_8    , --  Reserved for JPEG extensions
+    SOF_9    , --  Extended sequential DCT
+    SOF_10   , --  Progressive DCT
+    SOF_11   , --  Lossless (sequential)
+    SOF_13   , --  Differential sequential DCT
+    SOF_14   , --  Differential progressive DCT
+    SOF_15   , --  Differential lossless (sequential)
+    --
+    DHT      , --  Define Huffman Table
+    DAC      , --  Define Arithmetic Coding
+    DQT      , --  Define Quantization Table
+    DRI      , --  Define Restart Interval
+    --
+    APP_0    , --  JFIF - JFIF JPEG image - AVI1 - Motion JPEG (MJPG)
+    APP_1    , --  EXIF Metadata, TIFF IFD format, JPEG Thumbnail (160x120)
+    APP_2    , --  ICC color profile, FlashPix
+    APP_3    ,
+    APP_4    ,
+    APP_5    ,
+    APP_6    ,
+    APP_7    ,
+    APP_8    ,
+    APP_9    ,
+    APP_10   ,
+    APP_11   ,
+    APP_12   , --  Picture Info
+    APP_13   , --  Photoshop Save As: IRB, 8BIM, IPTC
+    APP_14   , --  Copyright Entries
+    --
+    COM      , --  Comments
+    SOS      , --  Start of Scan
+    EOI        --  End of Image
+  );
+
+  YCbCr_set : constant Compo_set:= (Y|Cb|Cr => True, others => False);
+  Y_Grey_set: constant Compo_set:= (Y => True, others => False);
+  CMYK_set  : constant Compo_set:= (Y|Cb|Cr|I => True, others => False);
+
+  type Segment_head is record
+    length : U16;
+    kind   : JPEG_marker;
+  end record;
+
+  procedure Read(image: in out Image_descriptor; sh: out Segment_head);
+
+  -- SOF - Start Of Frame (the real header)
+  procedure Read_SOF(image: in out Image_descriptor; sh: Segment_head);
+
+  procedure Read_DHT(image: in out Image_descriptor; data_length: Natural);
+  procedure Read_DQT(image: in out Image_descriptor; data_length: Natural);
+  procedure Read_DRI(image: in out Image_descriptor);
+
+  procedure Read_EXIF(image: in out Image_descriptor; data_length: Natural);
+
+  --------------------
+  -- Image decoding --
+  --------------------
+
+  generic
+    type Primary_color_range is mod <>;
+    with procedure Set_X_Y (x, y: Natural);
+    with procedure Put_Pixel (
+      red, green, blue : Primary_color_range;
+      alpha            : Primary_color_range
+    );
+    with procedure Feedback (percents: Natural);
+    -- mode: Display_mode; -- nice -> progressive nicely displayed
+  --
+  procedure Load (
+    image     : in out Image_descriptor;
+    next_frame:    out Ada.Calendar.Day_Duration
+  );
+
+end GID.Decoding_JPG;

3-mid/opengl/private/gid/gid-decoding_png-huffman.adb

@@ -0,0 +1,367 @@
+with Ada.Text_IO;
+with Ada.Unchecked_Deallocation;
+
+package body GID.Decoding_PNG.Huffman is
+
+  procedure Build(t: out Huff_tree; descr: in Huff_descriptor) is
+    curr, alloc: Natural;
+    code, mask: Unsigned_32;
+  begin
+    alloc:= root;
+    for i in descr'Range loop
+      if descr(i).length > 0 then
+        curr:= root;
+        code:= Unsigned_32(descr(i).code);
+        mask:= Shift_Left(Unsigned_32'(1), descr(i).length-1);
+        for j in 0..descr(i).length-1 loop
+          if (code and mask) /= 0 then
+            if t.node(curr).one = nil then
+              alloc:= alloc + 1;
+              t.node(curr).one:= alloc;
+            end if;
+            curr:= t.node(curr).one;
+          else
+            if t.node(curr).zero = nil then
+              alloc:= alloc + 1;
+              t.node(curr).zero:= alloc;
+            end if;
+            curr:= t.node(curr).zero;
+          end if;
+          mask:= Shift_Right(mask, 1);
+        end loop;
+        t.node(curr).n:= i;
+      end if;
+    end loop;
+    t.last:= alloc;
+  end Build;
+
+  -- Free huffman tables starting with table where t points to
+
+  procedure HufT_free ( tl: in out p_Table_list ) is
+
+    procedure  Dispose is new
+      Ada.Unchecked_Deallocation( HufT_table, p_HufT_table );
+    procedure  Dispose is new
+      Ada.Unchecked_Deallocation( Table_list, p_Table_list );
+
+    current: p_Table_list;
+    tcount : Natural; -- just a stat. Idea: replace table_list with an array
+    tot_length: Natural;
+
+  begin
+    if full_trace then
+      Ada.Text_IO.Put("[HufT_Free... ");
+      tcount:= 0;
+      tot_length:= 0;
+    end if;
+    while tl /= null loop
+      if full_trace then
+        tcount:= tcount+1;
+        tot_length:= tot_length + tl.table'Length;
+      end if;
+      Dispose( tl.table ); -- destroy the Huffman table
+      current:= tl;
+      tl     := tl.next;
+      Dispose( current );  -- destroy the current node
+    end loop;
+    if full_trace then
+      Ada.Text_IO.Put_Line(
+        Integer'Image(tcount)& " tables, of" &
+        Integer'Image(tot_length)& " tot. length]"
+      );
+    end if;
+  end HufT_free;
+
+  -- Build huffman table from code lengths given by array b
+
+  procedure HufT_build ( b    : Length_array;
+                         s    : Integer;
+                         d, e : Length_array;
+                         tl   :    out p_Table_list;
+                         m    : in out Integer;
+              huft_incomplete :    out Boolean)
+  is
+    b_max  : constant:= 16;
+    b_maxp1: constant:= b_max + 1;
+
+    -- bit length count table
+    count : array( 0 .. b_maxp1 ) of Integer:= (others=> 0);
+
+    f   : Integer;                    -- i repeats in table every f entries
+    g   : Integer;                    -- max. code length
+    i,                                -- counter, current code
+      j : Integer;                    -- counter
+    kcc : Integer;                    -- number of bits in current code
+
+    c_idx, v_idx: Natural;            -- array indices
+
+    current_table_ptr : p_HufT_table:= null;
+    current_node_ptr  : p_Table_list:= null; -- curr. node for the curr. table
+    new_node_ptr      : p_Table_list;        -- new node for the new table
+
+    new_entry: HufT;                  -- table entry for structure assignment
+
+    u : array( 0..b_max ) of p_HufT_table;   -- table stack
+
+    n_max : constant:= 288;
+    -- values in order of bit length
+    v : array( 0..n_max ) of Integer:= (others=> 0);
+    el_v, el_v_m_s: Integer;
+
+    w : Natural:= 0;                        -- bits before this table
+
+    offset, code_stack : array( 0..b_maxp1 ) of Integer;
+
+    table_level : Integer:= -1;
+    bits : array( Integer'(-1)..b_maxp1 ) of Integer;
+    -- ^bits(table_level) = # bits in table of level table_level
+
+    y  : Integer;                     -- number of dummy codes added
+    z  : Natural:= 0;                 -- number of entries in current table
+    el : Integer;                     -- length of eob code=code 256
+
+    no_copy_length_array: constant Boolean:= d'Length=0 or e'Length=0;
+
+  begin
+    if full_trace then
+      Ada.Text_IO.Put("[HufT_Build...");
+    end if;
+    tl:= null;
+
+    if b'Length > 256 then -- set length of EOB code, if any
+      el := b(256);
+    else
+      el := b_max;
+    end if;
+
+    -- Generate counts for each bit length
+
+    for k in b'Range loop
+      if b(k) > b_max then
+        -- m := 0; -- GNAT 2005 doesn't like it (warning).
+        raise huft_error;
+      end if;
+      count( b(k) ):= count( b(k) ) + 1;
+    end loop;
+
+    if count(0) = b'Length then
+      m := 0;
+      huft_incomplete:= False; -- spotted by Tucker Taft, 19-Aug-2004
+      return; -- complete
+    end if;
+
+    -- Find minimum and maximum length, bound m by those
+
+    j := 1;
+    while j <= b_max and then count(j) = 0 loop
+      j:= j + 1;
+    end loop;
+    kcc := j;
+    if m < j then
+      m := j;
+    end if;
+    i := b_max;
+    while i > 0 and then count(i) = 0 loop
+      i:= i - 1;
+    end loop;
+    g := i;
+    if m > i then
+      m := i;
+    end if;
+
+    -- Adjust last length count to fill out codes, if needed
+
+    y := Integer( Shift_Left(Unsigned_32'(1), j) ); -- y:= 2 ** j;
+    while j < i loop
+      y := y - count(j);
+      if y < 0 then
+        raise huft_error;
+      end if;
+      y:= y * 2;
+      j:= j + 1;
+    end loop;
+
+    y:= y - count(i);
+    if y < 0 then
+      raise huft_error;
+    end if;
+    count(i):= count(i) + y;
+
+    -- Generate starting offsets into the value table for each length
+
+    offset(1) := 0;
+    j:= 0;
+    for idx in 2..i loop
+      j:= j + count( idx-1 );
+      offset( idx ) := j;
+    end loop;
+
+    -- Make table of values in order of bit length
+
+    for idx in b'Range loop
+      j := b(idx);
+      if j /= 0 then
+        v( offset(j) ) := idx-b'First;
+        offset(j):= offset(j) + 1;
+      end if;
+    end loop;
+
+    -- Generate huffman codes and for each, make the table entries
+
+    code_stack(0) := 0;
+    i := 0;
+    v_idx:= v'First;
+    bits(-1) := 0;
+
+    -- go through the bit lengths (kcc already is bits in shortest code)
+    for k in kcc .. g loop
+
+      for am1 in reverse 0 .. count(k)-1 loop -- a counts codes of length k
+
+        -- here i is the huffman code of length k bits for value v(v_idx)
+        while k > w + bits(table_level) loop
+
+          w:= w + bits(table_level);    -- Length of tables to this position
+          table_level:= table_level+ 1;
+          z:= g - w;                    -- Compute min size table <= m bits
+          if z > m then
+            z := m;
+          end if;
+          j := k - w;
+          f := Integer(Shift_Left(Unsigned_32'(1), j)); -- f:= 2 ** j;
+          if f > am1 + 2 then   -- Try a k-w bit table
+            f:= f - (am1 + 2);
+            c_idx:= k;
+            loop              -- Try smaller tables up to z bits
+              j:= j + 1;
+              exit when j >= z;
+              f := f * 2;
+              c_idx:= c_idx + 1;
+              exit when f - count(c_idx) <= 0;
+              f:= f - count(c_idx);
+            end loop;
+          end if;
+
+          if w + j > el and then  w < el  then
+            j:= el - w;       -- Make EOB code end at table
+          end if;
+          if w = 0 then
+            j := m;  -- Fix: main table always m bits!
+          end if;
+          z:= Integer(Shift_Left(Unsigned_32'(1), j)); -- z:= 2 ** j;
+          bits(table_level) := j;
+
+          -- Allocate and link new table
+
+          begin
+            current_table_ptr := new HufT_table ( 0..z );
+            new_node_ptr      := new Table_list'( current_table_ptr, null );
+          exception
+            when Storage_Error =>
+              raise huft_out_of_memory;
+          end;
+
+          if current_node_ptr = null then -- first table
+            tl:= new_node_ptr;
+          else
+            current_node_ptr.next:= new_node_ptr;   -- not my first...
+          end if;
+
+          current_node_ptr:= new_node_ptr; -- always non-Null from there
+
+          u( table_level ):= current_table_ptr;
+
+          -- Connect to last table, if there is one
+
+          if table_level > 0 then
+            code_stack(table_level) := i;
+            new_entry.bits          := bits(table_level-1);
+            new_entry.extra_bits    := 16 + j;
+            new_entry.next_table    := current_table_ptr;
+
+            j :=  Integer(
+              Shift_Right( Unsigned_32(i) and
+                (Shift_Left(Unsigned_32'(1), w) - 1 ),
+                w - bits(table_level-1) )
+              );
+
+            -- Test against bad input!
+
+            if j > u( table_level - 1 )'Last then
+              raise huft_error;
+            end if;
+            u( table_level - 1 ) (j) := new_entry;
+          end if;
+
+        end loop;
+
+        -- Set up table entry in new_entry
+
+        new_entry.bits      := k - w;
+        new_entry.next_table:= null;   -- Unused
+
+        if v_idx >= b'Length then
+          new_entry.extra_bits := invalid;
+        else
+          el_v:= v(v_idx);
+          el_v_m_s:= el_v - s;
+          if el_v_m_s < 0 then -- Simple code, raw value
+            if el_v < 256 then
+              new_entry.extra_bits:= 16;
+            else
+              new_entry.extra_bits:= 15;
+            end if;
+            new_entry.n := el_v;
+          else                    -- Non-simple -> lookup in lists
+            if no_copy_length_array then
+              raise huft_error;
+            end if;
+            new_entry.extra_bits := e( el_v_m_s );
+            new_entry.n          := d( el_v_m_s );
+          end if;
+          v_idx:= v_idx + 1;
+        end if;
+
+        -- fill code-like entries with new_entry
+        f := Integer( Shift_Left( Unsigned_32'(1) , k - w ));
+        -- i.e. f := 2 ** (k-w);
+        j := Integer( Shift_Right( Unsigned_32(i), w ) );
+        while j < z loop
+          current_table_ptr(j) := new_entry;
+          j:= j + f;
+        end loop;
+
+        -- backwards increment the k-bit code i
+        j := Integer( Shift_Left( Unsigned_32'(1) , k - 1 ));
+        -- i.e.: j:= 2 ** (k-1)
+        while ( Unsigned_32(i) and Unsigned_32(j) ) /= 0 loop
+          i := Integer( Unsigned_32(i) xor Unsigned_32(j) );
+          j :=  j / 2;
+        end loop;
+        i := Integer( Unsigned_32(i) xor Unsigned_32(j) );
+
+        -- backup over finished tables
+        while
+          Integer(Unsigned_32(i) and (Shift_Left(1, w)-1)) /=
+          code_stack(table_level)
+        loop
+          table_level:= table_level - 1;
+          w:= w - bits(table_level); -- Size of previous table!
+        end loop;
+
+      end loop;  -- am1
+    end loop;  -- k
+
+    if full_trace then
+      Ada.Text_IO.Put_Line("finished]");
+    end if;
+
+    huft_incomplete:= y /= 0 and g /= 1;
+
+  exception
+    when others =>
+      HufT_free( tl );
+      raise;
+  end HufT_build;
+
+end GID.Decoding_PNG.Huffman;

3-mid/opengl/private/gid/gid-decoding_png-huffman.ads

@@ -0,0 +1,88 @@
+-- GID.Decoding_PNG.Huffman
+---------------------------
+-- Huffman tree generation and deletion.
+-- Copy of UnZip.Decompress.Huffman
+
+private package GID.Decoding_PNG.Huffman is
+
+  -- Variants A and B.
+
+  -- A/ Simplistic huffman trees, pointerless
+
+  type Length_code_pair is record
+    length: Natural;
+    code  : Natural;
+  end record;
+
+  type Huff_descriptor is array(Natural range <>) of Length_code_pair;
+
+  nil: constant:= 0;
+  root: constant:= 1;
+
+  type Huff_node is record
+    n: Natural; -- value
+    zero, one: Natural:= nil; -- index of next node, if any
+  end record;
+
+  max_size: constant:= 800;
+
+  type Huff_node_list is array(1..max_size) of Huff_node;
+
+  type Huff_tree is record
+    last: Natural:= nil;
+    node: Huff_node_list;
+  end record;
+
+  procedure Build(t: out Huff_tree; descr: in Huff_descriptor);
+
+  -- B/ Huffman tables: several steps in the binary tree
+  -- in one jump.
+  -- Pro: probably faster
+  -- Contra: complicated, relies on pointers, large data.
+
+  type HufT_table;
+  type p_HufT_table is access HufT_table;
+
+  invalid: constant:= 99; -- invalid value for extra bits
+
+  type HufT is record
+    extra_bits : Natural:= invalid;
+    bits       : Natural;
+    n          : Natural;
+    next_table : p_HufT_table:= null;
+  end record;
+
+  type HufT_table is array( Integer range <> ) of aliased HufT;
+
+  type p_HufT is access all HufT;
+
+  -- Linked list just for destroying Huffman tables
+
+  type Table_list;
+  type p_Table_list is access Table_list;
+
+  type Table_list is record
+    table: p_HufT_table;
+    next : p_Table_list;
+  end record;
+
+  type Length_array is array(Integer range <>) of Natural;
+
+  empty : constant Length_array( 1..0 ):= ( others=> 0 );
+
+  -- Free huffman tables starting with table where t points to
+  procedure HufT_free ( tl: in out p_Table_list );
+
+  -- Build huffman table from code lengths given by array b.all
+  procedure HufT_build ( b    : Length_array;
+                         s    : Integer;
+                         d, e : Length_array;
+                         tl   :    out p_Table_list;
+                         m    : in out Integer;
+              huft_incomplete :    out Boolean);
+
+  -- Possible exceptions occuring in huft_build
+  huft_error,                    -- bad tree constructed
+  huft_out_of_memory: exception; -- not enough memory
+
+end GID.Decoding_PNG.Huffman;

3-mid/opengl/private/gid/gid-decoding_png.ads

@@ -0,0 +1,77 @@
+private package GID.Decoding_PNG is
+
+  type PNG_Chunk_tag is (
+    --
+    -- Critical chunks
+    --
+    IHDR, --    must be the first chunk; it contains the header.
+    PLTE, --    contains the palette; list of colors.
+    IDAT, --    contains the image, which may be split among multiple IDAT chunks.
+    IEND, --    marks the image end.
+    --
+    -- Ancillary chunks
+    --
+    bKGD, --    gives the default background color.
+    cHRM, --    gives the chromaticity coordinates of the display primaries and white point.
+    gAMA, --    specifies gamma.
+    hIST, --    can store the histogram, or total amount of each color in the image.
+    iCCP, --    is an ICC color profile.
+    iTXt, --    contains UTF-8 text, compressed or not, with an optional language tag.
+    pHYs, --    holds the intended pixel size and/or aspect ratio of the image.
+    sBIT, --    (significant bits) indicates the color-accuracy of the source data.
+    sPLT, --    suggests a palette to use if the full range of colors is unavailable.
+    sRGB, --    indicates that the standard sRGB color space is used.
+    tEXt, --    can store text that can be represented in ISO/IEC 8859-1.
+    tIME, --    stores the time that the image was last changed.
+    tRNS, --    contains transparency information.
+    zTXt, --    contains compressed text with the same limits as tEXt.
+    --
+    -- Public extentions
+    -- PNG Extensions and Register of Public Chunks and Keywords
+    --
+    oFFs, -- image offset from frame or page origin
+    pCAL, -- physical calibration of pixel values
+    sCAL, -- physical scale of image subject
+    sTER, -- stereographic subimage layout
+    gIFg, -- GIF Graphic Control Extension
+    gIFx, -- GIF Application Extension
+    fRAc, -- fractal image parameters
+    --
+    -- Private chunks (not defined in the ISO standard)
+    --
+    vpAg, --    used in ImageMagick to store "virtual page" size
+    spAL,
+    prVW,
+    cmOD,
+    cmPP,
+    cpIp,
+    mkBF,
+    mkBS,
+    mkBT,
+    mkTS,
+    pcLb
+  );
+
+  type Chunk_head is record
+    length: U32;
+    kind  : PNG_Chunk_tag;
+  end record;
+
+  procedure Read( image: in out image_descriptor; ch: out Chunk_head);
+
+  --------------------
+  -- Image decoding --
+  --------------------
+
+  generic
+    type Primary_color_range is mod <>;
+    with procedure Set_X_Y (x, y: Natural);
+    with procedure Put_Pixel (
+      red, green, blue : Primary_color_range;
+      alpha            : Primary_color_range
+    );
+    with procedure Feedback (percents: Natural);
+  --
+  procedure Load (image: in out Image_descriptor);
+
+end GID.Decoding_PNG;

3-mid/opengl/private/gid/gid-decoding_tga.adb

@@ -0,0 +1,283 @@
+with GID.Buffering;                     use GID.Buffering;
+with GID.Color_tables;
+
+package body GID.Decoding_TGA is
+
+  ----------
+  -- Load --
+  ----------
+
+  procedure Load (image: in out Image_descriptor) is
+
+    procedure Row_start(y: Natural) is
+    begin
+      if image.flag_1 then -- top first
+        Set_X_Y(0, image.height-1-y);
+      else
+        Set_X_Y(0, y);
+      end if;
+    end Row_Start;
+
+    -- Run Length Encoding --
+    RLE_pixels_remaining: Natural:= 0;
+    is_run_packet: Boolean;
+
+    type Pixel is record
+      color: RGB_Color;
+      alpha: U8;
+    end record;
+
+    pix, pix_mem: Pixel;
+
+    generic
+      bpp: Positive;
+      pal: Boolean;
+    procedure Get_pixel;
+    pragma Inline(Get_Pixel);
+    --
+    procedure Get_pixel is
+      idx: Natural;
+      p1, p2, c, d: U8;
+    begin
+      if pal then
+        if image.palette'Length <= 256 then
+          Get_Byte(image.buffer, p1);
+          idx:= Natural(p1);
+        else
+          Get_Byte(image.buffer, p1);
+          Get_Byte(image.buffer, p2);
+          idx:= Natural(p1) + Natural(p2) * 256;
+        end if;
+        idx:= idx + image.palette'First;
+        pix.color:= image.palette(idx);
+      else
+        case bpp is
+          when 32 => -- BGRA
+            Get_Byte(image.buffer, pix.color.blue);
+            Get_Byte(image.buffer, pix.color.green);
+            Get_Byte(image.buffer, pix.color.red);
+            Get_Byte(image.buffer, pix.alpha);
+          when 24 => -- BGR
+            Get_Byte(image.buffer, pix.color.blue);
+            Get_Byte(image.buffer, pix.color.green);
+            Get_Byte(image.buffer, pix.color.red);
+          when 16 | 15 => -- 5 bit per channel
+            Get_Byte(image.buffer,  c);
+            Get_Byte(image.buffer,  d);
+            Color_tables.Convert(c, d, pix.color);
+            if bpp=16 then
+              pix.alpha:= U8((U16(c and 128) * 255)/128);
+            end if;
+          when 8  => -- Gray
+            Get_Byte(image.buffer, pix.color.green);
+            pix.color.red:= pix.color.green;
+            pix.color.blue:= pix.color.green;
+          when others =>
+            null;
+        end case;
+      end if;
+    end Get_pixel;
+
+    generic
+      bpp: Positive;
+      pal: Boolean;
+    procedure RLE_Pixel;
+    pragma Inline(RLE_Pixel);
+    --
+    procedure RLE_Pixel is
+      tmp: U8;
+      procedure Get_pixel_for_RLE is new Get_pixel(bpp, pal);
+    begin
+      if RLE_pixels_remaining = 0 then -- load RLE code
+        Get_Byte(image.buffer, tmp );
+        Get_pixel_for_RLE;
+        RLE_pixels_remaining:= U8'Pos(tmp and 16#7F#);
+        is_run_packet:= (tmp and 16#80#) /= 0;
+        if is_run_packet then
+          pix_mem:= pix;
+        end if;
+      else
+        if is_run_packet then
+          pix:= pix_mem;
+        else
+          Get_pixel_for_RLE;
+        end if;
+        RLE_pixels_remaining:= RLE_pixels_remaining - 1;
+      end if;
+    end RLE_Pixel;
+
+    procedure RLE_pixel_32      is new RLE_pixel(32, False);
+    procedure RLE_pixel_24      is new RLE_pixel(24, False);
+    procedure RLE_pixel_16      is new RLE_pixel(16, False);
+    procedure RLE_pixel_15      is new RLE_pixel(15, False);
+    procedure RLE_pixel_8       is new RLE_pixel(8,  False);
+    procedure RLE_pixel_palette is new RLE_pixel(1,  True); -- 1: dummy
+
+    procedure Output_Pixel is
+    pragma Inline(Output_Pixel);
+    begin
+      case Primary_color_range'Modulus is
+        when 256 =>
+          Put_Pixel(
+            Primary_color_range(pix.color.red),
+            Primary_color_range(pix.color.green),
+            Primary_color_range(pix.color.blue),
+            Primary_color_range(pix.alpha)
+          );
+        when 65_536 =>
+          Put_Pixel(
+            16#101#  * Primary_color_range(pix.color.red),
+            16#101#  * Primary_color_range(pix.color.green),
+            16#101#  * Primary_color_range(pix.color.blue),
+            16#101#  * Primary_color_range(pix.alpha)
+            -- 16#101# because max intensity FF goes to FFFF
+          );
+        when others =>
+          raise invalid_primary_color_range;
+      end case;
+    end Output_Pixel;
+
+    procedure Get_RGBA is -- 32 bits
+      procedure Get_pixel_32 is new Get_pixel(32, False);
+    begin
+      for y in 0..image.height-1 loop
+        Row_start(y);
+        for x in 0..image.width-1 loop
+          Get_pixel_32;
+          Output_Pixel;
+        end loop;
+        Feedback(((y+1)*100)/image.height);
+      end loop;
+    end Get_RGBA;
+
+    procedure Get_RGB is -- 24 bits
+      procedure Get_pixel_24 is new Get_pixel(24, False);
+    begin
+      for y in 0..image.height-1 loop
+        Row_start(y);
+        for x in 0..image.width-1 loop
+          Get_pixel_24;
+          Output_Pixel;
+        end loop;
+        Feedback(((y+1)*100)/image.height);
+      end loop;
+    end Get_RGB;
+
+    procedure Get_16 is -- 16 bits
+      procedure Get_pixel_16 is new Get_pixel(16, False);
+    begin
+      for y in 0..image.height-1 loop
+        Row_start(y);
+        for x in 0..image.width-1 loop
+          Get_pixel_16;
+          Output_Pixel;
+        end loop;
+        Feedback(((y+1)*100)/image.height);
+      end loop;
+    end Get_16;
+
+    procedure Get_15 is -- 15 bits
+      procedure Get_pixel_15 is new Get_pixel(15, False);
+    begin
+      for y in 0..image.height-1 loop
+        Row_start(y);
+        for x in 0..image.width-1 loop
+          Get_pixel_15;
+          Output_Pixel;
+        end loop;
+        Feedback(((y+1)*100)/image.height);
+      end loop;
+    end Get_15;
+
+    procedure Get_Gray is
+      procedure Get_pixel_8  is new Get_pixel(8, False);
+    begin
+      for y in 0..image.height-1 loop
+        Row_start(y);
+        for x in 0..image.width-1 loop
+          Get_pixel_8;
+          Output_Pixel;
+        end loop;
+        Feedback(((y+1)*100)/image.height);
+      end loop;
+    end Get_Gray;
+
+    procedure Get_with_palette is
+      procedure Get_pixel_palette  is new Get_pixel(1, True); -- 1: dummy
+    begin
+      for y in 0..image.height-1 loop
+        Row_start(y);
+        for x in 0..image.width-1 loop
+          Get_pixel_palette;
+          Output_Pixel;
+        end loop;
+        Feedback(((y+1)*100)/image.height);
+      end loop;
+    end Get_with_palette;
+
+  begin
+    pix.alpha:= 255; -- opaque is default
+    Attach_Stream(image.buffer, image.stream);
+    --
+    if image.RLE_encoded then
+      -- One format check per row
+      RLE_pixels_remaining:= 0;
+      for y in 0..image.height-1 loop
+        Row_start(y);
+        if image.palette /= null then
+          for x in 0..image.width-1 loop
+            RLE_pixel_palette;
+            Output_Pixel;
+          end loop;
+        else
+          case image.bits_per_pixel is
+            when 32 =>
+              for x in 0..image.width-1 loop
+                RLE_Pixel_32;
+                Output_Pixel;
+              end loop;
+            when 24 =>
+              for x in 0..image.width-1 loop
+                RLE_Pixel_24;
+                Output_Pixel;
+              end loop;
+            when 16 =>
+              for x in 0..image.width-1 loop
+                RLE_Pixel_16;
+                Output_Pixel;
+              end loop;
+            when 15 =>
+              for x in 0..image.width-1 loop
+                RLE_Pixel_15;
+                Output_Pixel;
+              end loop;
+            when 8  =>
+              for x in 0..image.width-1 loop
+                RLE_Pixel_8;
+                Output_Pixel;
+              end loop;
+            when others => null;
+          end case;
+        end if;
+        Feedback(((y+1)*100)/image.height);
+      end loop;
+    elsif image.palette /= null then
+      Get_with_palette;
+    else
+      case image.bits_per_pixel is
+        when 32 =>
+          Get_RGBA;
+        when 24 =>
+          Get_RGB;
+        when 16 =>
+          Get_16;
+        when 15 =>
+          Get_15;
+        when 8  =>
+          Get_Gray;
+        when others => null;
+      end case;
+    end if;
+  end Load;
+
+end GID.Decoding_TGA;

3-mid/opengl/private/gid/gid-decoding_tga.ads

@@ -0,0 +1,18 @@
+private package GID.Decoding_TGA is
+
+  --------------------
+  -- Image decoding --
+  --------------------
+
+  generic
+    type Primary_color_range is mod <>;
+    with procedure Set_X_Y (x, y: Natural);
+    with procedure Put_Pixel (
+      red, green, blue : Primary_color_range;
+      alpha            : Primary_color_range
+    );
+    with procedure Feedback (percents: Natural);
+  --
+  procedure Load (image: in out Image_descriptor);
+
+end GID.Decoding_TGA;

3-mid/opengl/private/gid/gid-headers.adb

@@ -0,0 +1,584 @@
+---------------------------------
+-- GID - Generic Image Decoder --
+---------------------------------
+--
+-- Private child of GID, with helpers for identifying
+-- image formats and reading header informations.
+--
+
+with GID.Buffering,
+     GID.Color_tables,
+     GID.Decoding_JPG,
+     GID.Decoding_PNG;
+
+with Ada.Exceptions, Ada.Unchecked_Deallocation;
+
+package body GID.Headers is
+
+  use Ada.Exceptions;
+
+  -------------------------------------------------------
+  -- The very first: read signature to identify format --
+  -------------------------------------------------------
+
+  procedure Load_signature (
+    image   : in out Image_descriptor;
+    try_tga :        Boolean:= False
+
+  )
+  is
+    use Bounded_255;
+    c, d: Character;
+    FITS_challenge: String(1..5); -- without the initial
+    GIF_challenge : String(1..5); -- without the initial
+    PNG_challenge : String(1..7); -- without the initial
+    PNG_signature: constant String:=
+      "PNG" & ASCII.CR & ASCII.LF & ASCII.SUB & ASCII.LF;
+    procedure Dispose is
+      new Ada.Unchecked_Deallocation(Color_table, p_Color_table);
+  begin
+    -- Some cleanup
+    Dispose(image.palette);
+    image.next_frame:= 0.0;
+    image.display_orientation:= Unchanged;
+    --
+    Character'Read(image.stream, c);
+    image.first_byte:= Character'Pos(c);
+    case c is
+      when 'B' =>
+        Character'Read(image.stream, c);
+        if c='M' then
+          image.detailed_format:= To_Bounded_String("BMP");
+          image.format:= BMP;
+          return;
+        end if;
+      when 'S' =>
+        String'Read(image.stream, FITS_challenge);
+        if FITS_challenge = "IMPLE"  then
+          image.detailed_format:= To_Bounded_String("FITS");
+          image.format:= FITS;
+          return;
+        end if;
+      when 'G' =>
+        String'Read(image.stream, GIF_challenge);
+        if GIF_challenge = "IF87a" or GIF_challenge = "IF89a" then
+          image.detailed_format:= To_Bounded_String('G' & GIF_challenge & ", ");
+          image.format:= GIF;
+          return;
+        end if;
+      when 'I' | 'M' =>
+        Character'Read(image.stream, d);
+        if c=d then
+          if c = 'I' then
+            image.detailed_format:= To_Bounded_String("TIFF, little-endian");
+          else
+            image.detailed_format:= To_Bounded_String("TIFF, big-endian");
+          end if;
+          image.format:= TIFF;
+          return;
+        end if;
+      when Character'Val(16#FF#) =>
+        Character'Read(image.stream, c);
+        if c=Character'Val(16#D8#) then
+          -- SOI (Start of Image) segment marker (FFD8)
+          image.detailed_format:= To_Bounded_String("JPEG");
+          image.format:= JPEG;
+          return;
+        end if;
+      when Character'Val(16#89#) =>
+        String'Read(image.stream, PNG_challenge);
+        if PNG_challenge = PNG_signature  then
+          image.detailed_format:= To_Bounded_String("PNG");
+          image.format:= PNG;
+          return;
+        end if;
+      when others =>
+        if try_tga then
+          image.detailed_format:= To_Bounded_String("TGA");
+          image.format:= TGA;
+          return;
+        else
+          raise unknown_image_format;
+        end if;
+    end case;
+    raise unknown_image_format;
+  end Load_signature;
+
+  generic
+    type Number is mod <>;
+  procedure Read_Intel_x86_number(
+    from : in     Stream_Access;
+    n    :    out Number
+  );
+    pragma Inline(Read_Intel_x86_number);
+
+  generic
+    type Number is mod <>;
+  procedure Big_endian_number(
+    from : in out Input_buffer;
+    n    :    out Number
+  );
+    pragma Inline(Big_endian_number);
+
+  procedure Read_Intel_x86_number(
+    from : in     Stream_Access;
+    n    :    out Number
+  )
+  is
+    b: U8;
+    m: Number:= 1;
+  begin
+    n:= 0;
+    for i in 1..Number'Size/8 loop
+      U8'Read(from, b);
+      n:= n + m * Number(b);
+      m:= m * 256;
+    end loop;
+  end Read_Intel_x86_number;
+
+  procedure Big_endian_number(
+    from : in out Input_buffer;
+    n    :    out Number
+  )
+  is
+    b: U8;
+  begin
+    n:= 0;
+    for i in 1..Number'Size/8 loop
+      Buffering.Get_Byte(from, b);
+      n:= n * 256 + Number(b);
+    end loop;
+  end Big_endian_number;
+
+  procedure Read_Intel is new Read_Intel_x86_number( U16 );
+  procedure Read_Intel is new Read_Intel_x86_number( U32 );
+  procedure Big_endian is new Big_endian_number( U32 );
+
+  ----------------------------------------------------------
+  -- Loading of various format's headers (past signature) --
+  ----------------------------------------------------------
+
+  ----------------
+  -- BMP header --
+  ----------------
+
+  procedure Load_BMP_header (image: in out Image_descriptor) is
+    n, dummy: U32;
+    pragma Warnings(off, dummy);
+    w, dummy16: U16;
+    pragma Warnings(off, dummy16);
+  begin
+    --   Pos= 3, read the file size
+    Read_Intel(image.stream, dummy);
+    --   Pos= 7, read four bytes, unknown
+    Read_Intel(image.stream, dummy);
+    --   Pos= 11, read four bytes offset, file top to bitmap data.
+    --            For 256 colors, this is usually 36 04 00 00
+    Read_Intel(image.stream, dummy);
+    --   Pos= 15. The beginning of Bitmap information header.
+    --   Data expected:  28H, denoting 40 byte header
+    Read_Intel(image.stream, dummy);
+    --   Pos= 19. Bitmap width, in pixels.  Four bytes
+    Read_Intel(image.stream, n);
+    image.width:=  Natural(n);
+    --   Pos= 23. Bitmap height, in pixels.  Four bytes
+    Read_Intel(image.stream, n);
+    image.height:= Natural(n);
+    --   Pos= 27, skip two bytes.  Data is number of Bitmap planes.
+    Read_Intel(image.stream, dummy16); -- perform the skip
+    --   Pos= 29, Number of bits per pixel
+    --   Value 8, denoting 256 color, is expected
+    Read_Intel(image.stream, w);
+    case w is
+      when 1 | 4 | 8 | 24 =>
+        null;
+      when others =>
+        Raise_exception(
+          unsupported_image_subformat'Identity,
+          "bit depth =" & U16'Image(w)
+        );
+    end case;
+    image.bits_per_pixel:= Integer(w);
+    --   Pos= 31, read four bytes
+    Read_Intel(image.stream, n);          -- Type of compression used
+    -- BI_RLE8 = 1
+    -- BI_RLE4 = 2
+    if n /= 0 then
+      Raise_exception(
+        unsupported_image_subformat'Identity,
+        "RLE compression"
+      );
+    end if;
+    --
+    Read_Intel(image.stream, dummy); -- Pos= 35, image size
+    Read_Intel(image.stream, dummy); -- Pos= 39, horizontal resolution
+    Read_Intel(image.stream, dummy); -- Pos= 43, vertical resolution
+    Read_Intel(image.stream, n); -- Pos= 47, number of palette colors
+    if image.bits_per_pixel <= 8 then
+      if n = 0 then
+        image.palette:= new Color_Table(0..2**image.bits_per_pixel-1);
+      else
+        image.palette:= new Color_Table(0..Natural(n)-1);
+      end if;
+    end if;
+    Read_Intel(image.stream, dummy); -- Pos= 51, number of important colors
+    --   Pos= 55 (36H), - start of palette
+    Color_tables.Load_palette(image);
+  end Load_BMP_header;
+
+  procedure Load_FITS_header (image: in out Image_descriptor) is
+  begin
+    raise known_but_unsupported_image_format;
+  end Load_FITS_header;
+
+  ----------------
+  -- GIF header --
+  ----------------
+
+  procedure Load_GIF_header (image: in out Image_descriptor) is
+    -- GIF - logical screen descriptor
+    screen_width, screen_height          : U16;
+    packed, background, aspect_ratio_code : U8;
+    global_palette: Boolean;
+  begin
+    Read_Intel(image.stream, screen_width);
+    Read_Intel(image.stream, screen_height);
+    image.width:= Natural(screen_width);
+    image.height:= Natural(screen_height);
+    image.transparency:= True; -- cannot exclude transparency at this level.
+    U8'Read(image.stream, packed);
+    --  Global Color Table Flag       1 Bit
+    --  Color Resolution              3 Bits
+    --  Sort Flag                     1 Bit
+    --  Size of Global Color Table    3 Bits
+    global_palette:= (packed and 16#80#) /= 0;
+    image.bits_per_pixel:= Natural((packed and 16#7F#)/16#10#) + 1;
+    -- Indicative:
+    -- iv) [...] This value should be set to indicate the
+    --     richness of the original palette
+    U8'Read(image.stream, background);
+    U8'Read(image.stream, aspect_ratio_code);
+    Buffering.Attach_stream(image.buffer, image.stream);
+    if global_palette then
+      image.subformat_id:= 1+(Natural(packed and 16#07#));
+      -- palette's bits per pixels, usually <= image's
+      --
+      --  if image.subformat_id > image.bits_per_pixel then
+      --    Raise_exception(
+      --      error_in_image_data'Identity,
+      --      "GIF: global palette has more colors than the image" &
+      --       image.subformat_id'img & image.bits_per_pixel'img
+      --    );
+      --  end if;
+      image.palette:= new Color_Table(0..2**(image.subformat_id)-1);
+      Color_tables.Load_palette(image);
+    end if;
+  end Load_GIF_header;
+
+  -----------------
+  -- JPEG header --
+  -----------------
+
+  procedure Load_JPEG_header (image: in out Image_descriptor) is
+    -- http://en.wikipedia.org/wiki/JPEG
+    use GID.Decoding_JPG, GID.Buffering, Bounded_255;
+    sh: Segment_head;
+    b: U8;
+  begin
+    -- We have already passed the SOI (Start of Image) segment marker (FFD8).
+    image.JPEG_stuff.restart_interval:= 0;
+    Attach_stream(image.buffer, image.stream);
+    loop
+      Read(image, sh);
+      case sh.kind is
+        when DHT => -- Huffman Table
+          Read_DHT(image, Natural(sh.length));
+        when DQT =>
+          Read_DQT(image, Natural(sh.length));
+        when DRI => -- Restart Interval
+          Read_DRI(image);
+        when SOF_0 .. SOF_15 =>
+          Read_SOF(image, sh);
+          exit; -- we've got header-style informations, then it's time to quit
+        when APP_1 =>
+          Read_EXIF(image, Natural(sh.length));
+        when others =>
+          -- Skip segment data
+          for i in 1..sh.length loop
+            Get_Byte(image.buffer, b);
+          end loop;
+      end case;
+    end loop;
+  end Load_JPEG_header;
+
+  ----------------
+  -- PNG header --
+  ----------------
+
+  procedure Load_PNG_header (image: in out Image_descriptor) is
+    use Decoding_PNG, Buffering;
+    ch: Chunk_head;
+    n, dummy: U32;
+    pragma Warnings(off, dummy);
+    b, color_type: U8;
+    palette: Boolean:= False;
+  begin
+    Buffering.Attach_stream(image.buffer, image.stream);
+    Read(image, ch);
+    if ch.kind /= IHDR then
+      Raise_exception(
+        error_in_image_data'Identity,
+        "Expected 'IHDR' chunk as first chunk in PNG stream"
+      );
+    end if;
+    Big_endian(image.buffer, n);
+    if n = 0 then
+      Raise_exception(
+        error_in_image_data'Identity,
+        "PNG image with zero width"
+      );
+    end if;
+    image.width:=  Natural(n);
+    Big_endian(image.buffer, n);
+    if n = 0 then
+      Raise_exception(
+        error_in_image_data'Identity,
+        "PNG image with zero height"
+      );
+    end if;
+    image.height:= Natural(n);
+    Get_Byte(image.buffer, b);
+    image.bits_per_pixel:= Integer(b);
+    Get_Byte(image.buffer, color_type);
+    image.subformat_id:= Integer(color_type);
+    case color_type is
+      when 0 => -- Greyscale
+        image.greyscale:= True;
+        case image.bits_per_pixel is
+          when 1 | 2 | 4 | 8 | 16 =>
+            null;
+          when others =>
+            Raise_exception(
+              error_in_image_data'Identity,
+              "PNG, type 0 (greyscale): wrong bit-per-channel depth"
+            );
+        end case;
+      when 2 => -- RGB TrueColor
+        case image.bits_per_pixel is
+          when 8 | 16 =>
+            image.bits_per_pixel:= 3 * image.bits_per_pixel;
+          when others =>
+            Raise_exception(
+              error_in_image_data'Identity,
+              "PNG, type 2 (RGB): wrong bit-per-channel depth"
+            );
+        end case;
+      when 3 => -- RGB with palette
+        palette:= True;
+        case image.bits_per_pixel is
+          when 1 | 2 | 4 | 8 =>
+            null;
+          when others =>
+            Raise_exception(
+              error_in_image_data'Identity,
+              "PNG, type 3: wrong bit-per-channel depth"
+            );
+        end case;
+      when 4 => -- Grey & Alpha
+        image.greyscale:= True;
+        image.transparency:= True;
+        case image.bits_per_pixel is
+          when 8 | 16 =>
+            image.bits_per_pixel:= 2 * image.bits_per_pixel;
+          when others =>
+            Raise_exception(
+              error_in_image_data'Identity,
+              "PNG, type 4 (Greyscale & Alpha): wrong bit-per-channel depth"
+            );
+        end case;
+      when 6 => -- RGBA
+        image.transparency:= True;
+        case image.bits_per_pixel is
+          when 8 | 16 =>
+            image.bits_per_pixel:= 4 * image.bits_per_pixel;
+          when others =>
+            Raise_exception(
+              error_in_image_data'Identity,
+              "PNG, type 6 (RGBA): wrong bit-per-channel depth"
+            );
+        end case;
+      when others =>
+        Raise_exception(
+          error_in_image_data'Identity,
+          "Unknown PNG color type"
+        );
+    end case;
+    Get_Byte(image.buffer, b);
+    if b /= 0 then
+      Raise_exception(
+        error_in_image_data'Identity,
+        "Unknown PNG compression; ISO/IEC 15948:2003" &
+        " knows only 'method 0' (deflate)"
+      );
+    end if;
+    Get_Byte(image.buffer, b);
+    if b /= 0 then
+      Raise_exception(
+        error_in_image_data'Identity,
+        "Unknown PNG filtering; ISO/IEC 15948:2003 knows only 'method 0'"
+      );
+    end if;
+    Get_Byte(image.buffer, b);
+    image.interlaced:= b = 1; -- Adam7
+    Big_endian(image.buffer, dummy); -- Chunk's CRC
+    if palette then
+      loop
+        Read(image, ch);
+        case ch.kind is
+          when IEND =>
+            Raise_exception(
+              error_in_image_data'Identity,
+              "PNG: there must be a palette, found IEND"
+            );
+          when PLTE =>
+            if ch.length rem 3 /= 0 then
+              Raise_exception(
+                error_in_image_data'Identity,
+                "PNG: palette chunk byte length must be a multiple of 3"
+              );
+            end if;
+            image.palette:= new Color_Table(0..Integer(ch.length/3)-1);
+            Color_tables.Load_palette(image);
+            Big_endian(image.buffer, dummy); -- Chunk's CRC
+            exit;
+          when others =>
+            -- skip chunk data and CRC
+            for i in 1..ch.length + 4 loop
+              Get_Byte(image.buffer, b);
+            end loop;
+        end case;
+      end loop;
+    end if;
+  end Load_PNG_header;
+
+  ------------------------
+  -- TGA (Targa) header --
+  ------------------------
+
+  procedure Load_TGA_header (image: in out Image_descriptor) is
+    -- TGA FILE HEADER, p.6
+    --
+    image_ID_length: U8; -- Field 1
+    color_map_type : U8; -- Field 2
+    image_type     : U8; -- Field 3
+    -- Color Map Specification - Field 4
+    first_entry_index   : U16; -- Field 4.1
+    color_map_length    : U16; -- Field 4.2
+    color_map_entry_size: U8;  -- Field 4.3
+    -- Image Specification - Field 5
+    x_origin: U16;
+    y_origin: U16;
+    image_width: U16;
+    image_height: U16;
+    pixel_depth: U8;
+    tga_image_descriptor: U8;
+    --
+    dummy: U8;
+    base_image_type: Integer;
+  begin
+    -- Read the header
+    image_ID_length:= image.first_byte;
+    U8'Read(image.stream, color_map_type);
+    U8'Read(image.stream, image_type);
+    --   Color Map Specification - Field 4
+    Read_Intel(image.stream, first_entry_index);
+    Read_Intel(image.stream, color_map_length);
+    U8'Read(image.stream, color_map_entry_size);
+    --   Image Specification - Field 5
+    Read_Intel(image.stream, x_origin);
+    Read_Intel(image.stream, y_origin);
+    Read_Intel(image.stream, image_width);
+    Read_Intel(image.stream, image_height);
+    U8'Read(image.stream, pixel_depth);
+    U8'Read(image.stream, tga_image_descriptor);
+    -- Done.
+    --
+    -- Image type:
+    --      1 = 8-bit palette style
+    --      2 = Direct [A]RGB image
+    --      3 = grayscale
+    --      9 = RLE version of Type 1
+    --     10 = RLE version of Type 2
+    --     11 = RLE version of Type 3
+    --
+    base_image_type:= U8'Pos(image_type and 7);
+    image.RLE_encoded:= (image_type and 8) /= 0;
+    --
+    if color_map_type /= 0 then
+      image.palette:= new Color_Table(
+        Integer(first_entry_index)..
+        Integer(first_entry_index)+Integer(color_map_length)-1
+      );
+      image.subformat_id:= Integer(color_map_entry_size);
+      case image.subformat_id is -- = palette's bit depth
+        when 8 =>       -- Grey
+          null;
+        when 15 | 16 => -- RGB 3*5 bit | RGBA 3*3+1 bit
+          null;
+        when 24 | 32 => -- RGB 3*8 bit | RGBA 4*8 bit
+          null;
+        when others =>
+          Raise_exception(
+            error_in_image_data'Identity,
+            "TGA color map (palette): wrong bit depth:" &
+            Integer'Image(image.subformat_id)
+          );
+      end case;
+    end if;
+    --
+    image.greyscale:= False; -- ev. overridden later
+    case base_image_type is
+      when 1 =>
+        image.greyscale:= color_map_entry_size = 8;
+      when 2 =>
+        null;
+      when 3 =>
+        image.greyscale:= True;
+      when others =>
+        Raise_exception(
+          unsupported_image_subformat'Identity,
+          "TGA type =" & Integer'Image(base_image_type)
+        );
+    end case;
+
+    image.width  := U16'Pos(image_width);
+    image.height := U16'Pos(image_height);
+    image.bits_per_pixel := U8'Pos(pixel_depth);
+
+    -- Make sure we are loading a supported TGA_type
+    case image.bits_per_pixel is
+      when 32 | 24 | 16 | 15 | 8 =>
+        null;
+      when others =>
+        Raise_exception(
+          unsupported_image_subformat'Identity,
+          "TGA bits per pixels =" & Integer'Image(image.bits_per_pixel)
+        );
+    end case;
+    image.flag_1:= (tga_image_descriptor and 32) /= 0; -- top first
+    --  *** Image and color map data
+    --  * Image ID
+    for i in 1..image_ID_length loop
+      U8'Read( image.stream, dummy );
+    end loop;
+    --  * Color map data (palette)
+    Color_tables.Load_palette(image);
+    --  * Image data: Read by Load_image_contents.
+  end Load_TGA_header;
+
+  procedure Load_TIFF_header (image: in out Image_descriptor) is
+  begin
+    raise known_but_unsupported_image_format;
+  end Load_TIFF_header;
+
+end;

3-mid/opengl/private/gid/gid-headers.ads

@@ -0,0 +1,31 @@
+---------------------------------
+-- GID - Generic Image Decoder --
+---------------------------------
+--
+-- Private child of GID, with helpers for identifying
+-- image formats and reading header informations.
+--
+private package GID.Headers is
+
+  --
+  -- Crude image signature detection
+  --
+  procedure Load_signature (
+    image   : in out Image_descriptor;
+    try_tga :        Boolean:= False
+  );
+
+
+  --
+  -- Loading of various format's headers (past signature)
+  --
+
+  procedure Load_BMP_header (image: in out Image_descriptor);
+  procedure Load_FITS_header (image: in out Image_descriptor);
+  procedure Load_GIF_header (image: in out Image_descriptor);
+  procedure Load_JPEG_header (image: in out Image_descriptor);
+  procedure Load_PNG_header (image: in out Image_descriptor);
+  procedure Load_TGA_header (image: in out Image_descriptor);
+  procedure Load_TIFF_header (image: in out Image_descriptor);
+
+end;

3-mid/opengl/private/gid/gid.adb

@@ -0,0 +1,210 @@
+---------------------------------
+-- GID - Generic Image Decoder --
+---------------------------------
+--
+--  Copyright (c) Gautier de Montmollin 2010
+--
+--  Permission is hereby granted, free of charge, to any person obtaining a copy
+--  of this software and associated documentation files (the "Software"), to deal
+--  in the Software without restriction, including without limitation the rights
+--  to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+--  copies of the Software, and to permit persons to whom the Software is
+--  furnished to do so, subject to the following conditions:
+--
+--  The above copyright notice and this permission notice shall be included in
+--  all copies or substantial portions of the Software.
+--
+--  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+--  IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+--  FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+--  AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+--  LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+--  OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+--  THE SOFTWARE.
+--
+-- NB: this is the MIT License, as found 2-May-2010 on the site
+-- http://www.opensource.org/licenses/mit-license.php
+
+with GID.Headers,
+     GID.Decoding_BMP,
+     GID.Decoding_GIF,
+     GID.Decoding_JPG,
+     GID.Decoding_PNG,
+     GID.Decoding_TGA;
+
+with Ada.Unchecked_Deallocation;
+
+package body GID is
+
+  -----------------------
+  -- Load_image_header --
+  -----------------------
+
+  procedure Load_image_header (
+    image   :    out Image_descriptor;
+    from    : in out Ada.Streams.Root_Stream_Type'Class;
+    try_tga :        Boolean:= False
+  )
+  is
+  begin
+    image.stream:= from'Unchecked_Access;
+    Headers.Load_signature(image, try_tga);
+    case image.format is
+      when BMP =>
+        Headers.Load_BMP_header(image);
+      when FITS =>
+        Headers.Load_FITS_header(image);
+      when GIF =>
+        Headers.Load_GIF_header(image);
+      when JPEG =>
+        Headers.Load_JPEG_header(image);
+      when PNG =>
+        Headers.Load_PNG_header(image);
+      when TGA =>
+        Headers.Load_TGA_header(image);
+      when TIFF =>
+        Headers.Load_TIFF_header(image);
+    end case;
+  end Load_image_header;
+
+  -----------------
+  -- Pixel_width --
+  -----------------
+
+  function Pixel_width (image: Image_descriptor) return Positive is
+  begin
+    return image.width;
+  end Pixel_width;
+
+  ------------------
+  -- Pixel_height --
+  ------------------
+
+  function Pixel_height (image: Image_descriptor) return Positive is
+  begin
+    return image.height;
+  end Pixel_height;
+
+  function Display_orientation (image: Image_descriptor) return Orientation is
+  begin
+    return image.display_orientation;
+  end Display_orientation;
+
+  -------------------------
+  -- Load_image_contents --
+  -------------------------
+
+  procedure Load_image_contents (
+    image     : in out Image_descriptor;
+    next_frame:    out Ada.Calendar.Day_Duration
+  )
+  is
+    procedure BMP_Load is
+      new Decoding_BMP.Load( Primary_color_range, Set_X_Y, Put_Pixel, Feedback );
+
+    procedure GIF_Load is
+      new Decoding_GIF.Load( Primary_color_range, Set_X_Y, Put_Pixel, Feedback, mode );
+
+    procedure JPG_Load is
+      new Decoding_JPG.Load( Primary_color_range, Set_X_Y, Put_Pixel, Feedback );
+
+    procedure PNG_Load is
+      new Decoding_PNG.Load( Primary_color_range, Set_X_Y, Put_Pixel, Feedback );
+
+    procedure TGA_Load is
+      new Decoding_TGA.Load( Primary_color_range, Set_X_Y, Put_Pixel, Feedback );
+
+  begin
+    next_frame:= 0.0;
+    -- ^ value updated in case of animation and when
+    --   current frame is not the last frame
+    case image.format is
+      when BMP =>
+        BMP_Load(image);
+      when GIF =>
+        GIF_Load(image, next_frame);
+      when JPEG =>
+        JPG_Load(image, next_frame);
+      when PNG =>
+        PNG_Load(image);
+      when TGA =>
+        TGA_Load(image);
+      when others =>
+        raise known_but_unsupported_image_format;
+    end case;
+  end Load_image_contents;
+
+  ---------------------------------------
+  -- Some informations about the image --
+  ---------------------------------------
+
+  function Format (image: Image_descriptor) return Image_format_type is
+  begin
+    return image.format;
+  end Format;
+
+  function Detailed_format (image: Image_descriptor) return String is
+  begin
+    return Bounded_255.To_String(image.detailed_format);
+  end Detailed_format;
+
+  function Subformat (image: Image_descriptor) return Integer is
+  begin
+    return image.subformat_id;
+  end Subformat;
+
+  function Bits_per_pixel (image: Image_descriptor) return Positive is
+  begin
+    return image.bits_per_pixel;
+  end Bits_per_pixel;
+
+  function RLE_encoded (image: Image_descriptor) return Boolean is
+  begin
+    return image.RLE_encoded;
+  end RLE_encoded;
+
+  function Interlaced (image: Image_descriptor) return Boolean is
+  begin
+    return image.interlaced;
+  end Interlaced;
+
+  function Greyscale (image: Image_descriptor) return Boolean is
+  begin
+    return image.greyscale;
+  end Greyscale;
+
+  function Has_palette (image: Image_descriptor) return Boolean is
+  begin
+    return image.palette /= null;
+  end Has_palette;
+
+  function Expect_transparency (image: Image_descriptor) return Boolean is
+  begin
+    return image.transparency;
+  end Expect_transparency;
+
+  procedure Adjust (Object : in out Image_descriptor) is
+  begin
+    -- Clone the palette
+    Object.palette:= new Color_table'(Object.palette.all);
+  end Adjust;
+
+  procedure Finalize (Object : in out Image_descriptor) is
+    procedure Dispose is
+      new Ada.Unchecked_Deallocation(Color_table, p_Color_table);
+    procedure Dispose is
+      new Ada.Unchecked_Deallocation(
+        JPEG_defs.VLC_table,
+        JPEG_defs.p_VLC_table
+      );
+  begin
+    -- Deterministic garbage collection
+    Dispose(Object.palette);
+    for ad in JPEG_defs.VLC_defs_type'Range(1) loop
+      for idx in JPEG_defs.VLC_defs_type'Range(2) loop
+        Dispose(Object.JPEG_stuff.vlc_defs(ad, idx));
+      end loop;
+    end loop;
+  end Finalize;
+
+end GID;

3-mid/opengl/private/gid/gid.ads

@@ -0,0 +1,304 @@
+---------------------------------
+-- GID - Generic Image Decoder --
+---------------------------------
+--
+-- Purpose:
+--
+--   The Generic Image Decoder is a package for decoding a broad
+--   variety of image formats, from any data stream, to any kind
+--   of medium, be it an in-memory bitmap, a GUI object,
+--   some other stream, arrays of floating-point initial data
+--   for scientific calculations, a browser element, a device,...
+--   Animations are supported.
+--
+--   The code is unconditionally portable, independent of the
+--   choice of operating system, processor, endianess and compiler.
+--
+-- Image types currently supported:
+--
+--   BMP, GIF, JPEG, PNG, TGA
+--
+-- Credits:
+--
+--   - André van Splunter: GIF's LZW decoder
+--   - Martin J. Fiedler: most of the JPEG decoder (from NanoJPEG)
+--
+--   More credits in gid_work.xls, sheet "credits".
+--
+-- Copyright (c) Gautier de Montmollin 2010..2012
+--
+--  Permission is hereby granted, free of charge, to any person obtaining a copy
+--  of this software and associated documentation files (the "Software"), to deal
+--  in the Software without restriction, including without limitation the rights
+--  to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+--  copies of the Software, and to permit persons to whom the Software is
+--  furnished to do so, subject to the following conditions:
+--
+--  The above copyright notice and this permission notice shall be included in
+--  all copies or substantial portions of the Software.
+--
+--  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+--  IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+--  FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+--  AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+--  LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+--  OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+--  THE SOFTWARE.
+--
+-- NB: this is the MIT License, as found 2-May-2010 on the site
+-- http://www.opensource.org/licenses/mit-license.php
+
+with Ada.Calendar, Ada.Streams, Ada.Strings.Bounded, Ada.Finalization;
+with Interfaces;
+
+package GID is
+
+  type Image_descriptor is private;
+
+  ---------------------------------------------------
+  -- 1) Load the image header from the data stream --
+  ---------------------------------------------------
+
+  procedure Load_image_header (
+    image   :    out Image_descriptor;
+    from    : in out Ada.Streams.Root_Stream_Type'Class;
+    try_tga :        Boolean:= False
+  );
+
+  -- try_tga: if no known signature is found, assume it might be
+  -- the TGA format (which hasn't a signature) and try to load an
+  -- image of this format
+
+  unknown_image_format,
+  known_but_unsupported_image_format,
+  unsupported_image_subformat,
+  error_in_image_data,
+  invalid_primary_color_range: exception;
+
+  ----------------------------------------------------------------------
+  -- 2) If needed, use dimensions to prepare the retrieval of the     --
+  --    image, for instance: reserving an in-memory bitmap, sizing a  --
+  --    GUI object, defining a browser element, setting up a device   --
+  ----------------------------------------------------------------------
+
+  function Pixel_width (image: Image_descriptor) return Positive;
+  function Pixel_height (image: Image_descriptor) return Positive;
+
+  -- "Unchanged" orientation has origin at top left
+
+  type Orientation is (
+    Unchanged,
+    Rotation_90, Rotation_180, Rotation_270
+  );
+
+  function Display_orientation (image: Image_descriptor) return Orientation;
+
+  --------------------------------------------------------------------
+  -- 3) Load and decode the image itself. If the image is animated, --
+  --    call Load_image_contents until next_frame is 0.0            --
+  --------------------------------------------------------------------
+
+  type Display_mode is (fast, nice);
+  -- For bitmap pictures, the result is exactly the same, but
+  -- interlaced images' larger pixels are drawn in full during decoding.
+
+  generic
+    type Primary_color_range is mod <>;
+    -- Coding of primary colors (red, green or blue)
+    --   and of opacity (also known as alpha channel), on the target "device".
+    -- Currently, only 8-bit and 16-bit are admitted.
+    --    8-bit coding is usual: TrueColor, PC graphics, etc.;
+    --   16-bit coding is seen in some high-end apps/devices/formats.
+    --
+    with procedure Set_X_Y (x, y: Natural);
+    -- After Set_X_Y, next pixel is meant to be displayed at position (x,y)
+    with procedure Put_Pixel (
+      red, green, blue : Primary_color_range;
+      alpha            : Primary_color_range
+    );
+    -- When Put_Pixel is called twice without a Set_X_Y inbetween,
+    -- the pixel must be displayed on the next X position after the last one.
+    -- [ Rationale: if the image lands into an array with contiguous pixels
+    --   on the X axis, this approach allows full address calculation to be
+    --   made only at the beginning of each row, which is much faster ]
+    --
+    with procedure Feedback (percents: Natural);
+    --
+    mode: Display_mode;
+    --
+  procedure Load_image_contents (
+    image     : in out Image_descriptor;
+    next_frame:    out Ada.Calendar.Day_Duration
+      -- ^ animation: real time lapse foreseen between the first image
+      -- and the image right after this one; 0.0 if no next frame
+  );
+
+  -------------------------------------------------------------------
+  -- Some informations about the image, not necessary for decoding --
+  -------------------------------------------------------------------
+
+  type Image_format_type is
+    ( -- Bitmap formats
+      BMP, FITS, GIF, JPEG, PNG, TGA, TIFF
+    );
+
+  function Format (image: Image_descriptor) return Image_format_type;
+  function Detailed_format (image: Image_descriptor) return String;
+  -- example: "GIF89a, interlaced"
+  function Subformat (image: Image_descriptor) return Integer;
+  -- example the 'color type' in PNG
+
+  function Bits_per_pixel (image: Image_descriptor) return Positive;
+  function RLE_encoded (image: Image_descriptor) return Boolean;
+  function Interlaced (image: Image_descriptor) return Boolean;
+  function Greyscale (image: Image_descriptor) return Boolean;
+  function Has_palette (image: Image_descriptor) return Boolean;
+  function Expect_transparency (image: Image_descriptor) return Boolean;
+
+  --------------------------------------------------------------
+  -- Information about this package - e.g. for an "about" box --
+  --------------------------------------------------------------
+
+  version   : constant String:= "02";
+  reference : constant String:= "8-Sep-2012";
+  web: constant String:= "http://sf.net/projects/gen-img-dec/";
+  -- Hopefully the latest version is at that URL...
+
+private
+
+  use Interfaces;
+
+  subtype U8  is Unsigned_8;
+  subtype U16 is Unsigned_16;
+  subtype U32 is Unsigned_32;
+
+  package Bounded_255 is
+    new Ada.Strings.Bounded.Generic_Bounded_Length(255);
+
+  type Stream_Access is access all Ada.Streams.Root_Stream_Type'Class;
+
+  type RGB_color is record
+    red, green, blue : U8;
+  end record;
+
+  type Color_table is array (Integer range <>) of RGB_color;
+
+  type p_Color_table is access Color_table;
+
+  type Byte_array is array(Integer range <>) of U8;
+
+  type Input_buffer is record
+    data       : Byte_array(1..1024);
+    stream     : Stream_Access:= null;
+    InBufIdx   : Positive:= 1; --  Points to next char in buffer to be read
+    MaxInBufIdx: Natural := 0; --  Count of valid chars in input buffer
+    InputEoF   : Boolean;      --  End of file indicator
+  end record;
+  -- Initial values ensure call to Fill_Buffer on first Get_Byte
+
+  -- JPEG may store data _before_ any image header (SOF), then we have
+  -- to make the image descriptor store that information, alas...
+
+  package JPEG_defs is
+
+  type Component is
+    (Y,  -- brightness
+     Cb, -- hue
+     Cr, -- saturation
+     I,  -- ??
+     Q   -- ??
+    );
+
+  type QT is array(0..63) of Natural;
+  type QT_list is array(0..7) of QT;
+
+  type Compo_set is array(Component) of Boolean;
+
+  type Info_per_component_A is record -- B is defined inside the decoder
+    qt_assoc    : Natural;
+    samples_hor : Natural;
+    samples_ver : Natural;
+    up_factor_x : Natural; -- how much we must repeat horizontally
+    up_factor_y : Natural; -- how much we must repeat vertically
+    shift_x     : Natural; -- shift for repeating pixels horizontally
+    shift_y     : Natural; -- shift for repeating pixels vertically
+  end record;
+
+  type Component_info_A is array(Component) of Info_per_component_A;
+
+  type Supported_color_space is (
+    YCbCr,  -- 3-dim color space
+    Y_Grey, -- 1-dim greyscale
+    CMYK    -- 4-dim Cyan, Magenta, Yellow, blacK
+  );
+
+    type AC_DC is (AC, DC);
+
+    type VLC_code is record
+      bits, code: U8;
+    end record;
+
+    type VLC_table is array(0..65_535) of VLC_code;
+
+    type p_VLC_table is access VLC_table;
+
+    type VLC_defs_type is array(AC_DC, 0..7) of p_VLC_table;
+
+  end JPEG_defs;
+
+  type JPEG_stuff_type is record
+    components       : JPEG_defs.Compo_set:= (others => False);
+    color_space      : JPEG_defs.Supported_color_space;
+    info             : JPEG_defs.Component_info_A;
+    max_samples_hor  : Natural;
+    max_samples_ver  : Natural;
+    qt_list          : JPEG_defs.QT_list;
+    vlc_defs         : JPEG_defs.VLC_defs_type:= (others => (others => null));
+    restart_interval : Natural; -- predictor restarts every... (0: never)
+  end record;
+
+  type Image_descriptor is new Ada.Finalization.Controlled with record
+    format             : Image_format_type;
+    detailed_format    : Bounded_255.Bounded_String; -- for humans only!
+    subformat_id       : Integer:= 0;
+    width, height      : Positive;
+    display_orientation: Orientation;
+    bits_per_pixel     : Positive;
+    RLE_encoded        : Boolean:= False;
+    transparency       : Boolean:= False;
+    greyscale          : Boolean:= False;
+    interlaced         : Boolean:= False;
+    flag_1             : Boolean; -- format-specific information
+    JPEG_stuff         : JPEG_stuff_type;
+    stream             : Stream_Access;
+    buffer             : Input_buffer;
+    palette            : p_Color_table:= null;
+    first_byte         : U8;
+    next_frame         : Ada.Calendar.Day_Duration;
+  end record;
+
+  procedure Adjust (Object : in out Image_descriptor);
+  procedure Finalize (Object : in out Image_descriptor);
+
+  to_be_done: exception;
+  -- this exception should not happen, even with malformed files
+  -- its role is to pop up when a feature is set as implemented
+  -- but one aspect (e.g. palette) was forgotten.
+
+  --
+  -- Primitive tracing using Ada.Text_IO, for debugging,
+  -- or explaining internals.
+  --
+  type Trace_type is (
+    none,   -- No trace at all, no use of console from the library
+    some_t, -- Image / frame technical informations
+    full    -- Byte / pixel / compressed block details
+  );
+
+  trace: constant Trace_type:= none; -- <== Choice here
+
+  no_trace  : constant Boolean:= trace=none;
+  full_trace: constant Boolean:= trace=full;
+  some_trace: constant Boolean:= trace>=some_t;
+
+end GID;

3-mid/opengl/private/gid/gid.gpr

@@ -0,0 +1,12 @@
+-- This is a GNAT, GCC or GNAT Programming Studio (GPS) project file
+-- for the Generic Image Decoder ( http://sf.net/projects/gen-img-dec/ )
+-- Build me with "gnatmake -P gid.gpr", or open me with GPS
+--
+project GID is
+
+   for Source_Dirs use (".");
+   --   for Exec_Dir use "test";
+   --   for Main use ("tb.ads", "to_bmp.adb", "mini.adb");
+   for Object_Dir use "obj_debug";
+
+end GID;

3-mid/opengl/private/gid/gid.txt

@@ -0,0 +1,162 @@
+Generic Image Decoder
+---------------------
+The Generic Image Decoder (GID) is an Ada package for decoding a
+broad variety of image formats, from any data stream, to any kind
+of medium, be it an in-memory bitmap, a GUI object,
+some other stream, arrays of floating-point initial data
+for scientific calculations, a browser element, a device,...
+Animations are supported.
+
+Some features:
+- Standalone (no dependency on other libraires, bindings,...)
+- Unconditionally portable code: OS-, CPU-, compiler- independent code.
+- Multi-platform, but native code
+- Task safe
+- Endian-neutral
+- Free, open-source
+- pure Ada 95 (compiled by Ada 95, Ada 2005, and later compilers)
+
+Some possible applications:
+- image processing (interactive or not)
+- image analysis, text recognition
+- a drawing program
+- a web browser
+- use of images as data for simulations
+- thumbnail generation for a file manager
+
+Through the genericity and the use of the Inline pragma at multiple
+nesting levels (see it like macros inside macros), the package is
+able to deliver a decent decoding performance, keep a reasonably
+compact and readable source code, and avoid tediously copied
+pieces of code with almost the same contents corresponding to
+different subformats.
+
+Licensing, warranty, copyright, supported formats, authors, credits, history
+----------------------------------------------------------------------------
+Please read the top comments in gid.ads, and further details in gid_work.xls.
+
+Files
+-----
+gid.ads   GID package specification
+gid.adb   GID package body
+gid-*.ad* private packages for decoding specific
+            formats, reading headers,...
+
+To summarize, the gid*.ad* files are the whole GID source files. 
+For example, you can have a copy of those in a gid/ subdirectory
+in your project.
+
+gid.gpr             GNAT/GCC project file - to be opened with GPS or used
+                      with the command: gnatmake -P gid
+gid_objectada.prj   ObjectAda (7.2.2+) project file
+
+gid_work.xls        this workbook contains GID's history, a list of open
+                      bugs, technical informations about formats, etc.
+
+test/to_bmp.adb     middle-size command-line demo which converts all image
+                      files given as arguments (also works from a GUI file
+                      explorer with drag & drop) into BMP image files with
+                      the .dib extension. Typically, you put plenty of
+                      images into the test folder and launch "to_bmp *" to
+                      convert them all.
+test/mini.adb       small-size version of to_bmp; writes PPM files.
+
+test/tb*.ad*        wrappers for to_bmp, for obtaining trace-back
+
+How to use GID in your programs
+-------------------------------
+Hopefully the package specification (in the file gid.ads) is self
+explanatory enough. There are three steps needed:
+
+1) Load the image header from a data stream
+2) If needed, use dimensions to prepare the retrieval of the image
+3) Load and decode the image itself. If the image is animated,
+     call Load_image_contents until next_frame is 0.0
+
+The subprograms corresponding to these steps are
+1) Load_image_header
+2) Pixel_width and Pixel_height 
+3) Load_image_contents
+
+Load_image_contents is generic. You provide the following:
+  * Primary_color_range: the type of primary colors.
+    Usually it is a byte (E.g. Unsigned_8)
+  * procedure Set_X_Y: setting a "cursor" (an array index, for instance)
+  * procedure Put_Pixel: set a color (and transparency) on
+      the "cursor" place; the cursor is meant to move one pixel
+      to te right, then
+  * procedure Feedback: display progress (if you want it, otherwise
+      you can always provide an empty procedure)
+  * mode: Display_mode: here you tell if you want the decoding rather
+      nicer or faster, when the decoder is processing "progressive"
+      (JPEG) or "interlaced" (GIF, PNG) pictures. Note: the end
+      result is exactly the same.
+
+This generic construction allows you a total freedom on where and
+how to use GID in your programs. In addition, your Set_X_Y and
+Put_Pixel procedures are inserted at compile-time, (no call instruction),
+right in the heart of the decoding procedures, for each image format,
+which should deliver a decent performance as soon as you set the right
+compiler options (optimization, inlined or macro-expanded generics,
+suppression of all checks, loop unrolling).
+
+How to build GID
+----------------
+- From GPS, press F4 - that's it. The executable is in the /test folder.
+- From ObjectAda, press F7 - that's it. The .exe is in the folder created
+     by ObjectAda upon first project opening.
+- From AdaGIDE, press F3. There will be .o and .ali files at unexpected
+     places, so it's better to build first with GPS or the command line
+- From the command line, with GNAT:
+   - default build mode: gnatmake -P gid
+   - other build mode (e.g. Small): gnatmake -P gid -XBuild_Mode=Small
+   
+We assume here you consider GID unpacked "out of the box", with directories.
+
+Memory requirements and usage
+-----------------------------
+GID uses only memory for decoding purposes (e.g. decompression
+structures, color tables) and doesn't store the image itself.
+As a result, memory will be reserved for only one copy of the output
+bitmap, and this under the format you want or need to have.
+As an example, the to_bmp demo stores the image as a packed
+RBG byte array with a 4-byte padding which is the appropriate
+format for dumping a BMP file in the end. But there are many
+other possible storage formats, and GID lets you the total
+freedom about it. It can be even the case that the bitmap
+storage is more appropriate through an operating system or
+a specific library; in such a case you would not store the
+bitmap within the Ada progam at all and Put_Pixel would be used
+to transmit the pixels further.
+All memory used by GID is taken on the stack, with the exception
+of palettes and JPEG's DHT tables. Those are dynamically allocated
+on the heap and deallocated upon scope end of a variable of the
+Image_descriptor type. It means there is no memory leak possible. 
+The use of heap allocation is justified there because of the
+relatively large size of those objects. They could very well
+be also part of the descriptor record, with a maximal size for
+palette (2**16, for the TGA format).
+
+Where to find the latest version
+--------------------------------
+Please check the "web" constant in gid.ads.
+     
+Note on the construction of GID.
+--------------------------------
+All image formats decoded by GID have similarities in their structure.
+
+- Most streams begin with a signature, followed by a header
+  containing dimensions and the color depth. Then the image contents
+  follow. This is obvious to have such a data organisation,
+  since the header details are needed to calibrate the recipient
+  of the image.
+
+- Streams are structured in blocks of data which are given different
+  names depending on the format:
+  - PNG : chunks
+  - GIF : blocks
+  - JPEG: segments
+  - TGA : areas
+  - TIFF: tags
+  etc.
+

3-mid/opengl/private/gl/applet/test/linkage/launch_gl_linkage_test.adb

@@ -0,0 +1,246 @@
+with
+     GL.safe,
+     GL.lean,
+     GL.desk,
+     interfaces.C,
+     System;
+
+procedure launch_GL_linkage_Test
+--
+--  This test is only intended to check that all GL functions link correctly.
+--  It is not meant to be run.
+--
+--  todo: Add missing calls for each profile.
+is
+   use GL;
+begin
+   --  Make a call to each core function
+   --
+   declare
+      Result : GLenum;
+      Status : GLboolean;
+   begin
+      glActiveTexture (0);
+      glBindTexture (0, 0);
+      glBlendFunc (0, 0);
+      glClear (0);
+      glClearColor (0.0, 0.0, 0.0, 0.0);
+      glClearDepthf (0.0);
+      glClearStencil (0);
+      glColorMask (0, 0, 0, 0);
+      glCullFace (0);
+      glDepthFunc (0);
+      glDepthMask (0);
+      glDepthRangef (0.0, 0.0);
+      glDisable (0);
+      glDrawArrays (0, 0, 0);
+      glEnable (0);
+      glFinish;
+      glFlush;
+      glFrontFace (0);
+      Result := glGetError;
+      glHint (0, 0);
+      Status := glIsEnabled (0);
+      glLineWidth (0.0);
+      glPixelStorei (0, 0);
+      glPolygonOffset (0.0, 0.0);
+      glScissor (0, 0, 0, 0);
+      glStencilFunc (0, 0, 0);
+      glStencilMask (0);
+      glStencilOp (0, 0, 0);
+      glTexParameteri (0, 0, 0);
+      glViewport (0, 0, 0, 0);
+   end;
+
+
+   --  Make a call to each 'Safe' function
+   --
+   declare
+      use safe;
+      Result : access GLubyte;
+   begin
+      Result := glGetString (0);
+      glDrawElements  (0, 0, 0, null);
+      glGenTextures   (0, null);
+      glGetBooleanv   (0, null);
+      glGetFloatv     (0, null);
+      glGetIntegerv   (0, null);
+      glGetTexParameteriv (0, 0, null);
+      glReadPixels    (0, 0, 0, 0, 0, 0, null);
+      glTexImage2D    (0, 0, 0, 0, 0, 0, 0, 0, null);
+      glTexSubImage2D (0, 0, 0, 0, 0, 0, 0, 0, null);
+   end;
+
+
+   --  Make a call to each 'Lean' function
+   --
+   declare
+      use lean, System;
+      a_GLenum       : GLenum;
+      a_GLuint       : GLuint;
+      a_GLboolean    : GLboolean;
+      a_C_int        : interfaces.C.int;
+      GLubyte_access : access GLubyte;
+   begin
+      glAttachShader            (0, 0);
+      glBindAttribLocation      (0, 0, null);
+      glBindBuffer              (0, 0);
+      glBindFramebuffer         (0, 0);
+      glBindRenderbuffer        (0, 0);
+      glBlendColor              (0.0, 0.0, 0.0, 0.0);
+      glBlendEquation           (0);
+      glBlendEquationSeparate   (0, 0);
+      glBlendFuncSeparate       (0, 0, 0, 0);
+      glBufferData              (0, 0, null, 0);
+      glBufferSubData           (0, 0, 0, null);
+      a_GLenum := glCheckFramebufferStatus (0);
+      glCompileShader           (0);
+      glCompressedTexImage2D    (0, 0, 0, 0, 0, 0, 0, null);
+      glCompressedTexSubImage2D (0, 0, 0, 0, 0, 0, 0, 0, null);
+      glCopyTexImage2D          (0, 0, 0, 0, 0, 0, 0, 0);
+      glCopyTexSubImage2D       (0, 0, 0, 0, 0, 0, 0, 0);
+      a_GLuint := glCreateProgram;
+      a_GLuint := glCreateShader (0);
+      glDeleteBuffers           (0, null);
+      glDeleteFramebuffers      (0, null);
+      glDeleteProgram           (0);
+      glDeleteRenderbuffers     (0, null);
+      glDeleteShader            (0);
+      glDeleteTextures          (0, null);
+      glDetachShader            (0, 0);
+      glDisableVertexAttribArray(0);
+      glDrawElements            (0, 0, 0, null);
+      glEnableVertexAttribArray (0);
+      glFramebufferRenderbuffer (0, 0, 0, 0);
+      glFramebufferTexture2D    (0, 0, 0, 0, 0);
+      glGenBuffers              (0, null);
+      glGenFramebuffers         (0, null);
+      glGenRenderbuffers        (0, null);
+      glGenTextures             (0, null);
+      glGenerateMipmap          (0);
+      glGetActiveAttrib         (0, 0, 0, null, null, null, null);
+      glGetActiveUniform        (0, 0, 0, null, null, null, null);
+      glGetAttachedShaders      (0, 0, null, null);
+      a_C_int := glGetAttribLocation (0, null);
+      glGetBooleanv             (0, null);
+      glGetBufferParameteriv    (0, 0, null);
+      glGetFloatv               (0, null);
+      glGetFramebufferAttachmentParameteriv
+                                (0, 0, 0, null);
+      glGetIntegerv             (0, null);
+      glGetProgramiv            (0, 0, null);
+      glGetProgramInfoLog       (0, 0, null, null);
+      glGetRenderbufferParameteriv
+                                (0, 0, null);
+      glGetShaderiv             (0, 0, null);
+      glGetShaderInfoLog        (0, 0, null, null);
+      glGetShaderPrecisionFormat(0, 0, null, null);
+      glGetShaderSource         (0, 0, null, null);
+      GLubyte_access := glGetString(0);
+      glGetTexParameterfv       (0, 0, null_Address);
+      glGetTexParameteriv       (0, 0, null);
+      glGetUniformfv            (0, 0, null_Address);
+      glGetUniformiv            (0, 0, null);
+      a_C_int := glGetUniformLocation (0, null);
+      glGetVertexAttribfv       (0, 0, null_Address);
+      glGetVertexAttribiv       (0, 0, null);
+      glGetVertexAttribPointerv (0, 0, null);
+      a_GLboolean := glIsBuffer      (0);
+      a_GLboolean := glIsFramebuffer (0);
+      a_GLboolean := glIsProgram     (0);
+      a_GLboolean := glIsRenderbuffer(0);
+      a_GLboolean := glIsShader      (0);
+      a_GLboolean := glIsTexture     (0);
+      glLinkProgram           (0);
+      glReadPixels            (0, 0, 0, 0, 0, 0, null);
+      glReleaseShaderCompiler;
+      glRenderbufferStorage   (0, 0, 0, 0);
+      glSampleCoverage        (0.0, 0);
+      glShaderBinary          (0, null, 0, null, 0);
+      glShaderSource          (0, 0, null, null);
+      glStencilFuncSeparate   (0, 0, 0, 0);
+      glStencilMaskSeparate   (0, 0);
+      glStencilOpSeparate     (0, 0, 0, 0);
+      glTexImage2D            (0, 0, 0, 0, 0, 0, 0, 0, null);
+      glTexParameterf         (0, 0, 0.0);
+      glTexParameterfv        (0, 0, null_Address);
+      glTexParameteriv        (0, 0, null);
+      glTexSubImage2D         (0, 0, 0, 0, 0, 0, 0, 0, null);
+      glUniform1f             (0, 0.0);
+      glUniform1fv            (0, 0, null_Address);
+      glUniform1i             (0, 0);
+      glUniform1iv            (0, 0, null);
+      glUniform2f             (0, 0.0, 0.0);
+      glUniform2fv            (0, 0, null_Address);
+      glUniform2i             (0, 0, 0);
+      glUniform2iv            (0, 0, null);
+      glUniform3f             (0, 0.0, 0.0, 0.0);
+      glUniform3fv            (0, 0, null_Address);
+      glUniform3i             (0, 0, 0, 0);
+      glUniform3iv            (0, 0, null);
+      glUniform4f             (0, 0.0, 0.0, 0.0, 0.0);
+      glUniform4fv            (0, 0, null_Address);
+      glUniform4i             (0, 0, 0, 0, 0);
+      glUniform4iv            (0, 0, null);
+      glUniformMatrix2fv      (0, 0, 0, null_Address);
+      glUniformMatrix3fv      (0, 0, 0, null_Address);
+      glUniformMatrix4fv      (0, 0, 0, null_Address);
+      glUseProgram            (0);
+      glValidateProgram       (0);
+      glVertexAttrib1f        (0, 0.0);
+      glVertexAttrib1fv       (0, null_Address);
+      glVertexAttrib2f        (0, 0.0, 0.0);
+      glVertexAttrib2fv       (0, null_Address);
+      glVertexAttrib3f        (0, 0.0, 0.0, 0.0);
+      glVertexAttrib3fv       (0, null_Address);
+      glVertexAttrib4f        (0, 0.0, 0.0, 0.0, 0.0);
+      glVertexAttrib4fv       (0, null_Address);
+      glVertexAttribPointer   (0, 0, 0, 0, 0, null);
+   end;
+
+
+   --  Make a call to each 'desk' function
+   --
+   declare
+      use desk;
+      a_GLboolean : GLboolean;
+   begin
+      glActiveTexture           (0);
+      glBindTexture             (0, 0);
+      glBlendColor              (0.0, 0.0, 0.0, 0.0);
+      glBlendEquation           (0);
+      glBlendEquationSeparate   (0, 0);
+      glBlendFunc               (0, 0);
+      glClearStencil            (0);
+      glClearDepth              (0.0);
+      glColorMask               (0, 0, 0, 0);
+      glCompressedTexImage2D    (0, 0, 0, 0, 0, 0, 0, null);
+      glCompressedTexSubImage2D (0, 0, 0, 0, 0, 0, 0, 0, null);
+      glCopyTexImage2D          (0, 0, 0, 0, 0, 0, 0, 0);
+      glCopyTexSubImage2D       (0, 0, 0, 0, 0, 0, 0, 0);
+      glDeleteTextures          (0, null);
+      glDepthMask               (0);
+      glDisable                 (0);
+      glDrawArrays              (0, 0, 0);
+      glGetBooleanv             (0, null);
+      glGetFloatv               (0, null);
+      glGetIntegerv             (0, null);
+      glGetTexParameterfv       (0, 0, null);
+      glGetTexParameteriv       (0, 0, null);
+      a_GLboolean := glIsTexture(0);
+      glLineWidth               (0.0);
+      glPixelStorei             (0, 0);
+      glPolygonOffset           (0.0, 0.0);
+      glReadPixels              (0, 0, 0, 0, 0, 0, null);
+      glSampleCoverage          (0.0, 0);
+      glStencilMask             (0);
+      glStencilOp               (0, 0, 0);
+      glTexImage2D              (0, 0, 0, 0, 0, 0, 0, 0, null);
+      glTexParameterf           (0, 0, 0.0);
+      glTexParameterfv          (0, 0, null);
+      glTexParameteri           (0, 0, 0);
+      glTexParameteriv          (0, 0, null);
+      glTexSubImage2D           (0, 0, 0, 0, 0, 0, 0, 0, null);
+   end;
+
+end launch_GL_linkage_Test;

3-mid/opengl/private/gl/applet/test/linkage/linkage_test.gpr

@@ -0,0 +1,24 @@
+with
+     "gl",
+     "lace_shared";
+
+project Linkage_Test
+is
+   for Object_Dir use "build";
+   for Exec_Dir   use ".";
+   for Main       use ("launch_gl_linkage_test.adb");
+
+   package Ide      renames Lace_shared.Ide;
+   package Builder  renames Lace_shared.Builder;
+   package Compiler renames Lace_shared.Compiler;
+   package Binder   renames Lace_shared.Binder;
+
+   package Linker is
+      for Default_Switches ("ada") use ("-g", "-lX11", "-lGL");
+   end Linker;
+
+   package Pretty_Printer is
+      for Default_Switches ("ada") use ("-A1");
+   end Pretty_Printer;
+
+end Linkage_Test;

3-mid/opengl/private/gl/library/gl.gpr

@@ -0,0 +1,15 @@
+with
+     "lace_shared";
+     
+project Gl
+is
+   for Languages   use ("Ada");
+   for Source_Dirs use (".", "../source");
+   for Object_Dir  use "build";
+
+   package Ide      renames Lace_shared.Ide;
+   package Builder  renames Lace_shared.Builder;
+   package Compiler renames Lace_shared.Compiler;
+   package Binder   renames Lace_shared.Binder;
+   
+end Gl;

3-mid/opengl/private/gl/source/cgl/gl-cgl.ads

@@ -0,0 +1,583 @@
+--  Copyright (c) 2011, Felix Krause <flyx@isobeef.org>
+--
+--  Permission to use, copy, modify, and/or distribute this software for any
+--  purpose with or without fee is hereby granted, provided that the above
+--  copyright notice and this permission notice appear in all copies.
+--
+--  THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+--  WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+--  MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+--  ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+--  WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+--  ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+--  OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+with System;
+with Interfaces.C.Pointers;
+with Interfaces.C.Extensions;
+with Interfaces.C.Strings;
+
+package GL.CGL is
+
+   --  CGL types and constants
+
+   subtype CGLContextObject      is System.Address;
+   subtype CGLPixelFormatObject  is System.Address;
+   subtype CGLRendererInfoObject is System.Address;
+   subtype CGLPBufferObject      is System.Address;
+
+   type CGLPixelFormatAttribute is (Terminator               ,
+                                    kCGLPFAAllRenderers      ,
+                                    kCGLPFATripleBuffer      ,
+                                    kCGLPFADoubleBuffer      ,
+                                    kCGLPFAStereo            ,
+                                    kCGLPFAAuxBuffers        ,
+                                    kCGLPFAColorSize         ,
+                                    kCGLPFAAlphaSize         ,
+                                    kCGLPFADepthSize         ,
+                                    kCGLPFAStencilSize       ,
+                                    kCGLPFAAccumSize         ,
+                                    kCGLPFAMinimumPolicy     ,
+                                    kCGLPFAMaximumPolicy     ,
+                                    kCGLPFAOffScreen         ,
+                                    kCGLPFAFullScreen        ,
+                                    kCGLPFASampleBuffers     ,
+                                    kCGLPFASamples           ,
+                                    kCGLPFAAuxDepthStencil   ,
+                                    kCGLPFAColorFloat        ,
+                                    kCGLPFAMultisample       ,
+                                    kCGLPFASupersample       ,
+                                    kCGLPFASampleAlpha       ,
+
+                                    kCGLPFARendererID        ,
+                                    kCGLPFASingleRenderer    ,
+                                    kCGLPFANoRecovery        ,
+                                    kCGLPFAAccelerated       ,
+                                    kCGLPFAClosestPolicy     ,
+                                    kCGLPFARobust            ,
+                                    kCGLPFABackingStore      ,
+                                    kCGLPFAMPSafe            ,
+                                    kCGLPFAWindow            ,
+                                    kCGLPFAMultiScreen       ,
+                                    kCGLPFACompliant         ,
+                                    kCGLPFADisplayMask       ,
+                                    kCGLPFAPBuffer           ,
+                                    kCGLPFARemotePBuffer     ,
+                                    kCGLPFAAllowOfflineRenderers,
+                                    kCGLPFAAcceleratedCompute,
+                                    kCGLPFAOpenGLProfile     ,
+                                    kCGLPFAVirtualScreenCount
+                                   );
+
+   type CGLRendererProperty is (kCGLRPOffScreen             ,
+                                kCGLRPFullScreen            ,
+                                kCGLRPRendererID            ,
+                                kCGLRPAccelerated           ,
+                                kCGLRPRobust                ,
+                                kCGLRPBackingStore          ,
+                                kCGLRPMPSafe                ,
+                                kCGLRPWindow                ,
+                                kCGLRPMultiScreen           ,
+                                kCGLRPCompliant             ,
+                                kCGLRPDisplayMask           ,
+                                kCGLRPBufferModes           ,
+                                kCGLRPColorModes            ,
+                                kCGLRPAccumModes            ,
+                                kCGLRPDepthModes            ,
+                                kCGLRPStencilModes          ,
+                                kCGLRPMaxAuxBuffers         ,
+                                kCGLRPMaxSampleBuffers      ,
+                                kCGLRPMaxSamples            ,
+                                kCGLRPSampleModes           ,
+                                kCGLRPSampleAlpha           ,
+                                kCGLRPVideoMemory           ,
+                                kCGLRPTextureMemory         ,
+                                kCGLRPGPUVertProcCapable    ,
+                                kCGLRPGPUFragProcCapable    ,
+                                kCGLRPRendererCount         ,
+                                kCGLRPOnline                ,
+                                kCGLRPAcceleratedCompute    ,
+                                kCGLRPVideoMemoryMegabytes  ,
+                                kCGLRPTextureMemoryMegabytes
+                               );
+
+   type CGLContextEnable is (kCGLCESwapRectangle  ,
+                             kCGLCESwapLimit      ,
+                             kCGLCERasterization  ,
+                             kCGLCEStateValidation,
+                             kCGLCESurfaceBackingSize,
+                             kCGLCEDisplayListOptimization,
+                             kCGLCEMPEngine       ,
+                             kCGLCECrashOnRemovedFunctions
+                            );
+
+   type CGLContextParameter is (kCGLCPSwapRectangle         ,
+                                kCGLCPSwapInterval          ,
+                                kCGLCPDispatchTableSize     ,
+                                kCGLCPClientStorage         ,
+                                kCGLCPSurfaceTexture        ,
+                                kCGLCPSurfaceOrder          ,
+                                kCGLCPSurfaceOpacity        ,
+                                kCGLCPSurfaceBackingSize    ,
+                                kCGLCPSurfaceSurfaceVolatile,
+                                kCGLCPReclaimResources      ,
+                                kCGLCPCurrentRendererID     ,
+                                kCGLCPGPUVertexProcessing   ,
+                                kCGLCPGPUFragmentProcessing ,
+                                kCGLCPHasDrawable           ,
+                                kCGLCPMPSwapsInFlight
+                               );
+
+   type CGLGlobalOption is (kCGLGOFormatCacheSize ,
+                            kCGLGOClearFormatCache,
+                            kCGLGORetainRenderers ,
+                            kCGLGOResetLibrary    ,
+                            kCGLGOUseErrorHandler ,
+                            kCGLGOUseBuildCache
+                           );
+
+   type CGLOpenGLProfile is (kCGLOGLPVersion_Legacy  ,
+                             kCGLOGLPVersion_3_2_Core
+                            );
+
+   type CGLError is (kCGLNoError           ,
+                     kCGLBadAttribute      ,
+                     kCGLBadProperty       ,
+                     kCGLBadPixelFormat    ,
+                     kCGLBadRendererInfo   ,
+                     kCGLBadContext        ,
+                     kCGLBadDrawable       ,
+                     kCGLBadDisplay        ,
+                     kCGLBadState          ,
+                     kCGLBadValue          ,
+                     kCGLBadMatch          ,
+                     kCGLBadEnumeration    ,
+                     kCGLBadOffScreen      ,
+                     kCGLBadFullScreen     ,
+                     kCGLBadWindow         ,
+                     kCGLBadAddress        ,
+                     kCGLBadCodeModule     ,
+                     kCGLBadAlloc          ,
+                     kCGLBadConnection
+                    );
+
+   kCGLMonoscopicBit  : constant := 16#00000001#;
+   kCGLStereoscopicBit: constant := 16#00000002#;
+   kCGLSingleBufferBit: constant := 16#00000004#;
+   kCGLDoubleBufferBit: constant := 16#00000008#;
+   kCGLTripleBufferBit: constant := 16#00000010#;
+   kCGL0Bit           : constant := 16#00000001#;
+   kCGL1Bit           : constant := 16#00000002#;
+   kCGL2Bit           : constant := 16#00000004#;
+   kCGL3Bit           : constant := 16#00000008#;
+   kCGL4Bit           : constant := 16#00000010#;
+   kCGL5Bit           : constant := 16#00000020#;
+   kCGL6Bit           : constant := 16#00000040#;
+   kCGL8Bit           : constant := 16#00000080#;
+   kCGL10Bit          : constant := 16#00000100#;
+   kCGL12Bit          : constant := 16#00000200#;
+   kCGL16Bit          : constant := 16#00000400#;
+   kCGL24Bit          : constant := 16#00000800#;
+   kCGL32Bit          : constant := 16#00001000#;
+   kCGL48Bit          : constant := 16#00002000#;
+   kCGL64Bit          : constant := 16#00004000#;
+   kCGL96Bit          : constant := 16#00008000#;
+   kCGL128Bit         : constant := 16#00010000#;
+   kCGLRGB444Bit      : constant := 16#00000040#;
+   kCGLARGB4444Bit    : constant := 16#00000080#;
+   kCGLRGB444A8Bit    : constant := 16#00000100#;
+   kCGLRGB555Bit      : constant := 16#00000200#;
+   kCGLARGB1555Bit    : constant := 16#00000400#;
+   kCGLRGB555A8Bit    : constant := 16#00000800#;
+   kCGLRGB565Bit      : constant := 16#00001000#;
+   kCGLRGB565A8Bit    : constant := 16#00002000#;
+   kCGLRGB888Bit      : constant := 16#00004000#;
+   kCGLARGB8888Bit    : constant := 16#00008000#;
+   kCGLRGB888A8Bit    : constant := 16#00010000#;
+   kCGLRGB101010Bit   : constant := 16#00020000#;
+   kCGLARGB2101010Bit : constant := 16#00040000#;
+   kCGLRGB101010_A8Bit: constant := 16#00080000#;
+   kCGLRGB121212Bit   : constant := 16#00100000#;
+   kCGLARGB12121212Bit: constant := 16#00200000#;
+   kCGLRGB161616Bit   : constant := 16#00400000#;
+   kCGLRGBA16161616Bit: constant := 16#00800000#;
+   kCGLRGBFloat64Bit  : constant := 16#01000000#;
+   kCGLRGBAFloat64Bit : constant := 16#02000000#;
+   kCGLRGBFloat128Bit : constant := 16#04000000#;
+   kCGLRGBAFloat128Bit: constant := 16#08000000#;
+   kCGLRGBFloat256Bit : constant := 16#10000000#;
+   kCGLRGBAFloat256Bit: constant := 16#20000000#;
+
+   kCGLSupersampleBit : constant := 16#00000001#;
+   kCGLMultisampleBit : constant := 16#00000002#;
+
+   type CGLPixelFormatAttribute_Array is array (Positive range <>) of
+     aliased CGLPixelFormatAttribute;
+
+
+   --  Pixel format functions
+
+   function CGLChoosePixelFormat (attribs : access CGLPixelFormatAttribute;
+                                  pix     : access CGLPixelFormatObject;
+                                  npix    : access GLint) return CGLError;
+
+   function CGLDestroyPixelFormat (pix : CGLPixelFormatObject) return CGLError;
+
+   function CGLDescribePixelFormat (pix : CGLPixelFormatObject; pix_num : GLint;
+                                    attrib : CGLPixelFormatAttribute;
+                                    value : access GLint) return CGLError;
+
+   procedure CGLReleasePixelFormat (pix : in CGLPixelFormatObject);
+
+   function CGLRetainPixelFormat (pix : CGLPixelFormatObject)
+                                  return CGLPixelFormatObject;
+
+   function CGLGetPixelFormatRetainCount (pix : CGLPixelFormatObject)
+                                          return GLuint;
+
+   function CGLQueryRendererInfo (display_mask : GLuint;
+                                  rend : access CGLRendererInfoObject;
+                                  nrend : access GLint) return CGLError;
+
+   function CGLDestroyRendererInfo (rend : CGLRendererInfoObject)
+                                    return CGLError;
+
+   function CGLDescribeRenderer (rend : CGLRendererInfoObject; rend_num : GLint;
+                                 prop : CGLRendererProperty;
+                                 value : access GLint) return CGLError;
+
+   function CGLCreateContext (pix : CGLPixelFormatObject;
+                              share : CGLContextObject;
+                              ctx : access CGLContextObject) return CGLError;
+
+   function CGLDestroyContext (ctx : CGLContextObject) return CGLError;
+
+   function CGLCopyContext (src, dst : CGLContextObject;
+                            mask : GLbitfield) return CGLError;
+
+   function CGLRetainContext (ctx : CGLContextObject) return CGLContextObject;
+
+   procedure CGLReleaseContext (ctx : in CGLContextObject);
+
+   function CGLGetContextRetainCount (ctx : CGLContextObject) return GLuint;
+
+   function CGLGetPixelFormat (ctx : CGLContextObject) return CGLPixelFormatObject;
+
+   function CGLCreatePBuffer (width, height : GLsizei;
+                              target, internalFormat : GLenum;
+                              max_level : GLint;
+                              pbuffer : access CGLPBufferObject)
+                              return CGLError;
+
+   function CGLDestroyPBuffer (pbuffer : CGLPBufferObject) return CGLError;
+
+   function CGLDescribePBuffer (obj : CGLPBufferObject;
+                                width, height : access GLsizei;
+                                target, internalFormat : access GLenum;
+                                mipmap : access GLint) return CGLError;
+
+   function CGLTexImagePBuffer (ctx : CGLContextObject;
+                                pbuffer : CGLPBufferObject;
+                                source : GLenum) return CGLError;
+
+   function CGLRetainPBuffer (pbuffer : CGLPBufferObject)
+                              return CGLPBufferObject;
+
+   procedure CGLReleasePBuffer (pbuffer : in CGLPBufferObject);
+
+   function CGLGetPBufferRetainCount (pbuffer : CGLPBufferObject) return GLuint;
+
+   function CGLSetOffScreen (ctx : CGLContextObject;
+                             width, height : GLsizei;
+                             rowbytes : GLint;
+                             baseaddr : Interfaces.C.Extensions.void_ptr)
+                             return CGLError;
+
+   function CGLGetOffScreen (ctx : CGLContextObject;
+                             width, height : access GLsizei;
+                             rowbytes : access GLint;
+                             baseaddr : access Interfaces.C.Extensions.void_ptr)
+                             return CGLError;
+
+   function CGLSetFullScreen (ctx : CGLContextObject) return CGLError;
+
+   function CGLSetFullScreenOnDisplay (ctx : CGLContextObject;
+                                       display_mask : GLuint) return CGLError;
+
+   function CGLSetPBuffer (ctx : CGLContextObject;
+                           pbuffer : CGLPBufferObject;
+                           face : GLenum;
+                           level, screen : GLint) return CGLError;
+
+   function CGLGetPBuffer (ctx : CGLContextObject;
+                           pbuffer : access CGLPBufferObject;
+                           face : access GLenum;
+                           level, screen : access GLint) return CGLError;
+
+   function CGLClearDrawable (ctx : CGLContextObject) return CGLError;
+
+   function CGLFlushDrawable (ctx : CGLContextObject) return CGLError;
+
+   function CGLEnable (ctx : CGLContextObject; pname : CGLContextEnable)
+                       return CGLError;
+
+   function CGLDisable (ctx : CGLContextObject; pname : CGLContextEnable)
+                        return CGLError;
+
+   function CGLIsEnabled (ctx : CGLContextObject; pname : CGLContextEnable;
+                          enable : access GLint) return CGLError;
+
+   function CGLSetParameter (ctx : CGLContextObject;
+                             pname : CGLContextParameter;
+                             params : access constant GLint) return CGLError;
+
+   function CGLGetParameter (ctx : CGLContextObject;
+                             pname : CGLContextParameter;
+                             params : access GLint) return CGLError;
+
+   function CGLSetVirtualScreen (ctx : CGLContextObject; screen : GLint)
+                                 return CGLError;
+
+   function CGLGetVirtualScreen (ctx : CGLContextObject; screen : access GLint)
+                                 return CGLError;
+
+   function CGLUpdateContext (ctx : CGLContextObject) return CGLError;
+
+   function CGLSetGlobalOption (pname : CGLGlobalOption;
+                                params : access constant GLint) return CGLError;
+
+   function CGLGetGlobalOption (pname : CGLGlobalOption;
+                                params : access GLint) return CGLError;
+
+   function CGLSetOption (pname : CGLGlobalOption; param : GLint)
+                          return CGLError;
+
+   function CGLGetOption (pname : CGLGlobalOption;
+                          param : access GLint) return CGLError;
+
+   function CGLLockContext (ctx : CGLContextObject) return CGLError;
+
+   function CGLUnlockContext (ctx : CGLContextObject) return CGLError;
+
+   procedure CGLGetVersion (majorvers, minorvers : out GLint);
+
+   function CGLErrorString (error : CGLError)
+                            return Interfaces.C.Strings.chars_ptr;
+
+   function CGLSetCurrentContext (ctx : CGLContextObject) return CGLError;
+
+   function CGLGetCurrentContext return CGLContextObject;
+
+private
+   C_Enum_Size : constant := 32;
+
+   for CGLPixelFormatAttribute use (Terminator                =>   0,
+                                    kCGLPFAAllRenderers       =>   1,
+                                    kCGLPFATripleBuffer       =>   3,
+                                    kCGLPFADoubleBuffer       =>   5,
+                                    kCGLPFAStereo             =>   6,
+                                    kCGLPFAAuxBuffers         =>   7,
+                                    kCGLPFAColorSize          =>   8,
+                                    kCGLPFAAlphaSize          =>  11,
+                                    kCGLPFADepthSize          =>  12,
+                                    kCGLPFAStencilSize        =>  13,
+                                    kCGLPFAAccumSize          =>  14,
+                                    kCGLPFAMinimumPolicy      =>  51,
+                                    kCGLPFAMaximumPolicy      =>  52,
+                                    kCGLPFAOffScreen          =>  53,
+                                    kCGLPFAFullScreen         =>  54,
+                                    kCGLPFASampleBuffers      =>  55,
+                                    kCGLPFASamples            =>  56,
+                                    kCGLPFAAuxDepthStencil    =>  57,
+                                    kCGLPFAColorFloat         =>  58,
+                                    kCGLPFAMultisample        =>  59,
+                                    kCGLPFASupersample        =>  60,
+                                    kCGLPFASampleAlpha        =>  61,
+
+                                    kCGLPFARendererID         =>  70,
+                                    kCGLPFASingleRenderer     =>  71,
+                                    kCGLPFANoRecovery         =>  72,
+                                    kCGLPFAAccelerated        =>  73,
+                                    kCGLPFAClosestPolicy      =>  74,
+                                    kCGLPFARobust             =>  75,
+                                    kCGLPFABackingStore       =>  76,
+                                    kCGLPFAMPSafe             =>  78,
+                                    kCGLPFAWindow             =>  80,
+                                    kCGLPFAMultiScreen        =>  81,
+                                    kCGLPFACompliant          =>  83,
+                                    kCGLPFADisplayMask        =>  84,
+                                    kCGLPFAPBuffer            =>  90,
+                                    kCGLPFARemotePBuffer      =>  91,
+                                    kCGLPFAAllowOfflineRenderers => 96,
+                                    kCGLPFAAcceleratedCompute =>  97,
+                                    kCGLPFAOpenGLProfile      =>  99,
+                                    kCGLPFAVirtualScreenCount => 128
+                                   );
+   for CGLPixelFormatAttribute'Size use C_Enum_Size;
+   pragma Convention (C, CGLPixelFormatAttribute);
+
+   for CGLRendererProperty use (kCGLRPOffScreen              =>  53,
+                                kCGLRPFullScreen             =>  54,
+                                kCGLRPRendererID             =>  70,
+                                kCGLRPAccelerated            =>  73,
+                                kCGLRPRobust                 =>  75,
+                                kCGLRPBackingStore           =>  76,
+                                kCGLRPMPSafe                 =>  78,
+                                kCGLRPWindow                 =>  80,
+                                kCGLRPMultiScreen            =>  81,
+                                kCGLRPCompliant              =>  83,
+                                kCGLRPDisplayMask            =>  84,
+                                kCGLRPBufferModes            => 100,
+                                kCGLRPColorModes             => 103,
+                                kCGLRPAccumModes             => 104,
+                                kCGLRPDepthModes             => 105,
+                                kCGLRPStencilModes           => 106,
+                                kCGLRPMaxAuxBuffers          => 107,
+                                kCGLRPMaxSampleBuffers       => 108,
+                                kCGLRPMaxSamples             => 109,
+                                kCGLRPSampleModes            => 110,
+                                kCGLRPSampleAlpha            => 111,
+                                kCGLRPVideoMemory            => 120,
+                                kCGLRPTextureMemory          => 121,
+                                kCGLRPGPUVertProcCapable     => 122,
+                                kCGLRPGPUFragProcCapable     => 123,
+                                kCGLRPRendererCount          => 128,
+                                kCGLRPOnline                 => 129,
+                                kCGLRPAcceleratedCompute     => 130,
+                                kCGLRPVideoMemoryMegabytes   => 131,
+                                kCGLRPTextureMemoryMegabytes => 132
+                               );
+   for CGLRendererProperty'Size use C_Enum_Size;
+   pragma Convention (C, CGLRendererProperty);
+
+   for CGLContextEnable use (kCGLCESwapRectangle           => 201,
+                             kCGLCESwapLimit               => 203,
+                             kCGLCERasterization           => 221,
+                             kCGLCEStateValidation         => 301,
+                             kCGLCESurfaceBackingSize      => 305,
+                             kCGLCEDisplayListOptimization => 307,
+                             kCGLCEMPEngine                => 313,
+                             kCGLCECrashOnRemovedFunctions => 316
+                            );
+   for CGLContextEnable'Size use C_Enum_Size;
+   pragma Convention (C, CGLContextEnable);
+
+   for CGLContextParameter use (kCGLCPSwapRectangle          => 200,
+                                kCGLCPSwapInterval           => 222,
+                                kCGLCPDispatchTableSize      => 224,
+                                kCGLCPClientStorage          => 226,
+                                kCGLCPSurfaceTexture         => 228,
+                                kCGLCPSurfaceOrder           => 235,
+                                kCGLCPSurfaceOpacity         => 236,
+                                kCGLCPSurfaceBackingSize     => 304,
+                                kCGLCPSurfaceSurfaceVolatile => 306,
+                                kCGLCPReclaimResources       => 308,
+                                kCGLCPCurrentRendererID      => 309,
+                                kCGLCPGPUVertexProcessing    => 310,
+                                kCGLCPGPUFragmentProcessing  => 311,
+                                kCGLCPHasDrawable            => 314,
+                                kCGLCPMPSwapsInFlight	     => 315
+                               );
+   for CGLContextParameter'Size use C_Enum_Size;
+   pragma Convention (C, CGLContextParameter);
+
+   for CGLGlobalOption use (kCGLGOFormatCacheSize  => 501,
+                            kCGLGOClearFormatCache => 502,
+                            kCGLGORetainRenderers  => 503,
+                            kCGLGOResetLibrary     => 504,
+                            kCGLGOUseErrorHandler  => 505,
+                            kCGLGOUseBuildCache    => 506
+                           );
+   for CGLGlobalOption'Size use C_Enum_Size;
+   pragma Convention (C, CGLGlobalOption);
+
+   for CGLOpenGLProfile use (kCGLOGLPVersion_Legacy   => 16#1000#,
+                             kCGLOGLPVersion_3_2_Core => 16#3200#
+                            );
+   for CGLOpenGLProfile'Size use C_Enum_Size;
+   pragma Convention (C, CGLOpenGLProfile);
+
+   for CGLError use (kCGLNoError            => 0,
+                     kCGLBadAttribute       => 10000,
+                     kCGLBadProperty        => 10001,
+                     kCGLBadPixelFormat     => 10002,
+                     kCGLBadRendererInfo    => 10003,
+                     kCGLBadContext         => 10004,
+                     kCGLBadDrawable        => 10005,
+                     kCGLBadDisplay         => 10006,
+                     kCGLBadState           => 10007,
+                     kCGLBadValue           => 10008,
+                     kCGLBadMatch           => 10009,
+                     kCGLBadEnumeration     => 10010,
+                     kCGLBadOffScreen       => 10011,
+                     kCGLBadFullScreen      => 10012,
+                     kCGLBadWindow          => 10013,
+                     kCGLBadAddress         => 10014,
+                     kCGLBadCodeModule      => 10015,
+                     kCGLBadAlloc           => 10016,
+                     kCGLBadConnection      => 10017
+                    );
+   for CGLError'Size use C_Enum_Size;
+   pragma Convention (C, CGLError);
+
+   pragma Import (C, CGLChoosePixelFormat, "CGLChoosePixelFormat");
+   pragma Import (C, CGLDestroyPixelFormat, "CGLDestroyPixelFormat");
+   pragma Import (C, CGLDescribePixelFormat, "CGLDescribePixelFormat");
+   pragma Import (C, CGLReleasePixelFormat, "CGLReleasePixelFormat");
+   pragma Import (C, CGLRetainPixelFormat, "CGLRetainPixelFormat");
+   pragma Import (C, CGLGetPixelFormatRetainCount, "CGLGetPixelFormatRetainCount");
+
+   pragma Import (C, CGLQueryRendererInfo, "CGLQueryRendererInfo");
+   pragma Import (C, CGLDestroyRendererInfo, "CGLDestroyRendererInfo");
+   pragma Import (C, CGLDescribeRenderer, "CGLDescribeRenderer");
+
+   pragma Import (C, CGLCreateContext, "CGLCreateContext");
+   pragma Import (C, CGLDestroyContext, "CGLDestroyContext");
+   pragma Import (C, CGLCopyContext, "CGLCopyContext");
+   pragma Import (C, CGLRetainContext, "CGLRetainContext");
+   pragma Import (C, CGLReleaseContext, "CGLReleaseContext");
+   pragma Import (C, CGLGetContextRetainCount, "CGLGetContextRetainCount");
+   pragma Import (C, CGLGetPixelFormat, "CGLGetPixelFormat");
+
+   pragma Import (C, CGLCreatePBuffer, "CGLCreatePBuffer");
+   pragma Import (C, CGLDestroyPBuffer, "CGLDestroyPBuffer");
+   pragma Import (C, CGLDescribePBuffer, "CGLDescribePBuffer");
+   pragma Import (C, CGLTexImagePBuffer, "CGLTexImagePBuffer");
+   pragma Import (C, CGLRetainPBuffer, "CGLRetainPBuffer");
+   pragma Import (C, CGLReleasePBuffer, "CGLReleasePBuffer");
+   pragma Import (C, CGLGetPBufferRetainCount, "CGLGetPBufferRetainCount");
+
+   pragma Import (C, CGLSetOffScreen, "CGLSetOffScreen");
+   pragma Import (C, CGLGetOffScreen, "CGLGetOffScreen");
+   pragma Import (C, CGLSetFullScreen, "CGLSetFullScreen");
+   pragma Import (C, CGLSetFullScreenOnDisplay, "CGLSetFullScreenOnDisplay");
+   pragma Import (C, CGLSetPBuffer, "CGLSetPBuffer");
+   pragma Import (C, CGLGetPBuffer, "CGLGetPBuffer");
+   pragma Import (C, CGLClearDrawable, "CGLClearDrawable");
+   pragma Import (C, CGLFlushDrawable, "CGLFlushDrawable");
+
+   pragma Import (C, CGLEnable, "CGLEnable");
+   pragma Import (C, CGLDisable, "CGLDisable");
+   pragma Import (C, CGLIsEnabled, "CGLIsEnabled");
+   pragma Import (C, CGLSetParameter, "CGLSetParameter");
+   pragma Import (C, CGLGetParameter, "CGLGetParameter");
+
+   pragma Import (C, CGLSetVirtualScreen, "CGLSetVirtualScreen");
+   pragma Import (C, CGLGetVirtualScreen, "CGLGetVirtualScreen");
+   pragma Import (C, CGLUpdateContext, "CGLUpdateContext");
+
+   pragma Import (C, CGLSetGlobalOption, "CGLSetGlobalOption");
+   pragma Import (C, CGLGetGlobalOption, "CGLGetGlobalOption");
+   pragma Import (C, CGLSetOption, "CGLSetOption");
+   pragma Import (C, CGLGetOption, "CGLGetOption");
+
+   pragma Import (C, CGLLockContext, "CGLLockContext");
+   pragma Import (C, CGLUnlockContext, "CGLUnlockContext");
+
+
+   pragma Import (C, CGLGetVersion, "CGLGetVersion");
+   pragma Import (C, CGLErrorString, "CGLErrorString");
+
+   pragma Import (C, CGLSetCurrentContext, "CGLSetCurrentContext");
+   pragma Import (C, CGLGetCurrentContext, "CGLGetCurrentContext");
+end GL.CGL;

3-mid/opengl/private/gl/source/gl-binding.ads

@@ -0,0 +1,151 @@
+package gl.Binding
+--
+--  Provides functions common to all openGL profiles.
+--
+is
+
+   procedure glActiveTexture (Texture  : in     GLenum);
+   procedure glBindTexture   (Target   : in     GLenum;
+                              Texture  : in     GLuint);
+   procedure glBlendFunc     (sFactor  : in     GLenum;
+                              dFactor  : in     GLenum);
+   procedure glClear         (Mask     : in     GLbitfield);
+   procedure glClearColor    (Red      : in     GLclampf;
+                              Green    : in     GLclampf;
+                              Blue     : in     GLclampf;
+                              Alpha    : in     GLclampf);
+   procedure glClearDepthf   (Depth    : in     GLclampf);
+   procedure glClearStencil  (S        : in     GLint);
+   procedure glColorMask     (Red      : in     GLboolean;
+                              Green    : in     GLboolean;
+                              Blue     : in     GLboolean;
+                              Alpha    : in     GLboolean);
+   procedure glCullFace      (Mode     : in     GLenum);
+   procedure glDepthFunc     (Func     : in     GLenum);
+   procedure glDepthMask     (Flag     : in     GLboolean);
+   procedure glDepthRangef   (zNear    : in     GLclampf;
+                              zFar     : in     GLclampf);
+   procedure glDisable       (Cap      : in     GLenum);
+   procedure glDrawArrays    (Mode     : in     GLenum;
+                              First    : in     GLint;
+                              Count    : in     GLsizei);
+   procedure glDrawElements  (Mode     : in     GLenum;
+                              Count    : in     GLsizei;
+                              the_Type : in     GLenum;
+                              Indices  : access GLvoid);
+   procedure glEnable        (Cap      : in     GLenum);
+   procedure glFinish;
+   procedure glFlush;
+   procedure glFrontFace     (Mode     : in     GLenum);
+   procedure glGenTextures   (N        : in     GLsizei;
+                              Textures : access GLuint);
+   function  glGetError                  return GLenum;
+   procedure glGetBooleanv   (pName    : in     GLenum;
+                              Params   : access GLboolean);
+   procedure glGetFloatv     (pName    : in     GLenum;
+                              Params   : access GLfloat);
+   procedure glGetIntegerv   (pName    : in     GLenum;
+                              Params   : access GLint);
+   function  glGetString     (Name     : in     GLenum)  return access GLubyte;
+   procedure glGetTexParameteriv
+                             (Target   : in     GLenum;
+                              pName    : in     GLenum;
+                              Params   : access GLint);
+   procedure glHint          (Target   : in     GLenum;
+                              Mode     : in     GLenum);
+   function  glIsEnabled     (Cap      : in     GLenum)   return GLboolean;
+   procedure glLineWidth     (Width    : in     GLfloat);
+   procedure glPixelStorei   (pName    : in     GLenum;
+                              Param    : in     GLint);
+   procedure glPolygonOffset (Factor   : in     GLfloat;
+                              Units    : in     GLfloat);
+   procedure glReadPixels    (X        : in     GLint;
+                              Y        : in     GLint;
+                              Width    : in     GLsizei;
+                              Height   : in     GLsizei;
+                              Format   : in     GLenum;
+                              the_Type : in     GLenum;
+                              Pixels   : access GLvoid);
+   procedure glScissor       (X        : in     GLint;
+                              Y        : in     GLint;
+                              Width    : in     GLsizei;
+                              Height   : in     GLsizei);
+   procedure glStencilFunc   (Func     : in     GLenum;
+                              Ref      : in     GLint;
+                              Mask     : in     GLuint);
+   procedure glStencilMask   (Mask     : in     GLuint);
+   procedure glStencilOp     (Fail     : in     GLenum;
+                              zFail    : in     GLenum;
+                              zPass    : in     GLenum);
+   procedure glTexImage2D    (Target   : in     GLenum;
+                              Level    : in     GLint;
+                              internalFormat
+                                       : in     GLenum;
+                              Width    : in     GLsizei;
+                              Height   : in     GLsizei;
+                              Border   : in     GLint;
+                              Format   : in     GLenum;
+                              the_Type : in     GLenum;
+                              Pixels   : access GLvoid);
+   procedure glTexSubImage2D (Target   : in     GLenum;
+                              Level    : in     GLint;
+                              xOffset  : in     GLint;
+                              yOffset  : in     GLint;
+                              Width    : in     GLsizei;
+                              Height   : in     GLsizei;
+                              Format   : in     GLenum;
+                              the_Type : in     GLenum;
+                              Pixels   : access GLvoid);
+   procedure glTexParameteri (Target   : in     GLenum;
+                              pName    : in     GLenum;
+                              Param    : in     GLint);
+   procedure glViewport      (X        : in     GLint;
+                              Y        : in     GLint;
+                              Width    : in     GLsizei;
+                              Height   : in     GLsizei);
+
+
+private
+
+   pragma Import (StdCall, glActiveTexture,     "glActiveTexture");
+   pragma Import (Stdcall, glBindTexture,       "glBindTexture");
+   pragma Import (Stdcall, glBlendFunc,         "glBlendFunc");
+   pragma Import (Stdcall, glClear,             "glClear");
+   pragma Import (Stdcall, glClearColor,        "glClearColor");
+   pragma Import (Stdcall, glClearDepthf,       "glClearDepthf");
+   pragma Import (Stdcall, glClearStencil,      "glClearStencil");
+   pragma Import (Stdcall, glColorMask,         "glColorMask");
+   pragma Import (Stdcall, glCullFace,          "glCullFace");
+   pragma Import (Stdcall, glDepthFunc,         "glDepthFunc");
+   pragma Import (Stdcall, glDepthMask,         "glDepthMask");
+   pragma Import (Stdcall, glDepthRangef,       "glDepthRangef");
+   pragma Import (Stdcall, glDisable,           "glDisable");
+   pragma Import (Stdcall, glDrawArrays,        "glDrawArrays");
+   pragma Import (Stdcall, glDrawElements,      "glDrawElements");
+   pragma Import (Stdcall, glEnable,            "glEnable");
+   pragma Import (Stdcall, glFinish,            "glFinish");
+   pragma Import (Stdcall, glFlush,             "glFlush");
+   pragma Import (Stdcall, glFrontFace,         "glFrontFace");
+   pragma Import (Stdcall, glGenTextures,       "glGenTextures");
+   pragma Import (Stdcall, glGetError,          "glGetError");
+   pragma Import (StdCall, glGetBooleanv,       "glGetBooleanv");
+   pragma Import (StdCall, glGetFloatv,         "glGetFloatv");
+   pragma Import (StdCall, glGetIntegerv,       "glGetIntegerv");
+   pragma Import (StdCall, glGetString,         "glGetString");
+   pragma Import (StdCall, glGetTexParameteriv, "glGetTexParameteriv");
+   pragma Import (Stdcall, glHint,              "glHint");
+   pragma Import (Stdcall, glIsEnabled,         "glIsEnabled");
+   pragma Import (Stdcall, glLineWidth,         "glLineWidth");
+   pragma Import (Stdcall, glPixelStorei,       "glPixelStorei");
+   pragma Import (Stdcall, glPolygonOffset,     "glPolygonOffset");
+   pragma Import (StdCall, glReadPixels,        "glReadPixels");
+   pragma Import (Stdcall, glScissor,           "glScissor");
+   pragma Import (Stdcall, glStencilFunc,       "glStencilFunc");
+   pragma Import (Stdcall, glStencilMask,       "glStencilMask");
+   pragma Import (Stdcall, glStencilOp,         "glStencilOp");
+   pragma Import (StdCall, glTexImage2D,        "glTexImage2D");
+   pragma Import (StdCall, glTexSubImage2D,     "glTexSubImage2D");
+   pragma Import (Stdcall, glTexParameteri,     "glTexParameteri");
+   pragma Import (Stdcall, glViewport,          "glViewport");
+
+end gl.Binding;

3-mid/opengl/private/gl/source/gl-lean.ads

@@ -0,0 +1,626 @@
+with
+     Interfaces.C.Pointers,
+     System;
+
+package GL.lean
+--
+--  Provides types, constants and functions specific to the openGL 'Embedded' profile.
+--
+is
+   ---------
+   --  Types
+   --
+
+   subtype GLchar     is GL_Types.GLchar;
+   subtype GLfixed    is GL_Types.GLfixed;
+
+   type    GLintptr   is new Integer;
+   type    GLsizeiptr is new Integer;
+
+
+   --  GLchar_Pointer
+   --
+   type    GLchar_array    is array (C.size_t range <>) of aliased GLchar;
+   package GLchar_Pointers is new C.Pointers (Index              => C.size_t,
+                                              Element            => GLchar,
+                                              Element_Array      => GLchar_array,
+                                              Default_Terminator => C.nul);
+   subtype GLchar_Pointer  is GLchar_Pointers.Pointer;
+
+   subtype GLfloat_Address is system.Address;
+
+
+   -------------
+   --  Constants
+   --
+
+   GL_ACTIVE_ATTRIBUTES                  : constant := 16#8B89#;
+   GL_ACTIVE_ATTRIBUTE_MAX_LENGTH        : constant := 16#8B8A#;
+   GL_ACTIVE_UNIFORMS                    : constant := 16#8B86#;
+   GL_ACTIVE_UNIFORM_MAX_LENGTH          : constant := 16#8B87#;
+   GL_ARRAY_BUFFER                       : constant := 16#8892#;
+   GL_ARRAY_BUFFER_BINDING               : constant := 16#8894#;
+   GL_ATTACHED_SHADERS                   : constant := 16#8B85#;
+   GL_BLEND_COLOR                        : constant := 16#8005#;
+   GL_BLEND_DST_ALPHA                    : constant := 16#80CA#;
+   GL_BLEND_DST_RGB                      : constant := 16#80C8#;
+   GL_BLEND_EQUATION                     : constant := 16#8009#;
+   GL_BLEND_EQUATION_ALPHA               : constant := 16#883D#;
+   GL_BLEND_EQUATION_RGB                 : constant := 16#8009#;   -- Same as BLEND_EQUATION.
+   GL_BLEND_SRC_ALPHA                    : constant := 16#80CB#;
+   GL_BLEND_SRC_RGB                      : constant := 16#80C9#;
+   GL_BOOL                               : constant := 16#8B56#;
+   GL_BOOL_VEC2                          : constant := 16#8B57#;
+   GL_BOOL_VEC3                          : constant := 16#8B58#;
+   GL_BOOL_VEC4                          : constant := 16#8B59#;
+   GL_BUFFER_SIZE                        : constant := 16#8764#;
+   GL_BUFFER_USAGE                       : constant := 16#8765#;
+   GL_COLOR_ATTACHMENT0                  : constant := 16#8CE0#;
+   GL_COMPILE_STATUS                     : constant := 16#8B81#;
+   GL_COMPRESSED_TEXTURE_FORMATS         : constant := 16#86A3#;
+   GL_CONSTANT_ALPHA                     : constant := 16#8003#;
+   GL_CONSTANT_COLOR                     : constant := 16#8001#;
+   GL_CURRENT_PROGRAM                    : constant := 16#8B8D#;
+   GL_CURRENT_VERTEX_ATTRIB              : constant := 16#8626#;
+   GL_DECR_WRAP                          : constant := 16#8508#;
+   GL_DELETE_STATUS                      : constant := 16#8B80#;
+   GL_DEPTH_ATTACHMENT                   : constant := 16#8D00#;
+   GL_DEPTH_COMPONENT                    : constant := 16#1902#;
+   GL_DEPTH_COMPONENT16                  : constant := 16#81A5#;
+   GL_DITHER                             : constant := 16#0BD0#;
+   GL_DST_ALPHA                          : constant := 16#0304#;
+   GL_DST_COLOR                          : constant := 16#0306#;
+   GL_DYNAMIC_DRAW                       : constant := 16#88E8#;
+   GL_ELEMENT_ARRAY_BUFFER               : constant := 16#8893#;
+   GL_ELEMENT_ARRAY_BUFFER_BINDING       : constant := 16#8895#;
+   GL_ES_VERSION_2_0                     : constant := 1;
+   GL_FIXED                              : constant := 16#140C#;
+   GL_FLOAT_MAT2                         : constant := 16#8B5A#;
+   GL_FLOAT_MAT3                         : constant := 16#8B5B#;
+   GL_FLOAT_MAT4                         : constant := 16#8B5C#;
+   GL_FLOAT_VEC2                         : constant := 16#8B50#;
+   GL_FLOAT_VEC3                         : constant := 16#8B51#;
+   GL_FLOAT_VEC4                         : constant := 16#8B52#;
+   GL_FRAGMENT_SHADER                    : constant := 16#8B30#;
+   GL_FRAMEBUFFER                        : constant := 16#8D40#;
+   GL_FRAMEBUFFER_ATTACHMENT_OBJECT_NAME : constant := 16#8CD1#;
+   GL_FRAMEBUFFER_ATTACHMENT_OBJECT_TYPE : constant := 16#8CD0#;
+   GL_FRAMEBUFFER_ATTACHMENT_TEXTURE_CUBE_MAP_FACE
+                                         : constant := 16#8CD3#;
+   GL_FRAMEBUFFER_ATTACHMENT_TEXTURE_LEVEL
+                                         : constant := 16#8CD2#;
+   GL_FRAMEBUFFER_BINDING                : constant := 16#8CA6#;
+   GL_FRAMEBUFFER_COMPLETE               : constant := 16#8CD5#;
+   GL_FRAMEBUFFER_INCOMPLETE_ATTACHMENT  : constant := 16#8CD6#;
+   GL_FRAMEBUFFER_INCOMPLETE_DIMENSIONS  : constant := 16#8CD9#;
+   GL_FRAMEBUFFER_INCOMPLETE_MISSING_ATTACHMENT
+                                         : constant := 16#8CD7#;
+   GL_FRAMEBUFFER_UNSUPPORTED            : constant := 16#8CDD#;
+   GL_FUNC_ADD                           : constant := 16#8006#;
+   GL_FUNC_REVERSE_SUBTRACT              : constant := 16#800B#;
+   GL_FUNC_SUBTRACT                      : constant := 16#800A#;
+   GL_GENERATE_MIPMAP_HINT               : constant := 16#8192#;
+   GL_HIGH_FLOAT                         : constant := 16#8DF2#;
+   GL_HIGH_INT                           : constant := 16#8DF5#;
+   GL_IMPLEMENTATION_COLOR_READ_FORMAT   : constant := 16#8B9B#;
+   GL_IMPLEMENTATION_COLOR_READ_TYPE     : constant := 16#8B9A#;
+   GL_INCR_WRAP                          : constant := 16#8507#;
+   GL_INFO_LOG_LENGTH                    : constant := 16#8B84#;
+   GL_INT_VEC2                           : constant := 16#8B53#;
+   GL_INT_VEC3                           : constant := 16#8B54#;
+   GL_INT_VEC4                           : constant := 16#8B55#;
+   GL_INVALID_FRAMEBUFFER_OPERATION      : constant := 16#0506#;
+   GL_LINK_STATUS                        : constant := 16#8B82#;
+   GL_LOW_FLOAT                          : constant := 16#8DF0#;
+   GL_LOW_INT                            : constant := 16#8DF3#;
+   GL_MAX_COMBINED_TEXTURE_IMAGE_UNITS   : constant := 16#8B4D#;
+   GL_MAX_CUBE_MAP_TEXTURE_SIZE          : constant := 16#851C#;
+   GL_MAX_FRAGMENT_UNIFORM_VECTORS       : constant := 16#8DFD#;
+   GL_MAX_RENDERBUFFER_SIZE              : constant := 16#84E8#;
+   GL_MAX_TEXTURE_IMAGE_UNITS            : constant := 16#8872#;
+   GL_MAX_VARYING_VECTORS                : constant := 16#8DFC#;
+   GL_MAX_VERTEX_ATTRIBS                 : constant := 16#8869#;
+   GL_MAX_VERTEX_TEXTURE_IMAGE_UNITS     : constant := 16#8B4C#;
+   GL_MAX_VERTEX_UNIFORM_VECTORS         : constant := 16#8DFB#;
+   GL_MEDIUM_FLOAT                       : constant := 16#8DF1#;
+   GL_MEDIUM_INT                         : constant := 16#8DF4#;
+   GL_MIRRORED_REPEAT                    : constant := 16#8370#;
+   GL_NONE                               : constant := 0;
+   GL_NUM_COMPRESSED_TEXTURE_FORMATS     : constant := 16#86A2#;
+   GL_NUM_SHADER_BINARY_FORMATS          : constant := 16#8DF9#;
+   GL_ONE_MINUS_CONSTANT_ALPHA           : constant := 16#8004#;
+   GL_ONE_MINUS_CONSTANT_COLOR           : constant := 16#8002#;
+   GL_ONE_MINUS_DST_ALPHA                : constant := 16#0305#;
+   GL_ONE_MINUS_DST_COLOR                : constant := 16#0307#;
+   GL_ONE_MINUS_SRC_COLOR                : constant := 16#0301#;
+   GL_RENDERBUFFER                       : constant := 16#8D41#;
+   GL_RENDERBUFFER_ALPHA_SIZE            : constant := 16#8D53#;
+   GL_RENDERBUFFER_BINDING               : constant := 16#8CA7#;
+   GL_RENDERBUFFER_BLUE_SIZE             : constant := 16#8D52#;
+   GL_RENDERBUFFER_DEPTH_SIZE            : constant := 16#8D54#;
+   GL_RENDERBUFFER_GREEN_SIZE            : constant := 16#8D51#;
+   GL_RENDERBUFFER_HEIGHT                : constant := 16#8D43#;
+   GL_RENDERBUFFER_INTERNAL_FORMAT       : constant := 16#8D44#;
+   GL_RENDERBUFFER_RED_SIZE              : constant := 16#8D50#;
+   GL_RENDERBUFFER_STENCIL_SIZE          : constant := 16#8D55#;
+   GL_RENDERBUFFER_WIDTH                 : constant := 16#8D42#;
+   GL_RGB565                             : constant := 16#8D62#;
+   GL_RGB5_A1                            : constant := 16#8057#;
+   GL_RGBA4                              : constant := 16#8056#;
+   GL_SAMPLER_2D                         : constant := 16#8B5E#;
+   GL_SAMPLER_CUBE                       : constant := 16#8B60#;
+   GL_SAMPLES                            : constant := 16#80A9#;
+   GL_SAMPLE_ALPHA_TO_COVERAGE           : constant := 16#809E#;
+   GL_SAMPLE_BUFFERS                     : constant := 16#80A8#;
+   GL_SAMPLE_COVERAGE                    : constant := 16#80A0#;
+   GL_SAMPLE_COVERAGE_INVERT             : constant := 16#80AB#;
+   GL_SAMPLE_COVERAGE_VALUE              : constant := 16#80AA#;
+   GL_SHADER_BINARY_FORMATS              : constant := 16#8DF8#;
+   GL_SHADER_COMPILER                    : constant := 16#8DFA#;
+   GL_SHADER_SOURCE_LENGTH               : constant := 16#8B88#;
+   GL_SHADER_TYPE                        : constant := 16#8B4F#;
+   GL_SHADING_LANGUAGE_VERSION           : constant := 16#8B8C#;
+   GL_SHORT                              : constant := 16#1402#;
+   GL_SRC_COLOR                          : constant := 16#0300#;
+   GL_STATIC_DRAW                        : constant := 16#88E4#;
+   GL_STENCIL_ATTACHMENT                 : constant := 16#8D20#;
+   GL_STENCIL_BACK_FAIL                  : constant := 16#8801#;
+   GL_STENCIL_BACK_FUNC                  : constant := 16#8800#;
+   GL_STENCIL_BACK_PASS_DEPTH_FAIL       : constant := 16#8802#;
+   GL_STENCIL_BACK_PASS_DEPTH_PASS       : constant := 16#8803#;
+   GL_STENCIL_BACK_REF                   : constant := 16#8CA3#;
+   GL_STENCIL_BACK_VALUE_MASK            : constant := 16#8CA4#;
+   GL_STENCIL_BACK_WRITEMASK             : constant := 16#8CA5#;
+   GL_STENCIL_INDEX8                     : constant := 16#8D48#;
+   GL_STREAM_DRAW                        : constant := 16#88E0#;
+   GL_TEXTURE                            : constant := 16#1702#;
+   GL_TEXTURE_BINDING_CUBE_MAP           : constant := 16#8514#;
+   GL_TEXTURE_CUBE_MAP                   : constant := 16#8513#;
+   GL_TEXTURE_CUBE_MAP_NEGATIVE_X        : constant := 16#8516#;
+   GL_TEXTURE_CUBE_MAP_NEGATIVE_Y        : constant := 16#8518#;
+   GL_TEXTURE_CUBE_MAP_NEGATIVE_Z        : constant := 16#851A#;
+   GL_TEXTURE_CUBE_MAP_POSITIVE_X        : constant := 16#8515#;
+   GL_TEXTURE_CUBE_MAP_POSITIVE_Y        : constant := 16#8517#;
+   GL_TEXTURE_CUBE_MAP_POSITIVE_Z        : constant := 16#8519#;
+   GL_UNSIGNED_SHORT                     : constant := 16#1403#;
+   GL_UNSIGNED_SHORT_4_4_4_4             : constant := 16#8033#;
+   GL_UNSIGNED_SHORT_5_5_5_1             : constant := 16#8034#;
+   GL_UNSIGNED_SHORT_5_6_5               : constant := 16#8363#;
+   GL_VALIDATE_STATUS                    : constant := 16#8B83#;
+   GL_VERTEX_ATTRIB_ARRAY_BUFFER_BINDING : constant := 16#889F#;
+   GL_VERTEX_ATTRIB_ARRAY_ENABLED        : constant := 16#8622#;
+   GL_VERTEX_ATTRIB_ARRAY_NORMALIZED     : constant := 16#886A#;
+   GL_VERTEX_ATTRIB_ARRAY_Pointer        : constant := 16#8645#;
+   GL_VERTEX_ATTRIB_ARRAY_Size           : constant := 16#8623#;
+   GL_VERTEX_ATTRIB_ARRAY_STRIDE         : constant := 16#8624#;
+   GL_VERTEX_ATTRIB_ARRAY_TYPE           : constant := 16#8625#;
+   GL_VERTEX_SHADER                      : constant := 16#8B31#;
+
+
+   -------------
+   --  Functions
+   --
+
+   procedure glAttachShader            (Program         : in     GLuint;
+                                        Shader          : in     GLuint);
+   procedure glBindAttribLocation      (Program         : in     GLuint;
+                                        Index           : in     GLuint;
+                                        Name            : access GLchar);
+   procedure glBindBuffer              (Target          : in     GLenum;
+                                        Buffer          : in     GLuint);
+   procedure glBindFramebuffer         (Target          : in     GLenum;
+                                        FrameBuffer     : in     GLuint);
+   procedure glBindRenderbuffer        (Target          : in     GLenum;
+                                        RenderBuffer    : in     GLuint);
+   procedure glBlendColor              (Red             : in     GLclampf;
+                                        Green           : in     GLclampf;
+                                        Blue            : in     GLclampf;
+                                        Alpha           : in     GLclampf);
+   procedure glBlendEquation           (Mode            : in     GLenum);
+   procedure glBlendEquationSeparate   (modeRGB         : in     GLenum;
+                                        modeAlpha       : in     GLenum);
+   procedure glBlendFuncSeparate       (srcRGB          : in     GLenum;
+                                        dstRGB          : in     GLenum;
+                                        srcAlpha        : in     GLenum;
+                                        dstAlpha        : in     GLenum);
+   procedure glBufferData              (Target          : in     GLenum;
+                                        Size            : in     GLsizeiptr;
+                                        Data            : access GLvoid;
+                                        Usage           : in     GLenum);
+   procedure glBufferSubData           (Target          : in     GLenum;
+                                        Offset          : in     GLintptr;
+                                        Size            : in     GLsizeiptr;
+                                        Data            : access GLvoid);
+   function  glCheckFramebufferStatus  (Target          : in     GLenum) return GLenum;
+   procedure glCompileShader           (Shader          : in     GLuint);
+   procedure glCompressedTexImage2D    (Target          : in     GLenum;
+                                        Level           : in     GLint;
+                                        internalFormat  : in     GLenum;
+                                        Width           : in     GLsizei;
+                                        Height          : in     GLsizei;
+                                        Border          : in     GLint;
+                                        imageSize       : in     GLsizei;
+                                        Data            : access GLvoid);
+   procedure glCompressedTexSubImage2D (Target          : in     GLenum;
+                                        Level           : in     GLint;
+                                        xOffset         : in     GLint;
+                                        yOffset         : in     GLint;
+                                        Width           : in     GLsizei;
+                                        Height          : in     GLsizei;
+                                        format          : in     GLenum;
+                                        imageSize       : in     GLsizei;
+                                        Data            : access GLvoid);
+   procedure glCopyTexImage2D          (Target          : in     GLenum;
+                                        Level           : in     GLint;
+                                        internalFormat  : in     GLenum;
+                                        X               : in     GLint;
+                                        Y               : in     GLint;
+                                        Width           : in     GLsizei;
+                                        Height          : in     GLsizei;
+                                        Border          : in     GLint);
+   procedure glCopyTexSubImage2D       (Target          : in     GLenum;
+                                        Level           : in     GLint;
+                                        xOffset         : in     GLint;
+                                        yOffset         : in     GLint;
+                                        X               : in     GLint;
+                                        Y               : in     GLint;
+                                        Width           : in     GLsizei;
+                                        Height          : in     GLsizei);
+   function  glCreateProgram return GLuint;
+   function  glCreateShader             (the_Type       : in     GLenum) return GLuint;
+   procedure glDeleteBuffers            (N              : in     GLsizei;
+                                         Buffers        : access GLuint);
+   procedure glDeleteFramebuffers       (N              : in     GLsizei;
+                                         FrameBuffers   : access GLuint);
+   procedure glDeleteProgram            (Program        : in     GLuint);
+   procedure glDeleteRenderbuffers      (N              : in     GLsizei;
+                                         RenderBuffers  : access GLuint);
+   procedure glDeleteShader             (Shader         : in     GLuint);
+   procedure glDeleteTextures           (N              : in     GLsizei;
+                                         Textures       : access GLuint);
+   procedure glDetachShader             (Program        : in     GLuint;
+                                         Shader         : in     GLuint);
+   procedure glDisableVertexAttribArray (Index          : in     GLuint);
+   procedure glEnableVertexAttribArray  (Index          : in     GLuint);
+   procedure glFramebufferRenderbuffer  (Target         : in     GLenum;
+                                         Attachment     : in     GLenum;
+                                         RenderBufferTarget
+                                                        : in     GLenum;
+                                         RenderBuffer   : in     GLuint);
+   procedure glFramebufferTexture2D     (Target         : in     GLenum;
+                                         Attachment     : in     GLenum;
+                                         TexTarget      : in     GLenum;
+                                         Texture        : in     GLuint;
+                                         Level          : in     GLint);
+   procedure glGenBuffers               (N              : in     GLsizei;
+                                         Buffers        : access GLuint);
+   procedure glGenFramebuffers          (N              : in     GLsizei;
+                                         FrameBuffers   : access GLuint);
+   procedure glGenRenderbuffers         (N              : in     GLsizei;
+                                         RenderBuffers  : access GLuint);
+   procedure glGenerateMipmap           (Target         : in     GLenum);
+   procedure glGetActiveAttrib          (Program        : in     GLuint;
+                                         Index          : in     GLuint;
+                                         BufSize        : in     GLsizei;
+                                         Length         : access GLsizei;
+                                         Size           : access GLint;
+                                         the_Type       : access GLenum;
+                                         Name           : access GLchar);
+   procedure glGetActiveUniform         (Program        : in     GLuint;
+                                         Index          : in     GLuint;
+                                         BufSize        : in     GLsizei;
+                                         Length         : access GLsizei;
+                                         Size           : access GLint;
+                                         the_Type       : access GLenum;
+                                         Name           : access GLchar);
+   procedure glGetAttachedShaders       (Program        : in     GLuint;
+                                         maxCount       : in     GLsizei;
+                                         Count          : access GLsizei;
+                                         Shaders        : access GLuint);
+   function glGetAttribLocation         (Program        : in     GLuint;
+                                         Name           : access GLchar) return Interfaces.C.int;
+   procedure glGetBufferParameteriv     (Target         : in     GLenum;
+                                         pName          : in     GLenum;
+                                         Params         : access GLint);
+   procedure glGetFramebufferAttachmentParameteriv
+                                        (Target         : in     GLenum;
+                                         Attachment     : in     GLenum;
+                                         pName          : in     GLenum;
+                                         Params         : access GLint);
+   procedure glGetProgramiv             (Program        : in     GLuint;
+                                         pName          : in     GLenum;
+                                         Params         : access GLint);
+   procedure glGetProgramInfoLog        (Program        : in     GLuint;
+                                         BufSize        : in     GLsizei;
+                                         Length         : access GLsizei;
+                                         infoLog        : access GLchar);
+   procedure glGetRenderbufferParameteriv
+                                        (Target         : in     GLenum;
+                                         pName          : in     GLenum;
+                                         Params         : access GLint);
+   procedure glGetShaderiv              (Shader         : in     GLuint;
+                                         pName          : in     GLenum;
+                                         Params         : access GLint);
+   procedure glGetShaderInfoLog         (Shader         : in     GLuint;
+                                         BufSize        : in     GLsizei;
+                                         Length         : access GLsizei;
+                                         infoLog        : access GLchar);
+   procedure glGetShaderPrecisionFormat (ShaderType     : in     GLenum;
+                                         PrecisionType  : in     GLenum;
+                                         the_Range      : access GLint;
+                                         Precision      : access GLint);
+   procedure glGetShaderSource          (Shader         : in     GLuint;
+                                         BufSize        : in     GLsizei;
+                                         Length         : access GLsizei;
+                                         Source         : access GLchar);
+   procedure glGetTexParameterfv        (Target         : in     GLenum;
+                                         pName          : in     GLenum;
+                                         Params         : in     GLfloat_Address);
+   procedure glGetUniformfv             (Program        : in     GLuint;
+                                         Location       : in     GLint;
+                                         Params         : in     GLfloat_Address);
+   procedure glGetUniformiv             (Program        : in     GLuint;
+                                         Location       : in     GLint;
+                                         Params         : access GLint);
+   function  glGetUniformLocation       (Program        : in     GLuint;
+                                         Name           : access GLchar) return Interfaces.C.int;
+   procedure glGetVertexAttribfv        (Index          : in     GLuint;
+                                         pName          : in     GLenum;
+                                         Params         : in     GLfloat_Address);
+   procedure glGetVertexAttribiv        (Index          : in     GLuint;
+                                         pName          : in     GLenum;
+                                         Params         : access GLint);
+   procedure glGetVertexAttribPointerv  (Index          : in     GLuint;
+                                         pName          : in     GLenum;
+                                         Pointer        : access GLvoid);
+   function  glIsBuffer                 (Buffer         : in     GLuint) return GLboolean;
+   function  glIsFramebuffer            (FrameBuffer    : in     GLuint) return GLboolean;
+   function  glIsProgram                (Program        : in     GLuint) return GLboolean;
+   function  glIsRenderbuffer           (RenderBuffer   : in     GLuint) return GLboolean;
+   function  glIsShader                 (Shader         : in     GLuint) return GLboolean;
+   function  glIsTexture                (Texture        : in     GLuint) return GLboolean;
+   procedure glLinkProgram              (Program        : in     GLuint);
+   procedure glReleaseShaderCompiler;
+   procedure glRenderbufferStorage      (Target         : in     GLenum;
+                                         internalFormat : in     GLenum;
+                                         Width          : in     GLsizei;
+                                         Height         : in     GLsizei);
+   procedure glSampleCoverage           (Value          : in     GLclampf;
+                                         Invert         : in     GLboolean);
+   procedure glShaderBinary             (N              : in     GLint;
+                                         Shaders        : access GLuint;
+                                         BinaryFormat   : in     GLenum;
+                                         Binary         : access GLvoid;
+                                         Length         : in     GLint);
+   procedure glShaderSource             (Shader         : in     GLuint;
+                                         Count          : in     GLsizei;
+                                         String         : access GLchar_Pointer;
+                                         Length         : access GLint);
+   procedure glStencilFuncSeparate      (Face           : in     GLenum;
+                                         Func           : in     GLenum;
+                                         Ref            : in     GLint;
+                                         Mask           : in     GLuint);
+   procedure glStencilMaskSeparate      (Face           : in     GLenum;
+                                         Mask           : in     GLuint);
+   procedure glStencilOpSeparate        (Face           : in     GLenum;
+                                         Fail           : in     GLenum;
+                                         zFail          : in     GLenum;
+                                         zPass          : in     GLenum);
+   procedure glTexParameterf            (Target         : in     GLenum;
+                                         pName          : in     GLenum;
+                                         Param          : in     GLfloat);
+   procedure glTexParameterfv           (Target         : in     GLenum;
+                                         pName          : in     GLenum;
+                                         Params         : in     GLfloat_Address);
+   procedure glTexParameteriv           (Target         : in     GLenum;
+                                         pName          : in     GLenum;
+                                         Params         : access GLint);
+   procedure glUniform1f                (Location       : in     GLint;
+                                         X              : in     GLfloat);
+   procedure glUniform1fv               (Location       : in     GLint;
+                                         Count          : in     GLsizei;
+                                         V              : in     GLfloat_Address);
+   procedure glUniform1i                (Location       : in     GLint;
+                                         X              : in     GLint);
+   procedure glUniform1iv               (Location       : in     GLint;
+                                         Count          : in     GLsizei;
+                                         V              : access GLint);
+   procedure glUniform2f                (Location       : in     GLint;
+                                         X              : in     GLfloat;
+                                         Y              : in     GLfloat);
+   procedure glUniform2fv               (Location       : in     GLint;
+                                         Count          : in     GLsizei;
+                                         V              : in     GLfloat_Address);
+   procedure glUniform2i                (Location       : in     GLint;
+                                         X              : in     GLint;
+                                         Y              : in     GLint);
+   procedure glUniform2iv               (Location       : in     GLint;
+                                         Count          : in     GLsizei;
+                                         V              : access GLint);
+   procedure glUniform3f                (Location       : in     GLint;
+                                         X              : in     GLfloat;
+                                         Y              : in     GLfloat;
+                                         Z              : in     GLfloat);
+   procedure glUniform3fv               (Location       : in     GLint;
+                                         Count          : in     GLsizei;
+                                         V              : in     GLfloat_Address);
+   procedure glUniform3i                (Location       : in     GLint;
+                                         X              : in     GLint;
+                                         Y              : in     GLint;
+                                         Z              : in     GLint);
+   procedure glUniform3iv               (Location       : in     GLint;
+                                         Count          : in     GLsizei;
+                                         V              : access GLint);
+   procedure glUniform4f                (Location       : in     GLint;
+                                         X              : in     GLfloat;
+                                         Y              : in     GLfloat;
+                                         Z              : in     GLfloat;
+                                         W              : in     GLfloat);
+   procedure glUniform4fv               (Location       : in     GLint;
+                                         Count          : in     GLsizei;
+                                         V              : in     GLfloat_Address);
+   procedure glUniform4i                (Location       : in     GLint;
+                                         X              : in     GLint;
+                                         Y              : in     GLint;
+                                         Z              : in     GLint;
+                                         W              : in     GLint);
+   procedure glUniform4iv               (Location       : in     GLint;
+                                         Count          : in     GLsizei;
+                                         V              : access GLint);
+   procedure glUniformMatrix2fv         (Location       : in     GLint;
+                                         Count          : in     GLsizei;
+                                         Transpose      : in     GLboolean;
+                                         Value          : in     GLfloat_Address);
+   procedure glUniformMatrix3fv         (Location       : in     GLint;
+                                         Count          : in     GLsizei;
+                                         Transpose      : in     GLboolean;
+                                         Value          : in     GLfloat_Address);
+   procedure glUniformMatrix4fv         (Location       : in     GLint;
+                                         Count          : in     GLsizei;
+                                         Transpose      : in GLboolean;
+                                         Value          : in     GLfloat_Address);
+   procedure glUseProgram               (Program        : in     GLuint);
+   procedure glValidateProgram          (Program        : in     GLuint);
+   procedure glVertexAttrib1f           (Index          : in     GLuint;
+                                         X              : in     GLfloat);
+   procedure glVertexAttrib1fv          (Index          : in     GLuint;
+                                         Values         : in     GLfloat_Address);
+   procedure glVertexAttrib2f           (Index          : in     GLuint;
+                                         X              : in     GLfloat;
+                                         Y              : in     GLfloat);
+   procedure glVertexAttrib2fv          (Index          : in     GLuint;
+                                         Values         : in     GLfloat_Address);
+   procedure glVertexAttrib3f           (Index          : in     GLuint;
+                                         X              : in     GLfloat;
+                                         Y              : in     GLfloat;
+                                         Z              : in     GLfloat);
+   procedure glVertexAttrib3fv          (Index          : in     GLuint;
+                                         Values         : in     GLfloat_Address);
+   procedure glVertexAttrib4f           (Index          : in     GLuint;
+                                         X              : in     GLfloat;
+                                         Y              : in     GLfloat;
+                                         Z              : in     GLfloat;
+                                         W              : in     GLfloat);
+   procedure glVertexAttrib4fv          (Index          : in     GLuint;
+                                         Values         : in     GLfloat_Address);
+   procedure glVertexAttribPointer      (Index          : in     GLuint;
+                                         Size           : in     GLint;
+                                         the_Type       : in     GLenum;
+                                         Normalized     : in     GLboolean;
+                                         Stride         : in     GLsizei;
+                                         Ptr            : access GLvoid);
+
+private
+
+   for GLintptr  'Size use standard'Address_Size;
+   for GLsizeiptr'Size use standard'Address_Size;
+
+
+   -------------
+   --  Functions
+   --
+   pragma Import (StdCall, glAttachShader,               "glAttachShader");
+   pragma Import (StdCall, glBindAttribLocation,         "glBindAttribLocation");
+   pragma Import (StdCall, glBindBuffer,                 "glBindBuffer");
+   pragma Import (StdCall, glBindFramebuffer,            "glBindFramebuffer");
+   pragma Import (StdCall, glBindRenderbuffer,           "glBindRenderbuffer");
+   pragma Import (StdCall, glBlendColor,                 "glBlendColor");
+   pragma Import (StdCall, glBlendEquation,              "glBlendEquation");
+   pragma Import (StdCall, glBlendEquationSeparate,      "glBlendEquationSeparate");
+   pragma Import (StdCall, glBlendFuncSeparate,          "glBlendFuncSeparate");
+   pragma Import (StdCall, glBufferData,                 "glBufferData");
+   pragma Import (StdCall, glBufferSubData,              "glBufferSubData");
+   pragma Import (StdCall, glCheckFramebufferStatus,     "glCheckFramebufferStatus");
+   pragma Import (StdCall, glCompileShader,              "glCompileShader");
+   pragma Import (StdCall, glCompressedTexImage2D,       "glCompressedTexImage2D");
+   pragma Import (StdCall, glCompressedTexSubImage2D,    "glCompressedTexSubImage2D");
+   pragma Import (StdCall, glCopyTexImage2D,             "glCopyTexImage2D");
+   pragma Import (StdCall, glCopyTexSubImage2D,          "glCopyTexSubImage2D");
+   pragma Import (StdCall, glCreateProgram,              "glCreateProgram");
+   pragma Import (StdCall, glCreateShader,               "glCreateShader");
+   pragma Import (StdCall, glDeleteBuffers,              "glDeleteBuffers");
+   pragma Import (StdCall, glDeleteFramebuffers,         "glDeleteFramebuffers");
+   pragma Import (StdCall, glDeleteProgram,              "glDeleteProgram");
+   pragma Import (StdCall, glDeleteRenderbuffers,        "glDeleteRenderbuffers");
+   pragma Import (StdCall, glDeleteShader,               "glDeleteShader");
+   pragma Import (StdCall, glDeleteTextures,             "glDeleteTextures");
+   pragma Import (StdCall, glDetachShader,               "glDetachShader");
+   pragma Import (StdCall, glDisableVertexAttribArray,   "glDisableVertexAttribArray");
+   pragma Import (StdCall, glEnableVertexAttribArray,    "glEnableVertexAttribArray");
+   pragma Import (StdCall, glFramebufferRenderbuffer,    "glFramebufferRenderbuffer");
+   pragma Import (StdCall, glFramebufferTexture2D,       "glFramebufferTexture2D");
+   pragma Import (StdCall, glGenBuffers,                 "glGenBuffers");
+   pragma Import (StdCall, glGenerateMipmap,             "glGenerateMipmap");
+   pragma Import (StdCall, glGenFramebuffers,            "glGenFramebuffers");
+   pragma Import (StdCall, glGenRenderbuffers,           "glGenRenderbuffers");
+   pragma Import (StdCall, glGetActiveAttrib,            "glGetActiveAttrib");
+   pragma Import (StdCall, glGetActiveUniform,           "glGetActiveUniform");
+   pragma Import (StdCall, glGetAttachedShaders,         "glGetAttachedShaders");
+   pragma Import (StdCall, glGetAttribLocation,          "glGetAttribLocation");
+   pragma Import (StdCall, glGetBufferParameteriv,       "glGetBufferParameteriv");
+   pragma Import (StdCall, glGetFramebufferAttachmentParameteriv,
+                                                         "glGetFramebufferAttachmentParameteriv");
+   pragma Import (StdCall, glGetProgramiv,               "glGetProgramiv");
+   pragma Import (StdCall, glGetProgramInfoLog,          "glGetProgramInfoLog");
+   pragma Import (StdCall, glGetRenderbufferParameteriv, "glGetRenderbufferParameteriv");
+   pragma Import (StdCall, glGetShaderiv,                "glGetShaderiv");
+   pragma Import (StdCall, glGetShaderInfoLog,           "glGetShaderInfoLog");
+   pragma Import (StdCall, glGetShaderPrecisionFormat,   "glGetShaderPrecisionFormat");
+   pragma Import (StdCall, glGetShaderSource,            "glGetShaderSource");
+   pragma Import (StdCall, glGetTexParameterfv,          "glGetTexParameterfv");
+   pragma Import (StdCall, glGetUniformfv,               "glGetUniformfv");
+   pragma Import (StdCall, glGetUniformiv,               "glGetUniformiv");
+   pragma Import (StdCall, glGetUniformLocation,         "glGetUniformLocation");
+   pragma Import (StdCall, glGetVertexAttribfv,          "glGetVertexAttribfv");
+   pragma Import (StdCall, glGetVertexAttribiv,          "glGetVertexAttribiv");
+   pragma Import (StdCall, glGetVertexAttribPointerv,    "glGetVertexAttribPointerv");
+   pragma Import (StdCall, glIsBuffer,                   "glIsBuffer");
+   pragma Import (StdCall, glIsFramebuffer,              "glIsFramebuffer");
+   pragma Import (StdCall, glIsProgram,                  "glIsProgram");
+   pragma Import (StdCall, glIsRenderbuffer,             "glIsRenderbuffer");
+   pragma Import (StdCall, glIsShader,                   "glIsShader");
+   pragma Import (StdCall, glIsTexture,                  "glIsTexture");
+   pragma Import (StdCall, glLinkProgram,                "glLinkProgram");
+   pragma Import (StdCall, glReleaseShaderCompiler,      "glReleaseShaderCompiler");
+   pragma Import (StdCall, glRenderbufferStorage,        "glRenderbufferStorage");
+   pragma Import (StdCall, glSampleCoverage,             "glSampleCoverage");
+   pragma Import (StdCall, glShaderBinary,               "glShaderBinary");
+   pragma Import (StdCall, glShaderSource,               "glShaderSource");
+   pragma Import (StdCall, glStencilFuncSeparate,        "glStencilFuncSeparate");
+   pragma Import (StdCall, glStencilMaskSeparate,        "glStencilMaskSeparate");
+   pragma Import (StdCall, glStencilOpSeparate,          "glStencilOpSeparate");
+   pragma Import (StdCall, glTexParameterf,              "glTexParameterf");
+   pragma Import (StdCall, glTexParameterfv,             "glTexParameterfv");
+   pragma Import (StdCall, glTexParameteriv,             "glTexParameteriv");
+   pragma Import (StdCall, glUniform1f,                  "glUniform1f");
+   pragma Import (StdCall, glUniform1fv,                 "glUniform1fv");
+   pragma Import (StdCall, glUniform1i,                  "glUniform1i");
+   pragma Import (StdCall, glUniform1iv,                 "glUniform1iv");
+   pragma Import (StdCall, glUniform2f,                  "glUniform2f");
+   pragma Import (StdCall, glUniform2fv,                 "glUniform2fv");
+   pragma Import (StdCall, glUniform2i,                  "glUniform2i");
+   pragma Import (StdCall, glUniform2iv,                 "glUniform2iv");
+   pragma Import (StdCall, glUniform3f,                  "glUniform3f");
+   pragma Import (StdCall, glUniform3fv,                 "glUniform3fv");
+   pragma Import (StdCall, glUniform3i,                  "glUniform3i");
+   pragma Import (StdCall, glUniform3iv,                 "glUniform3iv");
+   pragma Import (StdCall, glUniform4f,                  "glUniform4f");
+   pragma Import (StdCall, glUniform4fv,                 "glUniform4fv");
+   pragma Import (StdCall, glUniform4i,                  "glUniform4i");
+   pragma Import (StdCall, glUniform4iv,                 "glUniform4iv");
+   pragma Import (StdCall, glUniformMatrix2fv,           "glUniformMatrix2fv");
+   pragma Import (StdCall, glUniformMatrix3fv,           "glUniformMatrix3fv");
+   pragma Import (StdCall, glUniformMatrix4fv,           "glUniformMatrix4fv");
+   pragma Import (StdCall, glUseProgram,                 "glUseProgram");
+   pragma Import (StdCall, glValidateProgram,            "glValidateProgram");
+   pragma Import (StdCall, glVertexAttrib1f,             "glVertexAttrib1f");
+   pragma Import (StdCall, glVertexAttrib1fv,            "glVertexAttrib1fv");
+   pragma Import (StdCall, glVertexAttrib2f,             "glVertexAttrib2f");
+   pragma Import (StdCall, glVertexAttrib2fv,            "glVertexAttrib2fv");
+   pragma Import (StdCall, glVertexAttrib3f,             "glVertexAttrib3f");
+   pragma Import (StdCall, glVertexAttrib3fv,            "glVertexAttrib3fv");
+   pragma Import (StdCall, glVertexAttrib4f,             "glVertexAttrib4f");
+   pragma Import (StdCall, glVertexAttrib4fv,            "glVertexAttrib4fv");
+   pragma Import (StdCall, glVertexAttribPointer,        "glVertexAttribPointer");
+
+end GL.lean;

3-mid/opengl/private/gl/source/gl-pointers.adb

@@ -0,0 +1,52 @@
+with
+     ada.unchecked_Conversion,
+     system.Address_to_Access_Conversions;
+
+package body GL.Pointers
+is
+
+   type GLvoid_access         is access all GLvoid;
+   type GLchar_access         is access all lean.GLchar;
+   type GLchar_Pointer_access is access all lean.GLchar_Pointer;
+   type chars_ptr_access      is access all C.strings.chars_ptr;
+
+   package Conversions is new system.Address_To_Access_Conversions (GLvoid);
+
+
+
+   function to_GLvoid_access (From : in system.Address) return access GLvoid
+   is
+   begin
+      return Conversions.to_Pointer (From);
+   end to_GLvoid_access;
+
+
+
+   function to_GLvoid_access (From : access C.unsigned_char) return access GLvoid
+   is
+      type unsigned_Char_access is access all C.unsigned_char;
+      function Convert is new ada.unchecked_Conversion (unsigned_Char_access, GLvoid_access);
+   begin
+      return Convert (unsigned_Char_access (From));
+   end to_GLvoid_access;
+
+
+
+   function to_GLchar_access (From : in C.Strings.chars_ptr) return access lean.GLchar
+   is
+      function Convert is new ada.unchecked_Conversion (C.Strings.chars_ptr, GLchar_access);
+   begin
+      return Convert (From);
+   end to_GLchar_access;
+
+
+
+   function to_GLchar_Pointer_access (From : access C.Strings.chars_ptr_array) return access lean.GLchar_Pointer
+   is
+      function Convert is new ada.unchecked_Conversion (chars_ptr_access, GLchar_Pointer_access);
+   begin
+      return Convert (From (From'First)'unchecked_Access);
+   end to_GLchar_Pointer_access;
+
+
+end GL.Pointers;

3-mid/opengl/private/gl/source/gl-pointers.ads

@@ -0,0 +1,23 @@
+with
+     GL.lean,
+     Interfaces.C.Strings,
+     System;
+
+package GL.Pointers
+--
+--  Provides pointer conversions.
+--
+is
+   function to_GLvoid_access (From : in     system.Address)      return access GLvoid;
+   function to_GLvoid_access (From : access C.unsigned_char)     return access GLvoid;
+   function to_GLchar_access (From : in     C.Strings.chars_ptr) return access lean.GLchar;
+
+   function to_GLchar_Pointer_access
+                             (From : access C.Strings.chars_ptr_array)
+                                                                 return access lean.GLchar_Pointer;
+
+   function "+" (From : in     system.Address)      return access GLvoid      renames to_GLvoid_access;
+   function "+" (From : access C.unsigned_char)     return access GLvoid      renames to_GLvoid_access;
+   function "+" (From : in     C.Strings.chars_ptr) return access lean.GLchar renames to_GLchar_access;
+
+end GL.Pointers;

3-mid/opengl/private/gl/source/gl-safe.ads

@@ -0,0 +1,379 @@
+with
+     Interfaces.C.Pointers;
+
+package GL.safe
+--
+--  Provides types, constants and functions specific to the openGL 'Safety Critical' profile.
+--
+is
+   ---------
+   --  Types
+   --
+
+   --  GLubyte_Pointer
+   --
+   package GLubyte_Pointers is new C.Pointers (Index              => C.size_t,
+                                               Element            => GLubyte,
+                                               Element_Array      => GLubyte_array,
+                                               Default_Terminator => 0);
+   subtype GLubyte_Pointer  is GLubyte_Pointers.Pointer;
+
+
+   --  GLint_Pointer
+   --
+   package GLint_Pointers is new C.Pointers (Index              => C.size_t,
+                                             Element            => GLint,
+                                             Element_Array      => GLint_array,
+                                             Default_Terminator => 0);
+   subtype GLint_Pointer  is GLint_Pointers.Pointer;
+
+
+   --  GLfloat_Pointer
+   --
+   package GLfloat_Pointers is new C.Pointers (Index              => C.size_t,
+                                               Element            => GLfloat,
+                                               Element_Array      => GLfloat_array,
+                                               Default_Terminator => 0.0);
+   subtype GLfloat_Pointer  is GLfloat_Pointers.Pointer;
+
+
+   --  GLvoid_Pointer
+   --
+   package GLvoid_Pointers is new C.Pointers (Index              => C.size_t,
+                                              Element            => GLvoid,
+                                              Element_Array      => GLvoid_array,
+                                              Default_Terminator => 0);
+   subtype GLvoid_Pointer  is GLvoid_Pointers.Pointer;
+
+
+   --  GLvoid_Pointer_Pointer
+   --
+   type    GLvoid_Pointer_array    is array (C.size_t range <>) of aliased GLvoid_Pointer;
+   package GLvoid_Pointer_Pointers is new C.Pointers (Index              => C.size_t,
+                                                      Element            => GLvoid_Pointer,
+                                                      Element_Array      => GLvoid_Pointer_array,
+                                                      Default_Terminator => null);
+   subtype GLvoid_Pointer_Pointer  is GLvoid_Pointer_Pointers.Pointer;
+
+
+
+   -------------
+   --  Constants
+   --
+
+   GL_ADD                            : constant := 16#0104#;
+   GL_ALPHA_TEST                     : constant := 16#0BC0#;
+   GL_ALPHA_TEST_FUNC                : constant := 16#0BC1#;
+   GL_ALPHA_TEST_REF                 : constant := 16#0BC2#;
+   GL_AMBIENT                        : constant := 16#1200#;
+   GL_AMBIENT_AND_DIFFUSE            : constant := 16#1602#;
+   GL_BLEND_DST                      : constant := 16#0BE0#;
+   GL_BLEND_SRC                      : constant := 16#0BE1#;
+   GL_CLIENT_ACTIVE_TEXTURE          : constant := 16#84E1#;
+   GL_COLOR                          : constant := 16#1800#;
+   GL_COLOR_ARRAY                    : constant := 16#8076#;
+   GL_COLOR_ARRAY_POINTER            : constant := 16#8090#;
+   GL_COLOR_ARRAY_SIZE               : constant := 16#8081#;
+   GL_COLOR_ARRAY_STRIDE             : constant := 16#8083#;
+   GL_COLOR_ARRAY_TYPE               : constant := 16#8082#;
+   GL_COLOR_INDEX                    : constant := 16#1900#;
+   GL_COLOR_INDEX8_EXT               : constant := 16#80E5#;
+   GL_COLOR_MATERIAL                 : constant := 16#0B57#;
+   GL_COLOR_TABLE_ALPHA_SIZE         : constant := 16#80DD#;
+   GL_COLOR_TABLE_BLUE_SIZE          : constant := 16#80DC#;
+   GL_COLOR_TABLE_FORMAT             : constant := 16#80D8#;
+   GL_COLOR_TABLE_GREEN_SIZE         : constant := 16#80DB#;
+   GL_COLOR_TABLE_INTENSITY_SIZE     : constant := 16#80DF#;
+   GL_COLOR_TABLE_LUMINANCE_SIZE     : constant := 16#80DE#;
+   GL_COLOR_TABLE_RED_Size           : constant := 16#80DA#;
+   GL_COLOR_TABLE_WIDTH              : constant := 16#80D9#;
+   GL_COMPILE                        : constant := 16#1300#;
+   GL_CURRENT_COLOR                  : constant := 16#0B00#;
+   GL_CURRENT_NORMAL                 : constant := 16#0B02#;
+   GL_CURRENT_RASTER_COLOR           : constant := 16#0B04#;
+   GL_CURRENT_RASTER_TEXTURE_COORDS  : constant := 16#0B06#;
+   GL_CURRENT_TEXTURE_COORDS         : constant := 16#0B03#;
+   GL_DECAL                          : constant := 16#2101#;
+   GL_DIFFUSE                        : constant := 16#1201#;
+   GL_EMISSION                       : constant := 16#1600#;
+   GL_EXT_paletted_texture           : constant := 1;
+   GL_FLAT                           : constant := 16#1D00#;
+   GL_LIGHT0                         : constant := 16#4000#;
+   GL_LIGHT1                         : constant := 16#4001#;
+   GL_LIGHTING                       : constant := 16#0B50#;
+   GL_LIGHT_MODEL_AMBIENT            : constant := 16#0B53#;
+   GL_LINE_SMOOTH                    : constant := 16#0B20#;
+   GL_LINE_SMOOTH_HINT               : constant := 16#0C52#;
+   GL_LINE_STIPPLE                   : constant := 16#0B24#;
+   GL_LINE_STIPPLE_PATTERN           : constant := 16#0B25#;
+   GL_LINE_STIPPLE_REPEAT            : constant := 16#0B26#;
+   GL_LIST_BASE                      : constant := 16#0B32#;
+   GL_MATRIX_MODE                    : constant := 16#0BA0#;
+   GL_MAX_ELEMENTS_INDICES           : constant := 16#80E9#;
+   GL_MAX_ELEMENTS_VERTICES          : constant := 16#80E8#;
+   GL_MAX_LIGHTS                     : constant := 16#0D31#;
+   GL_MAX_LIST_NESTING               : constant := 16#0B31#;
+   GL_MAX_MODELVIEW_STACK_DEPTH      : constant := 16#0D36#;
+   GL_MAX_PROJECTION_STACK_DEPTH     : constant := 16#0D38#;
+   GL_MAX_TEXTURE_UNITS              : constant := 16#84E2#;
+   GL_MODELVIEW                      : constant := 16#1700#;
+   GL_MODELVIEW_MATRIX               : constant := 16#0BA6#;
+   GL_MODELVIEW_STACK_DEPTH          : constant := 16#0BA3#;
+   GL_MODULATE                       : constant := 16#2100#;
+   GL_NORMALIZE                      : constant := 16#0BA1#;
+   GL_NORMAL_ARRAY                   : constant := 16#8075#;
+   GL_NORMAL_ARRAY_POINTER           : constant := 16#808F#;
+   GL_NORMAL_ARRAY_STRIDE            : constant := 16#807F#;
+   GL_NORMAL_ARRAY_TYPE              : constant := 16#807E#;
+   GL_OES_single_precision           : constant := 1;
+   GL_OSC_VERSION_1_0                : constant := 1;
+   GL_PERSPECTIVE_CORRECTION_HINT    : constant := 16#0C50#;
+   GL_POINT_SIZE                     : constant := 16#0B11#;
+   GL_POINT_SMOOTH                   : constant := 16#0B10#;
+   GL_POINT_SMOOTH_HINT              : constant := 16#0C51#;
+   GL_POLYGON_SMOOTH_HINT            : constant := 16#0C53#;
+   GL_POLYGON_STIPPLE                : constant := 16#0B42#;
+   GL_POSITION                       : constant := 16#1203#;
+   GL_PROJECTION                     : constant := 16#1701#;
+   GL_PROJECTION_MATRIX              : constant := 16#0BA7#;
+   GL_PROJECTION_STACK_DEPTH         : constant := 16#0BA4#;
+   GL_RESCALE_NORMAL                 : constant := 16#803A#;
+   GL_SHADE_MODEL                    : constant := 16#0B54#;
+   GL_SHININESS                      : constant := 16#1601#;
+   GL_SMOOTH                         : constant := 16#1D01#;
+   GL_SMOOTH_LINE_WIDTH_GRANULARITY  : constant := 16#0B23#;
+   GL_SMOOTH_LINE_WIDTH_RANGE        : constant := 16#0B22#;
+   GL_SMOOTH_POINT_SIZE_GRANULARITY  : constant := 16#0B13#;
+   GL_SMOOTH_POINT_SIZE_RANGE        : constant := 16#0B12#;
+   GL_SPECULAR                       : constant := 16#1202#;
+   GL_STACK_OVERFLOW                 : constant := 16#0503#;
+   GL_STACK_UNDERFLOW                : constant := 16#0504#;
+   GL_TEXTURE_COORD_ARRAY            : constant := 16#8078#;
+   GL_TEXTURE_COORD_ARRAY_POINTER    : constant := 16#8092#;
+   GL_TEXTURE_COORD_ARRAY_SIZE       : constant := 16#8088#;
+   GL_TEXTURE_COORD_ARRAY_STRIDE     : constant := 16#808A#;
+   GL_TEXTURE_COORD_ARRAY_TYPE       : constant := 16#8089#;
+   GL_TEXTURE_ENV                    : constant := 16#2300#;
+   GL_TEXTURE_ENV_COLOR              : constant := 16#2201#;
+   GL_TEXTURE_ENV_MODE               : constant := 16#2200#;
+   GL_VERTEX_ARRAY                   : constant := 16#8074#;
+   GL_VERTEX_ARRAY_POINTER           : constant := 16#808E#;
+   GL_VERTEX_ARRAY_SIZE              : constant := 16#807A#;
+   GL_VERTEX_ARRAY_STRIDE            : constant := 16#807C#;
+   GL_VERTEX_ARRAY_TYPE              : constant := 16#807B#;
+
+
+   --------------
+   --   Functions
+   --
+
+   procedure glAlphaFunc           (Func           : in     GLenum;
+                                    Ref            : in     GLclampf);
+   procedure glBegin               (Mode           : in     GLenum);
+   procedure glBitmap              (Width          : in     GLsizei;
+                                    Height         : in     GLsizei;
+                                    xOrig          : in     GLfloat;
+                                    yOrig          : in     GLfloat;
+                                    xMove          : in     GLfloat;
+                                    yMove          : in     GLfloat;
+                                    Bitmap         : in     GLubyte_Pointer);
+   procedure glCallLists           (N              : in     GLsizei;
+                                    the_Type       : in     GLenum;
+                                    Lists          : in     GLvoid_Pointer);
+   procedure glClientActiveTexture (Texture        : in     GLenum);
+   procedure glColor4f             (Red            : in     GLfloat;
+                                    Green          : in     GLfloat;
+                                    Blue           : in     GLfloat;
+                                    Alpha          : in     GLfloat);
+   procedure glColor4fv            (V              : in     GLfloat_Pointer);
+   procedure glColor4ub            (Red            : in     GLubyte;
+                                    Green          : in     GLubyte;
+                                    Blue           : in     GLubyte;
+                                    Alpha          : in     GLubyte);
+   procedure glColorPointer        (Size           : in     GLint;
+                                    the_Type       : in     GLenum;
+                                    Stride         : in     GLsizei;
+                                    Ptr            : in     GLvoid_Pointer);
+   procedure glCopyPixels          (X              : in     GLint;
+                                    Y              : in     GLint;
+                                    Width          : in     GLsizei;
+                                    Height         : in     GLsizei;
+                                    the_Type       : in     GLenum);
+   procedure glDisableClientState  (Cap            : in     GLenum);
+   procedure glDrawPixels          (Width          : in     GLsizei;
+                                    Height         : in     GLsizei;
+                                    Format         : in     GLenum;
+                                    the_Type       : in     GLenum;
+                                    Pixels         : in     GLvoid_Pointer);
+   procedure glEnableClientState   (Cap            : in     GLenum);
+   procedure glEnd;
+   procedure glEndList;
+   procedure glFrustumf            (Left           : in     GLfloat;
+                                    Right          : in     GLfloat;
+                                    Bottom         : in     GLfloat;
+                                    Top            : in     GLfloat;
+                                    near_Val       : in     GLfloat;
+                                    far_Val        : in     GLfloat);
+   function  glGenLists            (the_Range      : in     GLsizei) return GLuint;
+   procedure glGetLightfv          (Light          : in     GLenum;
+                                    pName          : in     GLenum;
+                                    Params         : in     GLfloat_Pointer);
+   procedure glGetMaterialfv       (Face           : in     GLenum;
+                                    pName          : in     GLenum;
+                                    Params         : in     GLfloat_Pointer);
+   procedure glGetPointerv         (pName          : in     GLenum;
+                                    Params         : in     GLvoid_Pointer_Pointer);
+   procedure glGetPolygonStipple   (Mask           : in     GLubyte_Pointer);
+   procedure glGetTexEnvfv         (Target         : in     GLenum;
+                                    pName          : in     GLenum;
+                                    Params         : in     GLfloat_Pointer);
+   procedure glGetTexEnviv         (Target         : in     GLenum;
+                                    pName          : in     GLenum;
+                                    Params         : in     GLint_Pointer);
+   procedure glLightModelfv        (pName          : in     GLenum;
+                                    Params         : in     GLfloat_Pointer);
+   procedure glLightfv             (Light          : in     GLenum;
+                                    pName          : in     GLenum;
+                                    Params         : in     GLfloat_Pointer);
+   procedure glLineStipple         (Factor         : in     GLint;
+                                    Pattern        : in     GLushort);
+   procedure glListBase            (Base           : in     GLuint);
+   procedure glLoadIdentity;
+   procedure glLoadMatrixf         (M              : in     GLfloat_Pointer);
+   procedure glMaterialf           (Face           : in     GLenum;
+                                    pName          : in     GLenum;
+                                    Param          : in     GLfloat);
+   procedure glMaterialfv          (Face           : in     GLenum;
+                                    pName          : in     GLenum;
+                                    Params         : in     GLfloat_Pointer);
+   procedure glMatrixMode          (Mode           : in     GLenum);
+   procedure glMultMatrixf         (M              : in     GLfloat_Pointer);
+   procedure glMultiTexCoord2f     (Target         : in     GLenum;
+                                    S              : in     GLfloat;
+                                    T              : in     GLfloat);
+   procedure glMultiTexCoord2fv    (Target         : in     GLenum;
+                                    V              : in     GLfloat_Pointer);
+   procedure glNewList             (List           : in     GLuint;
+                                    Mode           : in     GLenum);
+   procedure glNormal3f            (nX             : in     GLfloat;
+                                    nY             : in     GLfloat;
+                                    nZ             : in     GLfloat);
+   procedure glNormal3fv           (V              : in     GLfloat_Pointer);
+   procedure glNormalPointer       (the_Type       : in     GLenum;
+                                    Stride         : in     GLsizei;
+                                    Ptr            : in     GLvoid_Pointer);
+   procedure glOrthof              (Left           : in     GLfloat;
+                                    Right          : in     GLfloat;
+                                    Bottom         : in     GLfloat;
+                                    Top            : in     GLfloat;
+                                    Near           : in     GLfloat;
+                                    Far            : in     GLfloat);
+   procedure glPointSize           (Size           : in     GLfloat);
+   procedure glPolygonStipple      (Mask           : in     GLubyte_Pointer);
+   procedure glPopMatrix;
+   procedure glPushMatrix;
+   procedure glRasterPos3f         (X              : in     GLfloat;
+                                    Y              : in     GLfloat;
+                                    Z              : in     GLfloat);
+   procedure glRotatef             (Angle          : in     GLfloat;
+                                    X              : in     GLfloat;
+                                    Y              : in     GLfloat;
+                                    Z              : in     GLfloat);
+   procedure glScalef              (X              : in     GLfloat;
+                                    Y              : in     GLfloat;
+                                    Z              : in     GLfloat);
+   procedure glShadeModel          (Mode           : in     GLenum);
+   procedure glTexCoordPointer     (Size           : in     GLint;
+                                    the_Type       : in     GLenum;
+                                    Stride         : in     GLsizei;
+                                    Ptr            : in     GLvoid_Pointer);
+   procedure glTexEnvfv            (Target         : in     GLenum;
+                                    pName          : in     GLenum;
+                                    Params         : in     GLfloat_Pointer);
+   procedure glTexEnvi             (Target         : in     GLenum;
+                                    pName          : in     GLenum;
+                                    Param          : in     GLint);
+   procedure glTranslatef          (X              : in     GLfloat;
+                                    Y              : in     GLfloat;
+                                    Z              : in     GLfloat);
+   procedure glVertex2f            (X              : in     GLfloat;
+                                    Y              : in     GLfloat);
+   procedure glVertex2fv           (V              : in     GLfloat_Pointer);
+   procedure glVertex3f            (X              : in     GLfloat;
+                                    Y              : in     GLfloat;
+                                    Z              : in     GLfloat);
+   procedure glVertex3fv           (V              : in     GLfloat_Pointer);
+   procedure glVertexPointer       (Size           : in     GLint;
+                                    the_Type       : in     GLenum;
+                                    Stride         : in     GLsizei;
+                                    Ptr            : in     GLvoid_Pointer);
+
+private
+
+   pragma Import (StdCall, glAlphaFunc,           "glAlphaFunc");
+   pragma Import (StdCall, glBegin,               "glBegin");
+   pragma Import (StdCall, glBitmap,              "glBitmap");
+   pragma Import (StdCall, glCallLists,           "glCallLists");
+   pragma Import (StdCall, glClientActiveTexture, "glClientActiveTexture");
+   pragma Import (StdCall, glColor4f,             "glColor4f");
+   pragma Import (StdCall, glColor4fv,            "glColor4fv");
+   pragma Import (StdCall, glColor4ub,            "glColor4ub");
+   pragma Import (StdCall, glColorPointer,        "glColorPointer");
+   pragma Import (StdCall, glCopyPixels,          "glCopyPixels");
+   pragma Import (StdCall, glDisableClientState,  "glDisableClientState");
+   pragma Import (StdCall, glDrawPixels,          "glDrawPixels");
+   pragma Import (StdCall, glEnableClientState,   "glEnableClientState");
+   pragma Import (StdCall, glEnd,                 "glEnd");
+   pragma Import (StdCall, glEndList,             "glEndList");
+   pragma Import (StdCall, glFrustumf,            "glFrustumf");
+   pragma Import (StdCall, glGenLists,            "glGenLists");
+   pragma Import (StdCall, glGetLightfv,          "glGetLightfv");
+   pragma Import (StdCall, glGetMaterialfv,       "glGetMaterialfv");
+   pragma Import (StdCall, glGetPointerv,         "glGetPointerv");
+   pragma Import (StdCall, glGetPolygonStipple,   "glGetPolygonStipple");
+   pragma Import (StdCall, glGetTexEnvfv,         "glGetTexEnvfv");
+   pragma Import (StdCall, glGetTexEnviv,         "glGetTexEnviv");
+   pragma Import (StdCall, glLightModelfv,        "glLightModelfv");
+   pragma Import (StdCall, glLightfv,             "glLightfv");
+   pragma Import (StdCall, glLineStipple,         "glLineStipple");
+   pragma Import (StdCall, glListBase,            "glListBase");
+   pragma Import (StdCall, glLoadIdentity,        "glLoadIdentity");
+   pragma Import (StdCall, glLoadMatrixf,         "glLoadMatrixf");
+   pragma Import (StdCall, glMaterialf,           "glMaterialf");
+   pragma Import (StdCall, glMaterialfv,          "glMaterialfv");
+   pragma Import (StdCall, glMatrixMode,          "glMatrixMode");
+   pragma Import (StdCall, glMultMatrixf,         "glMultMatrixf");
+   pragma Import (StdCall, glMultiTexCoord2f,     "glMultiTexCoord2f");
+   pragma Import (StdCall, glMultiTexCoord2fv,    "glMultiTexCoord2fv");
+   pragma Import (StdCall, glNewList,             "glNewList");
+   pragma Import (StdCall, glNormal3f,            "glNormal3f");
+   pragma Import (StdCall, glNormal3fv,           "glNormal3fv");
+   pragma Import (StdCall, glNormalPointer,       "glNormalPointer");
+   pragma Import (StdCall, glOrthof,              "glOrthof");
+   pragma Import (StdCall, glPointSize,           "glPointSize");
+   pragma Import (StdCall, glPolygonStipple,      "glPolygonStipple");
+   pragma Import (StdCall, glPopMatrix,           "glPopMatrix");
+   pragma Import (StdCall, glPushMatrix,          "glPushMatrix");
+   pragma Import (StdCall, glRasterPos3f,         "glRasterPos3f");
+   pragma Import (StdCall, glRotatef,             "glRotatef");
+   pragma Import (StdCall, glScalef,              "glScalef");
+   pragma Import (StdCall, glShadeModel,          "glShadeModel");
+   pragma Import (StdCall, glTexCoordPointer,     "glTexCoordPointer");
+   pragma Import (StdCall, glTexEnvfv,            "glTexEnvfv");
+   pragma Import (StdCall, glTexEnvi,             "glTexEnvi");
+   pragma Import (StdCall, glTranslatef,          "glTranslatef");
+   pragma Import (StdCall, glVertex2f,            "glVertex2f");
+   pragma Import (StdCall, glVertex2fv,           "glVertex2fv");
+   pragma Import (StdCall, glVertex3f,            "glVertex3f");
+   pragma Import (StdCall, glVertex3fv,           "glVertex3fv");
+   pragma Import (StdCall, glVertexPointer,       "glVertexPointer");
+
+end GL.safe;
+
+-- TODO:  Bind these missing functions, if needed.
+--
+--  GLAPI void   APIENTRY glColorSubTableEXT    (GLenum target, GLsizei start, GLsizei count, GLenum format, GLenum type, const GLvoid *table);
+--  GLAPI void   APIENTRY glColorTableEXT       (GLenum target, GLenum internalformat, GLsizei width, GLenum format, GLenum type, const GLvoid *table);
+--  GLAPI void   APIENTRY glGetColorTableEXT    (GLenum target, GLenum format, GLenum type, GLvoid *table);
+--  GLAPI void   APIENTRY glGetColorTableParameterivEXT
+--                                              (GLenum target, GLenum pname, GLint *params);

3-mid/opengl/private/gl/source/gl.ads

@@ -0,0 +1,284 @@
+with
+     GL_Types,
+     Interfaces.C;
+
+package GL
+--
+--  Provides types and constants common to all openGL profiles.
+--
+is
+   pragma Pure;
+
+   use Interfaces;
+
+   ---------
+   --  Types
+   --
+
+   -- GLvoid
+   --
+   subtype GLvoid       is GL_Types.GLvoid;
+   type    GLvoid_array is array (C.size_t range <>) of aliased GLvoid;
+
+   -- GLenum
+   --
+   subtype GLenum       is GL_Types.GLenum;
+   type    GLenum_array is array (C.size_t range <>) of aliased GLenum;
+
+   -- GLboolean
+   --
+   subtype GLboolean       is GL_Types.GLboolean;
+   type    GLboolean_array is array (C.size_t range <>) of aliased GLboolean;
+
+   -- GLbitfield
+   --
+   subtype GLbitfield       is GL_Types.GLbitfield;
+   type    GLbitfield_array is array (C.size_t range <>) of aliased GLbitfield;
+
+   -- GLshort
+   --
+   subtype GLshort       is GL_Types.GLshort;
+   type    GLshort_array is array (C.size_t range <>) of aliased GLshort;
+
+   -- GLint
+   --
+   subtype GLint       is GL_Types.GLint;
+   type    GLint_array is array (C.size_t range <>) of aliased GLint;
+
+   -- GLsizei
+   --
+   subtype GLsizei       is GL_Types.GLsizei;
+   type    GLsizei_array is array (C.size_t range <>) of aliased GLsizei;
+
+   -- GLushort
+   --
+   subtype GLushort       is GL_Types.GLushort;
+   type    GLushort_array is array (C.size_t range <>) of aliased GLushort;
+
+   -- GLuint
+   --
+   subtype GLuint       is GL_Types.GLuint;
+   type    GLuint_array is array (C.size_t range <>) of aliased GLuint;
+
+
+   -- GLbyte
+   --
+   subtype GLbyte       is GL_Types.GLbyte;
+   type    GLbyte_array is array (C.size_t range <>) of aliased GLbyte;
+
+
+   -- GLubyte
+   --
+   subtype GLubyte       is GL_Types.GLubyte;
+   type    GLubyte_array is array (C.size_t range <>) of aliased GLubyte;
+
+
+   -- GLfloat
+   --
+   subtype GLfloat       is GL_Types.GLfloat;
+   type    GLfloat_array is array (C.size_t range <>) of aliased GLfloat;
+
+
+   -- GLclampf
+   --
+   subtype GLclampf       is GL_Types.GLclampf;
+   type    GLclampf_array is array (C.size_t range <>) of aliased GLclampf;
+
+
+   -------------
+   --  Constants
+   --
+
+   --  ClearBufferMask
+   GL_DEPTH_BUFFER_BIT   : constant := 16#100#;
+   GL_STENCIL_BUFFER_BIT : constant := 16#400#;
+   GL_COLOR_BUFFER_BIT   : constant := 16#4000#;
+
+   --  Boolean
+   GL_FALSE : constant := 0;
+   GL_TRUE  : constant := 1;
+
+   --  BeginMode
+   GL_POINTS         : constant := 16#0#;
+   GL_LINES          : constant := 16#1#;
+   GL_LINE_LOOP      : constant := 16#2#;
+   GL_LINE_STRIP     : constant := 16#3#;
+   GL_TRIANGLES      : constant := 16#4#;
+   GL_TRIANGLE_STRIP : constant := 16#5#;
+   GL_TRIANGLE_FAN   : constant := 16#6#;
+
+   --  BlendingFactorDest
+   GL_ZERO                : constant := 0;
+   GL_ONE                 : constant := 1;
+   GL_ONE_MINUS_SRC_ALPHA : constant := 16#303#;
+
+   --  BlendingFactorSrc
+   GL_SRC_ALPHA          : constant := 16#302#;
+   GL_SRC_ALPHA_SATURATE : constant := 16#308#;
+
+   --   CullFaceMode
+   GL_FRONT          : constant := 16#404#;
+   GL_BACK           : constant := 16#405#;
+   GL_FRONT_AND_BACK : constant := 16#408#;
+
+   --   EnableCap
+   GL_TEXTURE_2D          : constant := 16#de1#;
+   GL_CULL_FACE           : constant := 16#b44#;
+   GL_BLEND               : constant := 16#be2#;
+   GL_STENCIL_TEST        : constant := 16#b90#;
+   GL_DEPTH_TEST          : constant := 16#b71#;
+   GL_SCISSOR_TEST        : constant := 16#c11#;
+   GL_POLYGON_OFFSET_FILL : constant := 16#8037#;
+
+   --  ErrorCode
+   GL_NO_ERROR          : constant := 0;
+   GL_INVALID_ENUM      : constant := 16#500#;
+   GL_INVALID_VALUE     : constant := 16#501#;
+   GL_INVALID_OPERATION : constant := 16#502#;
+   GL_OUT_OF_MEMORY     : constant := 16#505#;
+
+   --  FrontFaceDirection
+   GL_CW  : constant := 16#900#;
+   GL_CCW : constant := 16#901#;
+
+
+   --  TODO: As above, categorise and add category comment for the following ...
+   --
+
+   GL_LINE_WIDTH : constant := 16#b21#;
+
+   GL_ALIASED_POINT_SIZE_RANGE : constant := 16#846d#;
+   GL_ALIASED_LINE_WIDTH_RANGE : constant := 16#846e#;
+
+   GL_CULL_FACE_MODE    : constant := 16#b45#;
+   GL_FRONT_FACE        : constant := 16#b46#;
+   GL_DEPTH_RANGE       : constant := 16#b70#;
+   GL_DEPTH_WRITEMASK   : constant := 16#b72#;
+   GL_DEPTH_CLEAR_VALUE : constant := 16#b73#;
+   GL_DEPTH_FUNC        : constant := 16#b74#;
+
+   GL_STENCIL_CLEAR_VALUE     : constant := 16#b91#;
+   GL_STENCIL_FUNC            : constant := 16#b92#;
+   GL_STENCIL_FAIL            : constant := 16#b94#;
+   GL_STENCIL_PASS_DEPTH_FAIL : constant := 16#b95#;
+   GL_STENCIL_PASS_DEPTH_PASS : constant := 16#b96#;
+   GL_STENCIL_REF             : constant := 16#b97#;
+   GL_STENCIL_VALUE_MASK      : constant := 16#b93#;
+   GL_STENCIL_WRITEMASK       : constant := 16#b98#;
+
+   GL_VIEWPORT    : constant := 16#ba2#;
+   GL_SCISSOR_BOX : constant := 16#c10#;
+
+   GL_COLOR_CLEAR_VALUE : constant := 16#c22#;
+   GL_COLOR_WRITEMASK   : constant := 16#c23#;
+
+   GL_UNPACK_ALIGNMENT : constant := 16#cf5#;
+   GL_PACK_ALIGNMENT   : constant := 16#d05#;
+
+   GL_MAX_TEXTURE_SIZE  : constant := 16#d33#;
+   GL_MAX_VIEWPORT_DIMS : constant := 16#d3a#;
+
+   GL_SUBPIXEL_BITS : constant := 16#d50#;
+   GL_RED_BITS      : constant := 16#d52#;
+   GL_GREEN_BITS    : constant := 16#d53#;
+   GL_BLUE_BITS     : constant := 16#d54#;
+   GL_ALPHA_BITS    : constant := 16#d55#;
+   GL_DEPTH_BITS    : constant := 16#d56#;
+   GL_STENCIL_BITS  : constant := 16#d57#;
+
+   GL_POLYGON_OFFSET_UNITS  : constant := 16#2a00#;
+   GL_POLYGON_OFFSET_FACTOR : constant := 16#8038#;
+
+   GL_TEXTURE_BINDING_2D : constant := 16#8069#;
+
+   GL_DONT_CARE : constant := 16#1100#;
+   GL_FASTEST   : constant := 16#1101#;
+   GL_NICEST    : constant := 16#1102#;
+
+   GL_BYTE          : constant := 16#1400#;
+   GL_UNSIGNED_BYTE : constant := 16#1401#;
+   GL_INT           : constant := 16#1404#;
+   GL_UNSIGNED_INT  : constant := 16#1405#;
+   GL_FLOAT         : constant := 16#1406#;
+
+   GL_ALPHA           : constant := 16#1906#;
+   GL_RGB             : constant := 16#1907#;
+   GL_RGBA            : constant := 16#1908#;
+   GL_LUMINANCE       : constant := 16#1909#;
+   GL_LUMINANCE_ALPHA : constant := 16#190a#;
+
+   GL_NEVER    : constant := 16#200#;
+   GL_LESS     : constant := 16#201#;
+   GL_EQUAL    : constant := 16#202#;
+   GL_LEQUAL   : constant := 16#203#;
+   GL_GREATER  : constant := 16#204#;
+   GL_NOTEQUAL : constant := 16#205#;
+   GL_GEQUAL   : constant := 16#206#;
+   GL_ALWAYS   : constant := 16#207#;
+
+   GL_KEEP    : constant := 16#1e00#;
+   GL_REPLACE : constant := 16#1e01#;
+   GL_INCR    : constant := 16#1e02#;
+   GL_DECR    : constant := 16#1e03#;
+
+   GL_INVERT : constant := 16#150a#;
+
+   GL_VENDOR     : constant := 16#1f00#;
+   GL_RENDERER   : constant := 16#1f01#;
+   GL_VERSION    : constant := 16#1f02#;
+   GL_EXTENSIONS : constant := 16#1f03#;
+
+   GL_MAJOR_VERSION : constant := 16#821B#;
+   GL_MINOR_VERSION : constant := 16#821C#;
+
+   GL_NEAREST : constant := 16#2600#;
+   GL_LINEAR  : constant := 16#2601#;
+
+   GL_NEAREST_MIPMAP_NEAREST : constant := 16#2700#;
+   GL_LINEAR_MIPMAP_NEAREST  : constant := 16#2701#;
+   GL_NEAREST_MIPMAP_LINEAR  : constant := 16#2702#;
+   GL_LINEAR_MIPMAP_LINEAR   : constant := 16#2703#;
+
+   GL_TEXTURE_MAG_FILTER : constant := 16#2800#;
+   GL_TEXTURE_MIN_FILTER : constant := 16#2801#;
+   GL_TEXTURE_WRAP_S     : constant := 16#2802#;
+   GL_TEXTURE_WRAP_T     : constant := 16#2803#;
+
+   GL_TEXTURE0  : constant := 16#84c0#;
+   GL_TEXTURE1  : constant := 16#84c1#;
+   GL_TEXTURE2  : constant := 16#84c2#;
+   GL_TEXTURE3  : constant := 16#84c3#;
+   GL_TEXTURE4  : constant := 16#84c4#;
+   GL_TEXTURE5  : constant := 16#84c5#;
+   GL_TEXTURE6  : constant := 16#84c6#;
+   GL_TEXTURE7  : constant := 16#84c7#;
+   GL_TEXTURE8  : constant := 16#84c8#;
+   GL_TEXTURE9  : constant := 16#84c9#;
+   GL_TEXTURE10 : constant := 16#84ca#;
+   GL_TEXTURE11 : constant := 16#84cb#;
+   GL_TEXTURE12 : constant := 16#84cc#;
+   GL_TEXTURE13 : constant := 16#84cd#;
+   GL_TEXTURE14 : constant := 16#84ce#;
+   GL_TEXTURE15 : constant := 16#84cf#;
+   GL_TEXTURE16 : constant := 16#84d0#;
+   GL_TEXTURE17 : constant := 16#84d1#;
+   GL_TEXTURE18 : constant := 16#84d2#;
+   GL_TEXTURE19 : constant := 16#84d3#;
+   GL_TEXTURE20 : constant := 16#84d4#;
+   GL_TEXTURE21 : constant := 16#84d5#;
+   GL_TEXTURE22 : constant := 16#84d6#;
+   GL_TEXTURE23 : constant := 16#84d7#;
+   GL_TEXTURE24 : constant := 16#84d8#;
+   GL_TEXTURE25 : constant := 16#84d9#;
+   GL_TEXTURE26 : constant := 16#84da#;
+   GL_TEXTURE27 : constant := 16#84db#;
+   GL_TEXTURE28 : constant := 16#84dc#;
+   GL_TEXTURE29 : constant := 16#84dd#;
+   GL_TEXTURE30 : constant := 16#84de#;
+   GL_TEXTURE31 : constant := 16#84df#;
+
+   GL_ACTIVE_TEXTURE : constant := 16#84e0#;
+   GL_REPEAT         : constant := 16#2901#;
+   GL_CLAMP_TO_EDGE  : constant := 16#812f#;
+
+end GL;

3-mid/opengl/private/gl/source/gl_types.ads

@@ -0,0 +1,33 @@
+with
+     Interfaces.C,
+     System;
+
+package GL_Types
+--
+--  Provides openGL types whose definitions may differ amongst platforms.
+--
+--  This file is generated by the 'generate_GL_types_Spec' tool.
+--
+is
+   pragma Pure;
+   use Interfaces;
+
+   subtype GLenum     is C.unsigned;
+   subtype GLboolean  is C.unsigned_char;
+   subtype GLbitfield is C.unsigned;
+   subtype GLvoid     is system.Address;
+   subtype GLbyte     is C.signed_char;
+   subtype GLshort    is C.short;
+   subtype GLint      is C.int;
+   subtype GLubyte    is C.unsigned_char;
+   subtype GLushort   is C.unsigned_short;
+   subtype GLuint     is C.unsigned;
+   subtype GLsizei    is C.int;
+   subtype GLfloat    is C.C_float;
+   subtype GLclampf   is C.C_float;
+   subtype GLdouble   is C.double;
+   subtype GLclampd   is C.double;
+   subtype GLchar     is C.char;
+   subtype GLfixed    is Integer_32;
+
+end GL_Types;

3-mid/opengl/private/gl/source/glu.ads

@@ -0,0 +1,30 @@
+with
+     GL,
+     System;
+
+package GLU
+   with Obsolescent
+--
+--  Provides a subset of the functions in GLU, tailored to be suitable for use with the openGL 'Embedded' profile.
+--
+--  Currently only 'gluScaleImage' is ported.
+--
+is
+   use GL;
+
+   procedure gluScaleImage (Format    : in GLenum;
+                            WidthIn   : in GLsizei;
+                            HeightIn  : in GLsizei;
+                            TypeIn    : in GLenum;
+                            DataIn    : in System.Address;
+                            WidthOut  : in GLsizei;
+                            HeightOut : in GLsizei;
+                            TypeOut   : in GLenum;
+                            DataOut   : in System.Address);
+   GLU_INVALID_VALUE,
+   GLU_INVALID_ENUM,
+   GLU_INVALID_TYPE,
+   GLU_INVALID_OPERATION,
+   GLU_OUT_OF_MEMORY : exception;
+
+end GLU;

3-mid/opengl/private/gl/source/glx/gl-glx.ads

@@ -0,0 +1,4 @@
+package gl.GLX
+is
+   pragma Pure;
+end gl.GLX;

3-mid/opengl/private/gl/source/wgl/gl-wgl.ads

@@ -0,0 +1,366 @@
+--
+--  Copyright  (c) 2002-2003, David Holm
+--  All rights reserved.
+--
+--  Redistribution and use in source and binary forms, with or without
+--  modification, are permitted provided that the following conditions are
+--  met:
+--
+--   * Redistributions of source code must retain the above copyright notice,
+--     this list of conditions and the following disclaimer.
+--   * Redistributions in binary form must reproduce the above copyright
+--     notice,
+--     this list of conditions and the following disclaimer in the
+--     documentation
+--     and/or other materials provided with the distribution.
+--   * The names of its contributors may not be used to endorse or promote
+--     products derived from this software without specific prior written
+--     permission.
+--
+--  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+--  "AS IS"
+--  AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+--  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+--  ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+--  LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+--  CONSEQUENTIAL DAMAGES  (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+--  SUBSTITUTE GOODS OR SERVICES;
+--  INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+--  CONTRACT, STRICT LIABILITY, OR TORT  (INCLUDING NEGLIGENCE OR OTHERWISE)
+--  ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+--  POSSIBILITY OF SUCH DAMAGE.
+--
+
+with Interfaces.C;
+with Interfaces.C.Extensions;
+with System;
+
+package GL.WGL is
+
+   WGL_FONT_LINES                 : constant := 8#0000#;
+   WGL_FONT_POLYGONS              : constant := 1;
+   WGL_SWAP_MAIN_PLANE            : constant := 1;
+   WGL_SWAP_OVERLAY1              : constant := 2;
+   WGL_SWAP_OVERLAY2              : constant := 4;
+   WGL_SWAP_OVERLAY3              : constant := 8;
+   WGL_SWAP_OVERLAY4              : constant := 16#0010#;
+   WGL_SWAP_OVERLAY5              : constant := 16#0020#;
+   WGL_SWAP_OVERLAY6              : constant := 16#0040#;
+   WGL_SWAP_OVERLAY7              : constant := 16#0080#;
+   WGL_SWAP_OVERLAY8              : constant := 16#0100#;
+   WGL_SWAP_OVERLAY9              : constant := 16#0200#;
+   WGL_SWAP_OVERLAY10             : constant := 16#0400#;
+   WGL_SWAP_OVERLAY11             : constant := 16#0800#;
+   WGL_SWAP_OVERLAY12             : constant := 16#1000#;
+   WGL_SWAP_OVERLAY13             : constant := 16#2000#;
+   WGL_SWAP_OVERLAY14             : constant := 16#4000#;
+   WGL_SWAP_OVERLAY15             : constant := 16#8000#;
+   WGL_SWAP_UNDERLAY1             : constant := 16#0001_0000#;
+   WGL_SWAP_UNDERLAY2             : constant := 16#0002_0000#;
+   WGL_SWAP_UNDERLAY3             : constant := 16#0004_0000#;
+   WGL_SWAP_UNDERLAY4             : constant := 16#0008_0000#;
+   WGL_SWAP_UNDERLAY5             : constant := 16#0010_0000#;
+   WGL_SWAP_UNDERLAY6             : constant := 16#0020_0000#;
+   WGL_SWAP_UNDERLAY7             : constant := 16#0040_0000#;
+   WGL_SWAP_UNDERLAY8             : constant := 16#0080_0000#;
+   WGL_SWAP_UNDERLAY9             : constant := 16#0100_0000#;
+   WGL_SWAP_UNDERLAY10            : constant := 16#0200_0000#;
+   WGL_SWAP_UNDERLAY11            : constant := 16#0400_0000#;
+   WGL_SWAP_UNDERLAY12            : constant := 16#0800_0000#;
+   WGL_SWAP_UNDERLAY13            : constant := 16#1000_0000#;
+   WGL_SWAP_UNDERLAY14            : constant := 16#2000_0000#;
+   WGL_SWAP_UNDERLAY15            : constant := 16#4000_0000#;
+
+   type Pixel_Format_Descriptor is
+       record
+           nSize           : Interfaces.C.short;
+           nVersion        : Interfaces.C.short;
+           dwFlags         : Interfaces.C.long;
+           iPixelType      : Interfaces.C.char;
+           cColorBits      : Interfaces.C.char;
+           cRedBits        : Interfaces.C.char;
+           cRedShift       : Interfaces.C.char;
+           cGreenBits      : Interfaces.C.char;
+           cGreenShift     : Interfaces.C.char;
+           cBlueBits       : Interfaces.C.char;
+           cBlueShift      : Interfaces.C.char;
+           cAlphaBits      : Interfaces.C.char;
+           cAlphaShift     : Interfaces.C.char;
+           cAccumBits      : Interfaces.C.char;
+           cAccumRedBits   : Interfaces.C.char;
+           cAccumGreenBits : Interfaces.C.char;
+           cAccumBlueBits  : Interfaces.C.char;
+           cAccumAlphaBits : Interfaces.C.char;
+           cDepthBits      : Interfaces.C.char;
+           cStencilBits    : Interfaces.C.char;
+           cAuxBuffers     : Interfaces.C.char;
+           iLayerType      : Interfaces.C.char;
+           bReserved       : Interfaces.C.char;
+           dwLayerMask     : Interfaces.C.long;
+           dwVisibleMask   : Interfaces.C.long;
+           dwDamageMask    : Interfaces.C.long;
+       end record;
+   pragma Convention (C_Pass_By_Copy, Pixel_Format_Descriptor);
+
+   type Point_Float is
+      record
+          x : Interfaces.C.C_float;
+          y : Interfaces.C.C_float;
+      end record;
+   pragma Convention (C_Pass_By_Copy, Point_Float);
+
+   type Glyph_Metrics_Float is
+      record
+          gmfBlackBoxX     : Interfaces.C.C_float;
+          gmfBlackBoxY     : Interfaces.C.C_float;
+          gmfptGlyphOrigin : Point_Float;
+          gmfCellIncX      : Interfaces.C.C_float;
+          gmfCellIncY      : Interfaces.C.C_float;
+      end record;
+   pragma Convention (C_Pass_By_Copy, Glyph_Metrics_Float);
+
+   type COLORREF is new Interfaces.C.long;
+   type COLORREF_Type is access all COLORREF;
+
+   type Layer_Plane_Descriptor is
+      record
+          nSize           : Interfaces.C.short;
+          nVersion        : Interfaces.C.short;
+          dwFlags         : Interfaces.C.long;
+          iPixelType      : Interfaces.C.char;
+          cColorBits      : Interfaces.C.char;
+          cRedBits        : Interfaces.C.char;
+          cRedShift       : Interfaces.C.char;
+          cGreenBits      : Interfaces.C.char;
+          cGreenShift     : Interfaces.C.char;
+          cBlueBits       : Interfaces.C.char;
+          cBlueShift      : Interfaces.C.char;
+          cAlphaBits      : Interfaces.C.char;
+          cAlphaShift     : Interfaces.C.char;
+          cAccumBits      : Interfaces.C.char;
+          cAccumRedBits   : Interfaces.C.char;
+          cAccumGreenBits : Interfaces.C.char;
+          cAccumBlueBits  : Interfaces.C.char;
+          cAccumAlphaBits : Interfaces.C.char;
+          cDepthBits      : Interfaces.C.char;
+          cStencilBits    : Interfaces.C.char;
+          cAuxBuffers     : Interfaces.C.char;
+          iLayerPlane     : Interfaces.C.char;
+          bReserved       : Interfaces.C.char;
+          crTransparent   : COLORREF;
+      end record;
+   pragma Convention (C_Pass_By_Copy, Layer_Plane_Descriptor);
+
+   type Layer_Plane_Descriptor_Type is access all Layer_Plane_Descriptor;
+   type Glyph_Metrics_Float_Type is access all Glyph_Metrics_Float;
+   type Pixel_Format_Descriptor_Type is access all Pixel_Format_Descriptor;
+
+   type HANDLE is new Interfaces.C.Extensions.void_ptr;
+   subtype HDC is HANDLE;
+   subtype HGLRC is HANDLE;
+
+   type PROC is access function return Interfaces.C.int;
+
+   function wglDeleteContext (Rendering_Context : HGLRC)
+      return Interfaces.C.int;
+
+   function wglMakeCurrent (Device_Context    : HDC;
+                            Rendering_Context : HGLRC)
+                               return Interfaces.C.int;
+
+   function wglSetPixelFormat (Device_Context    : HDC;
+                               Pixel_Format      : Interfaces.C.int;
+                               Pixel_Format_Desc :
+                                  access Pixel_Format_Descriptor_Type)
+                                     return Interfaces.C.int;
+
+   function wglSwapBuffers (Device_Context : HDC)
+      return Interfaces.C.int;
+
+   function wglGetCurrentDC return HANDLE;
+
+   function wglCreateContext (Device_Context : HDC)
+      return HANDLE;
+
+   function wglCreateLayerContext (Device_Context : HDC;
+                                   Layer_Plane : Interfaces.C.int)
+                                      return HANDLE;
+
+   function wglGetCurrentContext return HANDLE;
+
+   function wglGetProcAddress (Proc_Desc : access Interfaces.C.char) return PROC;
+
+   function wglChoosePixelFormat (Device_Context    : HDC;
+                                  Pixel_Format_Desc :
+                                     access Pixel_Format_Descriptor_Type)
+                                        return Interfaces.C.int;
+
+
+   function wglCopyContext (Rendering_Context_Source : HGLRC;
+                            Rendering_Context_Dest   : HGLRC;
+                            Mask                     :
+                               Interfaces.C.unsigned)
+                                  return Interfaces.C.int;
+
+   function wglDescribeLayerPlane (Device_Context : HDC;
+                                   Pixel_Format   : Interfaces.C.int;
+                                   Layer_Plane    : Interfaces.C.int;
+                                   Bytes          : Interfaces.C.unsigned;
+                                   Plane_Desc     :
+                                     Layer_Plane_Descriptor_Type)
+                                        return Interfaces.C.int;
+
+   function wglDescribePixelFormat (Device_Context    : HDC;
+                                    Layer_Plane       : Interfaces.C.int;
+                                    Bytes             :
+                                       Interfaces.C.unsigned;
+                                    Pixel_Format_Desc :
+                                       Pixel_Format_Descriptor_Type)
+                                          return Interfaces.C.int;
+
+   function wglGetLayerPaletteEntries (Device_Context : HDC;
+                                       Layer_Plane    : Interfaces.C.int;
+                                       Start          : Interfaces.C.int;
+                                       Entries        : Interfaces.C.int;
+                                       Color_Ref      :
+                                          access Interfaces.C.long)
+                                             return Interfaces.C.int;
+
+   function wglGetPixelFormat (Device_Context : HDC)
+      return Interfaces.C.int;
+
+   function wglRealizeLayerPalette (Device_Context : HDC;
+                                    Layer_Plane    : Interfaces.C.int;
+                                    Realize        : Boolean)
+                                       return Interfaces.C.int;
+
+   function wglSetLayerPaletteEntries (Device_Context  : HDC;
+                                       Layer_Plane     : Interfaces.C.int;
+                                       Start           : Interfaces.C.int;
+                                       Entries         : Interfaces.C.int;
+                                       Color_Reference : COLORREF_Type)
+                                          return Interfaces.C.int;
+
+   function wglShareLists (Existing_Rendering_Context : HGLRC;
+                           New_Rendering_Context      : HGLRC)
+                              return Interfaces.C.int;
+
+   function wglSwapLayerBuffers (Device_Context : HDC;
+                                 Planes         : Interfaces.C.unsigned)
+                                    return Interfaces.C.int;
+
+   function wglUseFontBitmapsA (Device_Context : HDC;
+                                First          : Interfaces.C.unsigned;
+                                Count          : Interfaces.C.unsigned;
+                                List_Base      : Interfaces.C.unsigned)
+                                   return Interfaces.C.int;
+
+   function wglUseFontBitmapsW (Device_Context : HDC;
+                                First          : Interfaces.C.unsigned;
+                                Count          : Interfaces.C.unsigned;
+                                List_Base      : Interfaces.C.unsigned)
+                                   return Interfaces.C.int;
+
+   function wglUseFontOutlinesA (Device_Context    : HDC;
+                                 First             : Interfaces.C.unsigned;
+                                 Count             : Interfaces.C.unsigned;
+                                 List_Base         : Interfaces.C.unsigned;
+                                 Deviation         : Interfaces.C.C_float;
+                                 Extrusion         : Interfaces.C.C_float;
+                                 Format            : Interfaces.C.int;
+                                 Glyph_Data_Buffer : Glyph_Metrics_Float_Type)
+                                    return Interfaces.C.int;
+
+   function wglUseFontOutlinesW (Device_Context    : HDC;
+                                 First             : Interfaces.C.unsigned;
+                                 Count             : Interfaces.C.unsigned;
+                                 List_Base         : Interfaces.C.unsigned;
+                                 Deviation         : Interfaces.C.C_float;
+                                 Extrusion         : Interfaces.C.C_float;
+                                 Format            : Interfaces.C.int;
+                                 Glyph_Data_Buffer : Glyph_Metrics_Float_Type)
+                                    return Interfaces.C.int;
+
+   function SwapBuffers (Device_Context : HDC) return
+      Interfaces.C.int;
+
+   function ChoosePixelFormat (Device_Context    : HDC;
+                               Pixel_Format_Desc :
+                                 access Pixel_Format_Descriptor_Type)
+                                    return Interfaces.C.int;
+
+   function DescribePixelFormat (Device_Context    : HDC;
+                                 Pixel_Format      : Interfaces.C.int;
+                                 Bytes             : Interfaces.C.unsigned;
+                                 Pixel_Format_Desc :
+                                    Pixel_Format_Descriptor_Type)
+                                       return Interfaces.C.int;
+
+   function GetPixelFormat (Device_Context : HDC)
+      return Interfaces.C.int;
+
+   function SetPixelFormat (Device_Context    : HDC;
+                            Pixel_Format      : Interfaces.C.int;
+                            Pixel_Format_Desc :
+                              access Pixel_Format_Descriptor_Type)
+                                 return Interfaces.C.int;
+
+private
+
+   pragma Import (StdCall, wglDeleteContext, "wglDeleteContext");
+
+   pragma Import (StdCall, wglMakeCurrent, "wglMakeCurrent");
+
+   pragma Import (StdCall, wglSetPixelFormat, "wglSetPixelFormat");
+
+   pragma Import (StdCall, wglSwapBuffers, "wglSwapBuffers");
+
+   pragma Import (StdCall, wglGetCurrentDC, "wglGetCurrentDC");
+
+   pragma Import (StdCall, wglCreateContext, "wglCreateContext");
+
+   pragma Import (StdCall, wglCreateLayerContext, "wglCreateLayerContext");
+
+   pragma Import (StdCall, wglGetCurrentContext, "wglGetCurrentContext");
+
+   pragma Import (StdCall, wglGetProcAddress, "wglGetProcAddress");
+
+   pragma Import (StdCall, wglChoosePixelFormat, "wglChoosePixelFormat");
+
+   pragma Import (StdCall, wglCopyContext, "wglCopyContext");
+
+   pragma Import (StdCall, wglDescribeLayerPlane, "wglDescribeLayerPlane");
+
+   pragma Import (StdCall, wglDescribePixelFormat, "wglDescribePixelFormat");
+
+   pragma Import (StdCall, wglGetLayerPaletteEntries, "wglGetLayerPaletteEntries");
+
+   pragma Import (StdCall, wglGetPixelFormat, "wglGetPixelFormat");
+
+   pragma Import (StdCall, wglRealizeLayerPalette, "wglRealizeLayerPalette");
+
+   pragma Import (StdCall, wglSetLayerPaletteEntries, "wglSetLayerPaletteEntries");
+
+   pragma Import (StdCall, wglShareLists, "wglShareLists");
+
+   pragma Import (StdCall, wglSwapLayerBuffers, "wglSwapLayerBuffers");
+
+   pragma Import (StdCall, wglUseFontBitmapsA, "wglUseFontBitmapsA");
+
+   pragma Import (StdCall, wglUseFontBitmapsW, "wglUseFontBitmapsW");
+
+   pragma Import (StdCall, wglUseFontOutlinesA, "wglUseFontOutlinesA");
+
+   pragma Import (StdCall, wglUseFontOutlinesW, "wglUseFontOutlinesW");
+
+   pragma Import (StdCall, SwapBuffers, "SwapBuffers");
+
+   pragma Import (StdCall, ChoosePixelFormat, "ChoosePixelFormat");
+
+   pragma Import (StdCall, DescribePixelFormat, "DescribePixelFormat");
+
+   pragma Import (StdCall, GetPixelFormat, "GetPixelFormat");
+
+   pragma Import (StdCall, SetPixelFormat, "SetPixelFormat");
+
+end GL.WGL;