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;