with
GL.Binding,
     GL.lean,

     Interfaces.c.Pointers,
     ada.unchecked_Conversion,
     ada.unchecked_Deallocation;

package body GLU
--
--  This is a direct port of parts of Mesa GLU 'mipmap.c' file.
--
--  Only declarations involved in 'gluScaleImage' are currently ported.
--  Other areas may be later ported at need.
--
--  Currently supports only GL datatypes allowed in the 'lean' profile.
--
is
   use GL.lean,
       Interfaces;

   use type GLint,
            GLenum,
            GLfloat;


   --  GLubyte
   --
   type GLubtye_array is array (C.size_t range <>) of aliased GLubyte;

   package GLubyte_Pointers is new C.Pointers (Index              => C.size_t,
                                               Element            => GLubyte,
                                               Element_Array      => GLubtye_array,
                                               Default_Terminator => 0);
   subtype GLubyte_view is GLubyte_Pointers.Pointer;

   function to_GLubyte_view is new ada.unchecked_Conversion (system.Address, GLubyte_view);



   --  GLushort
   --
   package GLushort_Pointers is new C.Pointers (Index              => C.size_t,
                                                Element            => GLushort,
                                                Element_Array      => GLushort_array,
                                                Default_Terminator => 0);

   subtype GLushort_view is GLushort_Pointers.Pointer;

   function to_GLushort_view is new ada.unchecked_Conversion (system.Address, GLushort_view);
   function to_GLushort_view is new ada.unchecked_Conversion (GLubyte_view,   GLushort_view);

   type GLushort_array_view is access all GLushort_array;


   --  GLbyte
   --
   type GLbyte_view is access all GLbyte;
   function to_GLbyte_view is new ada.unchecked_Conversion (GLubyte_view, GLbyte_view);


   --  Pixel storage modes
   --
   type PixelStorageModes is
      record
         pack_alignment,
         pack_row_length,
         pack_skip_rows,
         pack_skip_pixels,
         pack_lsb_first,
         pack_swap_bytes,
         pack_skip_images,
         pack_image_height,

         unpack_alignment,
         unpack_row_length,
         unpack_skip_rows,
         unpack_skip_pixels,
         unpack_lsb_first,
         unpack_swap_bytes,
         unpack_skip_images,
         unpack_image_height : aliased GLint;
      end record;


   -- Type_Widget
   --
   type widget_Kind is (ub, us, ui, b, s, i, f);

   type uchar_array is array (C.size_t range <>) of C.unsigned_char;
   type  char_array is array (C.size_t range <>) of C.char;
   type short_array is array (C.size_t range <>) of C.short;

   type Type_Widget (Kind : widget_Kind := widget_Kind'First) is
      record
         case Kind
         is
            when ub =>   ub : uchar_array    (0 .. 3);
            when us =>   us : GLushort_array (0 .. 1);
            when ui =>   ui : c.unsigned;
            when b  =>   b  : char_array  (0 .. 3);
            when s  =>   s  : short_array (0 .. 1);
            when i  =>   i  : C.int;
            when f  =>   f  : GLfloat;
         end case;
      end record;
   pragma Unchecked_Union (Type_Widget);



   function legalFormat (Format : in GLenum) return Boolean
   is
   begin
      case Format
      is
         when GL_ALPHA
            | GL_RGB
            | GL_RGBA
            | GL_LUMINANCE
            | GL_LUMINANCE_ALPHA =>
            return True;

         when others =>
            return False;
      end case;
   end legalFormat;



   function legalType (gl_Type : in GLenum) return Boolean
   is
   begin
      case gl_Type
      is
         when GL_BYTE
            | GL_UNSIGNED_BYTE
            | GL_SHORT
            | GL_UNSIGNED_SHORT
            | GL_INT
            | GL_UNSIGNED_INT
            | GL_FLOAT
            | GL_UNSIGNED_SHORT_5_6_5
            | GL_UNSIGNED_SHORT_4_4_4_4
            | GL_UNSIGNED_SHORT_5_5_5_1 =>
            return True;

         when others =>
            return False;
      end case;
   end legalType;



   function isTypePackedPixel (gl_Type : in GLenum) return Boolean
   is
      pragma assert (legalType (gl_Type));
   begin
      case gl_Type
      is
         when GL_UNSIGNED_SHORT_5_6_5
            | GL_UNSIGNED_SHORT_4_4_4_4
            | GL_UNSIGNED_SHORT_5_5_5_1 =>
            return True;

         when others =>
            return False;
      end case;
   end isTypePackedPixel;



   -- Determines if the packed pixel type is compatible with the format.
   --
   function isLegalFormatForPackedPixelType (format,
                                             gl_Type : in GLenum) return Boolean
   is
   begin
      -- If not a packed pixel type then return true.
      --
      if not isTypePackedPixel (gl_Type)
      then
         return True;
      end if;

      -- 3_3_2/2_3_3_REV & 5_6_5/5_6_5_REV are only compatible with RGB
      --
      if    gl_Type = GL_UNSIGNED_SHORT_5_6_5
        and format /= GL_RGB
      then
         return False;
      end if;

      -- 4_4_4_4 & 5_5_5_1 are only compatible with RGBA.
      --
      if    (   gl_Type = GL_UNSIGNED_SHORT_4_4_4_4
             or gl_Type = GL_UNSIGNED_SHORT_5_5_5_1)
        and format /= GL_RGBA
      then
         return False;
      end if;

      return True;
   end isLegalFormatForPackedPixelType;



   -- Return the number of bytes per element, based on the element type.
   --
   function bytes_per_element (gl_Type : in GLenum) return GLfloat
   is
   begin
      case gl_Type
      is
         when GL_UNSIGNED_SHORT         =>   return GLfloat (GLushort'Size / 8);
         when GL_SHORT                  =>   return GLfloat (GLshort 'Size / 8);
         when GL_UNSIGNED_BYTE          =>   return GLfloat (GLubyte 'Size / 8);
         when GL_BYTE                   =>   return GLfloat (GLbyte  'Size / 8);
         when GL_INT                    =>   return GLfloat (GLint   'Size / 8);
         when GL_UNSIGNED_INT           =>   return GLfloat (GLuint  'Size / 8);
         when GL_FLOAT                  =>   return GLfloat (GLfloat 'Size / 8);
         when GL_UNSIGNED_SHORT_5_6_5
            | GL_UNSIGNED_SHORT_4_4_4_4
            | GL_UNSIGNED_SHORT_5_5_5_1 =>   return GLfloat (GLushort'Size / 8);
         when others                    =>   return 4.0;
      end case;
   end bytes_per_element;



   -- Return the number of elements per group of a specified format.
   --
   function elements_per_group (format, gl_Type : in GLenum) return GLint
   is
   begin
      -- If the type is packedpixels then answer is 1 (ignore format).
      --
      if   gl_Type = GL_UNSIGNED_SHORT_5_6_5
        or gl_Type = GL_UNSIGNED_SHORT_4_4_4_4
        or gl_Type = GL_UNSIGNED_SHORT_5_5_5_1
      then
         return 1;
      end if;

      -- Types are not packed pixels, so get elements per group.
      --
      case format
      is
         when GL_RGB             =>   return 3;
         when GL_LUMINANCE_ALPHA =>   return 2;
         when GL_RGBA            =>   return 4;
         when others             =>   return 1;
      end case;
   end elements_per_group;



   -- Compute memory required for internal packed array of data of given type and format.
   --
   function image_size (width,  height  : in GLint;
                        format, gl_Type : in GLenum) return c.size_t
   is
      pragma assert (width  > 0);
      pragma assert (height > 0);

      bytes_per_row : constant GLint := GLint (bytes_per_element (gl_Type)) * width;
      components    : constant GLint := elements_per_group (format, gl_Type);
   begin
      return c.size_t (bytes_per_row * height * components);
   end image_size;



   procedure retrieveStoreModes (psm : in out PixelStorageModes)
   is
      use gl.Binding;
   begin
      glGetIntegerv (GL_UNPACK_ALIGNMENT, psm.unpack_alignment'Access);

      psm.unpack_row_length  := 0;
      psm.unpack_skip_rows   := 0;
      psm.unpack_skip_pixels := 0;
      psm.unpack_lsb_first   := 0;
      psm.unpack_swap_bytes  := 0;

      glGetIntegerv (GL_PACK_ALIGNMENT, psm.pack_alignment'Access);

      psm.pack_row_length  := 0;
      psm.pack_skip_rows   := 0;
      psm.pack_skip_pixels := 0;
      psm.pack_lsb_first   := 0;
      psm.pack_swap_bytes  := 0;
   end retrieveStoreModes;



   function GLU_SWAP_2_BYTES (s : in system.Address) return GLushort
   is
      use GLubyte_Pointers;
      s0 : constant GLubyte_view := to_GLubyte_view (s) + 0;
      s1 : constant GLubyte_view := to_GLubyte_view (s) + 1;
   begin
      return GLushort (   shift_Left (Unsigned_16 (s1.all), 8)
                          or             Unsigned_16 (s0.all));
   end GLU_SWAP_2_BYTES;

   --  #define __GLU_SWAP_2_BYTES(s)\
   --  (GLushort) (  ((GLushort)  ((const GLubyte*) (s)) [1]) << 8  |  ((const GLubyte*) (s)) [0]  )



   function GLU_SWAP_4_BYTES (s : in system.Address) return GLushort
   is
      use GLubyte_Pointers;
      s0 : constant GLubyte_view := to_GLubyte_view (s) + 0;
      s1 : constant GLubyte_view := to_GLubyte_view (s) + 1;
      s2 : constant GLubyte_view := to_GLubyte_view (s) + 2;
      s3 : constant GLubyte_view := to_GLubyte_view (s) + 3;
   begin
      return GLushort (   shift_Left (Unsigned_32 (s3.all), 24)
                          or shift_Left (Unsigned_32 (s2.all), 16)
                          or shift_Left (Unsigned_32 (s1.all), 8)
                          or             Unsigned_32 (s0.all));
   end GLU_SWAP_4_BYTES;

   --  #define __GLU_SWAP_4_BYTES(s)\
   --  (GLuint)(((GLuint)((const GLubyte*)(s))[3])<<24 | \
   --          ((GLuint)((const GLubyte*)(s))[2])<<16 | \
   --          ((GLuint)((const GLubyte*)(s))[1])<<8  |
   --                   ((const GLubyte*)(s))[0])




   procedure extract565 (isSwap            : in     GLint;
                         packedPixel       : in     system.Address;
                         extractComponents :    out GLfloat_array)
   is
      use type GLushort;
      ushort : GLushort;
   begin
      if isSwap /= 0 then
         ushort := GLU_SWAP_2_BYTES (packedPixel);
      else
         ushort := to_GLushort_view (packedPixel).all;
      end if;

      -- 11111000,00000000 == 0xf800
      -- 00000111,11100000 == 0x07e0
      -- 00000000,00011111 == 0x001f
      --
      extractComponents (0) := GLfloat (shift_Right (Unsigned_16 (ushort and 16#f800#), 11)) / 31.0;   -- 31 = 2^5-1
      extractComponents (1) := GLfloat (shift_Right (Unsigned_16 (ushort and 16#07e0#),  5)) / 63.0;   -- 63 = 2^6-1
      extractComponents (2) := GLfloat (                          ushort and 16#001f#)       / 31.0;
   end extract565;



   procedure extract4444 (isSwap            : in     GLint;
                          packedPixel       : in     system.Address;
                          extractComponents :    out GLfloat_array)
   is
      use type GLushort;
      ushort : GLushort;
   begin
      if isSwap /= 0 then
         ushort := GLU_SWAP_2_BYTES (packedPixel);
      else
         ushort := to_GLushort_view (packedPixel).all;
      end if;

      -- 11110000,00000000 == 0xf000
      -- 00001111,00000000 == 0x0f00
      -- 00000000,11110000 == 0x00f0
      -- 00000000,00001111 == 0x000f
      --
      extractComponents (0) := GLfloat (shift_Right (Unsigned_16 (ushort and 16#f000#), 12)) / 15.0;   -- 15 = 2^4-1
      extractComponents (1) := GLfloat (shift_Right (Unsigned_16 (ushort and 16#0f00#),  8)) / 15.0;
      extractComponents (2) := GLfloat (shift_Right (Unsigned_16 (ushort and 16#00f0#),  4)) / 15.0;
      extractComponents (3) := GLfloat (                          ushort and 16#000f#)       / 15.0;
   end extract4444;



   procedure extract5551 (isSwap            : in     GLint;
                          packedPixel       : in     system.Address;
                          extractComponents :    out GLfloat_array)
   is
      use type GLushort;
      ushort : GLushort;
   begin
      if isSwap /= 0 then
         ushort := GLU_SWAP_2_BYTES (packedPixel);
      else
         ushort := to_GLushort_view (packedPixel).all;
      end if;

      -- 11111000,00000000 == 0xf800
      -- 00000111,11000000 == 0x07c0
      -- 00000000,00111110 == 0x003e
      -- 00000000,00000001 == 0x0001
      --
      extractComponents (0) := GLfloat (shift_Right (Unsigned_16 (ushort and 16#f800#), 11)) / 31.0;   -- 31 = 2^5-1
      extractComponents (1) := GLfloat (shift_Right (Unsigned_16 (ushort and 16#07c0#),  6)) / 31.0;
      extractComponents (2) := GLfloat (shift_Right (Unsigned_16 (ushort and 16#003e#),  1)) / 31.0;
      extractComponents (3) := GLfloat (                          ushort and 16#0001#);
   end extract5551;



   procedure shove565 (shoveComponents : in GLfloat_array;
                       index           : in GLint;
                       packedPixel     : in system.Address)
   is
      use GLushort_Pointers;
      use type GLushort;
      the_Pixel : constant GLushort_view := to_GLushort_view (packedPixel) + C.ptrdiff_t (index);
   begin
      -- 11111000,00000000 == 0xf800
      -- 00000111,11100000 == 0x07e0
      -- 00000000,00011111 == 0x001f

      pragma assert (0.0 <= shoveComponents(0) and shoveComponents(0) <= 1.0);
      pragma assert (0.0 <= shoveComponents(1) and shoveComponents(1) <= 1.0);
      pragma assert (0.0 <= shoveComponents(2) and shoveComponents(2) <= 1.0);

      -- due to limited precision, need to round before shoving
      --
      the_Pixel.all :=                  GLushort (shift_Left (Unsigned_16 (shoveComponents (0) * 31.0 + 0.5), 11) and 16#f800#);
      the_Pixel.all := the_Pixel.all or GLushort (shift_Left (Unsigned_16 (shoveComponents (1) * 63.0 + 0.5),  5) and 16#07e0#);
      the_Pixel.all := the_Pixel.all or GLushort (            Unsigned_16 (shoveComponents (2) * 31.0 + 0.5)      and 16#001f#);
   end shove565;



   procedure shove4444 (shoveComponents : in GLfloat_array;
                        index           : in GLint;
                        packedPixel     : in system.Address)
   is
      use GLushort_Pointers;
      use type GLushort;
      the_Pixel : constant GLushort_view := to_GLushort_view (packedPixel) + C.ptrdiff_t (index);
   begin
      pragma assert (0.0 <= shoveComponents (0) and shoveComponents (0) <= 1.0);
      pragma assert (0.0 <= shoveComponents (1) and shoveComponents (1) <= 1.0);
      pragma assert (0.0 <= shoveComponents (2) and shoveComponents (2) <= 1.0);
      pragma assert (0.0 <= shoveComponents (3) and shoveComponents (3) <= 1.0);

      -- due to limited precision, need to round before shoving
      --
      the_Pixel.all :=                  GLushort (shift_Left (Unsigned_16 (shoveComponents (0) * 15.0 + 0.5), 12) and 16#f000#);
      the_Pixel.all := the_Pixel.all or GLushort (shift_Left (Unsigned_16 (shoveComponents (1) * 15.0 + 0.5),  8) and 16#0f00#);
      the_Pixel.all := the_Pixel.all or GLushort (shift_Left (Unsigned_16 (shoveComponents (2) * 15.0 + 0.5),  4) and 16#00f0#);
      the_Pixel.all := the_Pixel.all or GLushort (            Unsigned_16 (shoveComponents (3) * 15.0 + 0.5)      and 16#000f#);
   end shove4444;



   procedure shove5551 (shoveComponents : in GLfloat_array;
                        index           : in GLint;
                        packedPixel     : in system.Address)
   is
      use GLushort_Pointers;
      use type GLushort;
      the_Pixel : constant GLushort_view := to_GLushort_view (packedPixel) + C.ptrdiff_t (index);
   begin
      -- 11111000,00000000 == 0xf800
      -- 00000111,11000000 == 0x07c0
      -- 00000000,00111110 == 0x003e
      -- 00000000,00000001 == 0x0001

      pragma assert (0.0 <= shoveComponents (0) and shoveComponents (0) <= 1.0);
      pragma assert (0.0 <= shoveComponents (1) and shoveComponents (1) <= 1.0);
      pragma assert (0.0 <= shoveComponents (2) and shoveComponents (2) <= 1.0);
      pragma assert (0.0 <= shoveComponents (3) and shoveComponents (3) <= 1.0);

      -- due to limited precision, need to round before shoving
      --
      the_Pixel.all :=                  GLushort (shift_Left (Unsigned_16 (shoveComponents (0) * 31.0 + 0.5), 11) and 16#f800#);
      the_Pixel.all := the_Pixel.all or GLushort (shift_Left (Unsigned_16 (shoveComponents (1) * 31.0 + 0.5),  6) and 16#07c0#);
      the_Pixel.all := the_Pixel.all or GLushort (shift_Left (Unsigned_16 (shoveComponents (2) * 31.0 + 0.5),  1) and 16#003e#);
      the_Pixel.all := the_Pixel.all or GLushort (            Unsigned_16 (shoveComponents (3)        + 0.5)      and 16#0001#);
   end shove5551;



   -- Extract array from user's data applying all pixel store modes.
   -- The internal format used is an array of unsigned shorts.
   --
   procedure fill_image (psm           : in PixelStorageModes;
                         width, height : in GLint;
                         format        : in GLenum;
                         gl_Type       : in GLenum;
                         index_format  : in Boolean;
                         userdata      : in System.Address;
                         newimage      : in GLushort_array_view)
   is
      use GLubyte_Pointers,
          GLushort_Pointers;

      use type GLushort;

      components,
      element_size,
      rowsize,
      padding,
      groups_per_line,
      group_size,
      elements_per_line : GLint;

      start : GLubyte_view;
      iter  : GLubyte_view;
      iter2 : GLushort_view;

      myswap_bytes : GLint;

      function to_GLubyte_view is new ada.Unchecked_Conversion (System.Address, GLubyte_view);

   begin
      myswap_bytes := psm.unpack_swap_bytes;
      components   := elements_per_group (format, gl_Type);

      if psm.unpack_row_length > 0 then
         groups_per_line := psm.unpack_row_length;
      else
         groups_per_line := width;
      end if;

      element_size := GLint (bytes_per_element (gl_Type));
      group_size   := element_size * components;

      if element_size = 1 then
         myswap_bytes := 0;
      end if;

      rowsize := groups_per_line * group_size;
      padding := rowsize mod psm.unpack_alignment;

      if padding /= 0 then
         rowsize := rowsize + psm.unpack_alignment - padding;
      end if;

      --        start             := (const GLubyte *) userdata + psm->unpack_skip_rows * rowsize
      start             :=   to_GLubyte_view (userdata)
        + C.ptrdiff_t (  psm.unpack_skip_rows   * rowsize
                         + psm.unpack_skip_pixels * group_size);
      elements_per_line := width * components;

      iter2 := newimage (newimage'First)'Access;

      for i in 0 .. height - 1
      loop
         iter := start;

         for j in 0 .. elements_per_line - 1
         loop
            declare
               widget            : Type_Widget;
               extractComponents : GLfloat_array (0 .. 3);
            begin
               case gl_Type
               is
               when GL_UNSIGNED_BYTE =>
                  if index_format then
                     iter2.all := GLushort (iter.all);
                     iter2     := iter2 + 1;
                  else
                     iter2.all := GLushort (iter.all) * 257;
                     iter2     := iter2 + 1;
                  end if;

               when GL_BYTE =>
                  if index_format then
                     iter2.all := GLushort (to_GLbyte_view (iter).all);
                     iter2     := iter2 + 1;
                  else
                     -- rough approx
                     iter2.all := GLushort (to_GLbyte_view (iter).all) * 516;
                     iter2     := iter2 + 1;
                  end if;

               when GL_UNSIGNED_SHORT_5_6_5 =>
                  extract565 (myswap_bytes, iter.all'Address, extractComponents);
                  for k in C.size_t' (0) .. 2 loop
                     iter2.all := GLushort (extractComponents (k) * 65535.0);
                     iter2     := iter2 + 1;
                  end loop;

               when GL_UNSIGNED_SHORT_4_4_4_4 =>
                  extract4444 (myswap_bytes, iter.all'Address, extractComponents);
                  for k in C.size_t' (0) .. 3 loop
                     iter2.all := GLushort (extractComponents (k) * 65535.0);
                     iter2     := iter2 + 1;
                  end loop;

               when GL_UNSIGNED_SHORT_5_5_5_1 =>
                  extract5551 (myswap_bytes, iter.all'Address, extractComponents);
                  for k in C.size_t' (0) .. 3 loop
                     iter2.all := GLushort (extractComponents (k) * 65535.0);
                     iter2     := iter2 + 1;
                  end loop;

               when GL_UNSIGNED_SHORT
                  | GL_SHORT =>
                  if myswap_bytes /= 0 then
                     widget.ub (0) := GLubyte_view (iter + 1).all;
                     widget.ub (1) := GLubyte_view (iter + 0).all;
                  else
                     widget.ub (0) := GLubyte_view (iter + 0).all;
                     widget.ub (1) := GLubyte_view (iter + 1).all;
                  end if;

                  if gl_Type = GL_SHORT then
                     if index_format then
                        iter2.all := GLushort (widget.s (0));
                        iter2     := iter2 + 1;
                     else
                        -- rough approx
                        iter2.all := GLushort (widget.s(0)) * 2;
                        iter2     := iter2 + 1;
                     end if;
                  else
                     iter2.all := widget.us (0);
                     iter2     := iter2 + 1;
                  end if;

               when GL_INT
                  | GL_UNSIGNED_INT
                  | GL_FLOAT =>
                  if myswap_bytes /= 0 then
                     widget.ub(0) := GLubyte_view (iter + 3).all;
                     widget.ub(1) := GLubyte_view (iter + 2).all;
                     widget.ub(2) := GLubyte_view (iter + 1).all;
                     widget.ub(3) := GLubyte_view (iter + 0).all;
                  else
                     widget.ub(0) := GLubyte_view (iter + 0).all;
                     widget.ub(1) := GLubyte_view (iter + 1).all;
                     widget.ub(2) := GLubyte_view (iter + 2).all;
                     widget.ub(3) := GLubyte_view (iter + 3).all;
                  end if;

                  if gl_Type = GL_FLOAT then
                     if index_format then
                        iter2.all := GLushort (widget.f);
                        iter2     := iter2 + 1;
                     else
                        iter2.all := GLushort (65535.0 * widget.f);
                        iter2     := iter2 + 1;
                     end if;
                  elsif gl_Type = GL_UNSIGNED_INT then
                     if index_format then
                        iter2.all := GLushort (widget.ui);
                        iter2     := iter2 + 1;
                     else
                        iter2.all := GLushort (shift_Right (Unsigned_32 (widget.ui), 16));
                        iter2     := iter2 + 1;
                     end if;
                  else
                     if index_format then
                        iter2.all := GLushort (widget.i);
                        iter2     := iter2 + 1;
                     else
                        iter2.all := GLushort (shift_Right (Unsigned_32 (widget.i), 15));
                        iter2     := iter2 + 1;
                     end if;
                  end if;

               when others =>
                  raise GLU_INVALID_TYPE;
               end case;

               iter := iter + C.ptrdiff_t (element_size);
            end;
         end loop; -- for j

         start := start + C.ptrdiff_t (rowsize);

         -- want 'iter' pointing at start, not within, row for assertion purposes
         iter := start;
      end loop; -- for i

      -- iterators should be one byte past end
      --
      if not isTypePackedPixel (gl_Type) then
         pragma assert (iter2 = newimage (C.size_t (width * height * components))'Access);
      else
         pragma assert (iter2 = newimage (C.size_t (width * height * elements_per_group (format, 0)))'Access);
      end if;

      pragma assert (iter = to_GLubyte_view (userdata) + C.ptrdiff_t (  rowsize * height
                     + psm.unpack_skip_rows   * rowsize
                     + psm.unpack_skip_pixels * group_size));
   end fill_image;



   -- Insert array into user's data applying all pixel store modes.
   -- The internal format is an array of unsigned shorts.
   -- empty_image() because it is the opposite of fill_image().
   --
   procedure empty_image (psm           : in PixelStorageModes;
                          width, height : in GLint;
                          format        : in GLenum;
                          gl_Type       : in GLenum;
                          index_format  : in Boolean;
                          oldimage      : in GLushort_array_view;
                          userdata      : in System.Address)

   is
      use GLubyte_Pointers,
          GLushort_Pointers;

      use type GLushort;

      components,
      element_size,
      rowsize,
      padding,
      groups_per_line,
      group_size,
      elements_per_line : GLint;

      start             : GLubyte_view;
      iter              : GLubyte_view;
      iter2             : GLushort_view;

      myswap_bytes      : GLint;
      shoveComponents   : GLfloat_array (0 .. 3);
   begin
      myswap_bytes := psm.pack_swap_bytes;
      components   := elements_per_group (format, gl_Type);

      if psm.pack_row_length > 0 then
         groups_per_line := psm.pack_row_length;
      else
         groups_per_line := width;
      end if;

      element_size := GLint (bytes_per_element (gl_Type));
      group_size   := element_size * components;

      if element_size = 1 then
         myswap_bytes := 0;
      end if;

      rowsize := groups_per_line * group_size;
      padding := (rowsize mod psm.pack_alignment);

      if padding /= 0 then
         rowsize := rowsize + psm.pack_alignment - padding;
      end if;

      start             :=   to_GLubyte_view (userdata)
        + C.ptrdiff_t (  psm.pack_skip_rows   * rowsize
                         + psm.pack_skip_pixels * group_size);
      elements_per_line := width * components;

      iter2 := oldimage (oldimage'First)'Access;

      for i in 0 .. height - 1
      loop
         iter := start;

         for j in 0 .. elements_per_line - 1
         loop
            declare
               widget : Type_Widget;
            begin
               case gl_Type
               is
               when GL_UNSIGNED_BYTE =>
                  if index_format then
                     iter.all := GLubyte (iter2.all);
                     iter2     := iter2 + 1;
                  else
                     iter.all := GLubyte (shift_Right (Unsigned_16 (iter2.all), 8));
                     iter2     := iter2 + 1;
                  end if;

               when GL_BYTE =>
                  if index_format then
                     to_GLbyte_view (iter).all := GLbyte (iter2.all);
                     iter2     := iter2 + 1;
                  else
                     to_GLbyte_view (iter).all := GLbyte (shift_Right (Unsigned_16 (iter2.all), 9));
                     iter2     := iter2 + 1;
                  end if;

               when GL_UNSIGNED_SHORT_5_6_5 =>
                  for k in C.size_t' (0) .. 2 loop
                     shoveComponents (k) := GLfloat (iter2.all) / 65535.0;
                     iter2     := iter2 + 1;
                  end loop;

                  shove565 (shoveComponents, 0, widget.us (0)'Address);

                  if myswap_bytes /= 0 then
                     GLubyte_view (iter + 0).all := widget.ub (1);
                     GLubyte_view (iter + 1).all := widget.ub (0);
                  else
                     to_GLushort_view (iter).all := widget.us (0);
                  end if;

               when GL_UNSIGNED_SHORT_4_4_4_4 =>
                  for k in C.size_t' (0) .. 3 loop
                     shoveComponents (k) := GLfloat (iter2.all) / 65535.0;
                     iter2               := iter2 + 1;
                  end loop;

                  shove4444 (shoveComponents, 0, widget.us (0)'Address);

                  if myswap_bytes /= 0 then
                     GLubyte_view (iter + 0).all := widget.ub (1);
                     GLubyte_view (iter + 1).all := widget.ub (0);
                  else
                     to_GLushort_view (iter).all := widget.us (0);
                  end if;

               when GL_UNSIGNED_SHORT_5_5_5_1 =>
                  for k in C.size_t' (0) .. 3 loop
                     shoveComponents (k) := GLfloat (iter2.all) / 65535.0;
                     iter2               := iter2 + 1;
                  end loop;

                  shove5551 (shoveComponents, 0, widget.us (0)'Address);

                  if myswap_bytes /= 0 then
                     GLubyte_view (iter + 0).all := widget.ub (1);
                     GLubyte_view (iter + 1).all := widget.ub (0);
                  else
                     to_GLushort_view (iter).all := widget.us (0);
                  end if;

               when GL_UNSIGNED_SHORT
                  | GL_SHORT =>
                  if gl_Type = GL_SHORT then
                     if index_format then
                        widget.s (0) := GLshort (iter2.all);
                        iter2        := iter2 + 1;
                     else
                        widget.s (0) := GLshort (shift_Right (Unsigned_16 (iter2.all), 1));
                        iter2        := iter2 + 1;
                     end if;
                  else
                     widget.us (0) := iter2.all;
                     iter2         := iter2 + 1;
                  end if;

                  if myswap_bytes /= 0 then
                     GLubyte_view (iter + 0).all := widget.ub (1);
                     GLubyte_view (iter + 1).all := widget.ub (0);
                  else
                     GLubyte_view (iter + 0).all := widget.ub (0);
                     GLubyte_view (iter + 1).all := widget.ub (1);
                  end if;

               when GL_INT
                  | GL_UNSIGNED_INT
                  | GL_FLOAT =>
                  if gl_Type = GL_FLOAT then
                     if index_format then
                        widget.f := GLfloat (iter2.all);
                        iter2    := iter2 + 1;
                     else
                        widget.f := GLfloat (iter2.all) / 65535.0;
                        iter2    := iter2 + 1;
                     end if;
                  elsif gl_Type = GL_UNSIGNED_INT then
                     if index_format then
                        widget.ui := GLuint (iter2.all);
                        iter2     := iter2 + 1;
                     else
                        widget.ui := GLuint (iter2.all) * 65537;
                        iter2     := iter2 + 1;
                     end if;
                  else
                     if index_format then
                        widget.i := GLint (iter2.all);
                        iter2    := iter2 + 1;
                     else
                        widget.i := GLint ((GLuint (iter2.all) * 65537) / 2);
                        iter2    := iter2 + 1;
                     end if;
                  end if;

                  if myswap_bytes /= 0 then
                     GLubyte_view (iter + 3).all := widget.ub (0);
                     GLubyte_view (iter + 2).all := widget.ub (1);
                     GLubyte_view (iter + 1).all := widget.ub (2);
                     GLubyte_view (iter + 0).all := widget.ub (3);
                  else
                     GLubyte_view (iter + 0).all := widget.ub (0);
                     GLubyte_view (iter + 1).all := widget.ub (1);
                     GLubyte_view (iter + 2).all := widget.ub (2);
                     GLubyte_view (iter + 3).all := widget.ub (3);
                  end if;

               when others =>
                  raise GLU_INVALID_TYPE;
               end case;

               iter := iter + C.ptrdiff_t (element_size);
            end;
         end loop;  --  for j

         start := start + C.ptrdiff_t (rowsize);

         -- want 'iter' pointing at start, not within, row for assertion purposes
         iter := start;
      end loop;  -- for i


      -- iterators should be one byte past end
      --
      if not isTypePackedPixel (gl_Type) then
         pragma assert (iter2 = oldimage (C.size_t (width * height * components))'Access);
      else
         pragma assert (iter2 = oldimage (C.size_t (width * height * elements_per_group (format, 0)))'Access);
      end if;

      pragma assert ( iter = to_GLubyte_view (userdata) + C.ptrdiff_t (  rowsize * height
                      + psm.pack_skip_rows   * rowsize
                      + psm.pack_skip_pixels * group_size) );
   end empty_image;



   procedure halveImage (components : in GLint;
                         width      : in GLuint;
                         height     : in GLuint;
                         datain     : in GLushort_view;
                         dataout    : in GLushort_view)
   is
      use GLushort_Pointers;
      use type GLushort;

      newwidth,
      newheight : GLint;
      the_delta : GLint;
      s, t      : GLushort_view;
   begin
      newwidth  := GLint (width)  / 2;
      newheight := GLint (height) / 2;
      the_delta := GLint (width)  * components;

      s := dataout;
      t := datain;

      -- Piece o' cake !
      --
      for i in 0 .. newheight - 1
      loop
         for j in 0 .. newwidth - 1
         loop
            for k in 0 .. components - 1
            loop
               s.all :=   (  GLushort_view (t + 0                                   ).all
                             + GLushort_view (t + C.ptrdiff_t (components)            ).all
                             + GLushort_view (t + C.ptrdiff_t (the_delta)             ).all
                             + GLushort_view (t + C.ptrdiff_t (the_delta + components)).all
                             + 2)
                 / 4;
               s     := s + 1;
               t     := t + 1;
            end loop;

            t := t + C.ptrdiff_t (components);
         end loop;

         t := t + C.ptrdiff_t (the_delta);
      end loop;
   end halveImage;



   procedure scale_internal (components : in GLint;
                             widthin    : in GLint;
                             heightin   : in GLint;
                             datain     : in GLushort_view;
                             widthout   : in GLint;
                             heightout  : in GLint;
                             dataout    : in GLushort_view)
   is
      use GLushort_Pointers;

      x, lowx, highx, convx, halfconvx : GLfloat;
      y, lowy, highy, convy, halfconvy : GLfloat;
      xpercent, ypercent               : GLfloat;
      percent                          : GLfloat;

      -- Max components in a format is 4, so...
      totals                     : GLfloat_array (0 .. 3);
      area                       : GLfloat;
      yint, xint, xindex, yindex : GLint;
      temp                       : GLint;
   begin
      if    widthin  = widthout  * 2
        and heightin = heightout * 2
      then
         halveImage (components,
                     GLuint (widthin),
                     GLuint (heightin),
                     datain,
                     dataout);
         return;
      end if;

      convy     := GLfloat (heightin) / GLfloat (heightout);
      convx     := GLfloat (widthin)  / GLfloat (widthout);
      halfconvx := convx / 2.0;
      halfconvy := convy / 2.0;

      for i in 0 .. heightout - 1
      loop
         y := convy * (GLfloat (i) + 0.5);
         if heightin > heightout then
            highy := y + halfconvy;
            lowy  := y - halfconvy;
         else
            highy := y + 0.5;
            lowy  := y - 0.5;
         end if;

         for j in 0 .. widthout - 1
         loop
            x := convx * (GLfloat (j) + 0.5);

            if widthin > widthout then
               highx := x + halfconvx;
               lowx  := x - halfconvx;
            else
               highx := x + 0.5;
               lowx  := x - 0.5;
            end if;

            -- Ok, now apply box filter to box that goes from (lowx, lowy)
            -- to (highx, highy) on input data into this pixel on output data.
            --
            totals := (others => 0.0);
            area   := 0.0;

            y    := lowy;
            yint := GLint (GLfloat'Floor (y));

            while y < highy
            loop
               yindex := (yint + heightin) mod heightin;

               if highy < GLfloat (yint + 1) then
                  ypercent := highy - y;
               else
                  ypercent := GLfloat (yint + 1) - y;
               end if;

               x    := lowx;
               xint := GLint (GLfloat'Floor (x));

               while x < highx
               loop
                  xindex := (xint + widthin) mod widthin;

                  if highx < GLfloat (xint + 1) then
                     xpercent := highx - x;
                  else
                     xpercent := GLfloat (xint + 1) - x;
                  end if;

                  percent := xpercent * ypercent;
                  area    := area + percent;
                  temp    := (xindex + (yindex * widthin)) * components;

                  for k in 0 .. C.size_t (components - 1) loop
                     totals (k) := totals (k) +   GLfloat (GLushort_view (datain + C.ptrdiff_t (temp) + C.ptrdiff_t (k)).all)
                       * percent;
                  end loop;

                  xint := xint + 1;
                  x    := GLfloat (xint);
               end loop;
               yint := yint + 1;
               y    := GLfloat (yint);
            end loop;

            temp := (j + (i * widthout)) * components;

            for k in 0 .. C.size_t (components - 1) loop
               declare
                  Data : GLfloat := (totals (k) + 0.5) / area;   -- totals[] should be rounded in the case of enlarging an RGB
                  -- ramp when the type is 332 or 4444
               begin
                  Data := GLfloat'Min (Data,
                                       GLfloat (GLushort'Last));

                  GLushort_view (dataout
                                 + C.ptrdiff_t (temp)
                                 + C.ptrdiff_t (k   )).all := GLushort (Data);
               end;
            end loop;

         end loop;  -- for j
      end loop;  -- for i
   end scale_internal;


   function is_index (format : in GLenum) return Boolean   -- TODO: Remove this, it doesn't apply to 'lean' GL types.
   is
   begin
      return False; -- format == GL_COLOR_INDEX || format = GL_STENCIL_INDEX;
   end is_index;


   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)
   is
      procedure free is new ada.unchecked_Deallocation (GLushort_array, GLushort_array_view);

      components  : GLint;
      beforeImage : GLushort_array_view;
      afterImage  : GLushort_array_view;
      psm         : PixelStorageModes;
   begin
      if   widthin   = 0
        or heightin  = 0
        or widthout  = 0
        or heightout = 0
      then
         return;
      end if;

      if   widthin   < 0
        or heightin  < 0
        or widthout  < 0
        or heightout < 0
      then
         raise GLU_INVALID_VALUE;
      end if;

      if   not legalFormat (format)
        or not legalType   (typein)
        or not legalType   (typeout)
      then
         raise GLU_INVALID_ENUM;
      end if;

      if not isLegalFormatForPackedPixelType (format, typein)
      then
         raise GLU_INVALID_OPERATION;
      end if;

      if not isLegalFormatForPackedPixelType (format, typeout)
      then
         raise GLU_INVALID_OPERATION;
      end if;

      declare
         use type C.size_t;

         before_Size : constant C.size_t := image_size (widthin,  heightin,  format, GL_UNSIGNED_SHORT);
         after_Size  : constant C.size_t := image_size (widthout, heightout, format, GL_UNSIGNED_SHORT);
      begin
         beforeImage := new GLushort_array (0 .. before_Size - 1);
         afterImage  := new GLushort_array (0 ..  after_Size - 1);
      end;

      retrieveStoreModes (psm);

      fill_image (psm,
                  widthin, heightin,
                  format,
                  typein,
                  is_index (format),
                  datain,
                  beforeImage);

      components := elements_per_group (format, 0);

      scale_internal (components,
                      widthin, heightin,
                      beforeImage (beforeImage'First)'Access,
                      widthout, heightout,
                      afterImage (afterImage'First)'Access);

      empty_image (psm,
                   widthout, heightout,
                   format,
                   typeout,
                   is_index (format),
                   afterImage,
                   dataout);

      free (beforeImage);
      free (afterImage);
   end gluScaleImage;


end GLU;
