From 50821bb787c9f7221af267ccf1e244f62858f53a Mon Sep 17 00:00:00 2001 From: Rod Kay Date: Wed, 22 Oct 2025 14:11:39 +1100 Subject: [PATCH] opengl: Cosmetics. --- 3-mid/opengl/source/demo/opengl-demo.adb | 1 + .../lean/buffer/opengl-buffer-general.adb | 6 +- .../lean/buffer/opengl-buffer-general.ads | 1 + .../lean/buffer/opengl-buffer-indices.ads | 1 + .../buffer/opengl-buffer-long_indices.ads | 1 + .../lean/buffer/opengl-buffer-normals.ads | 1 + .../buffer/opengl-buffer-short_indices.ads | 1 + .../buffer/opengl-buffer-texture_coords.ads | 1 + .../lean/buffer/opengl-buffer-vertex.ads | 1 + .../source/lean/buffer/opengl-buffer.adb | 6 +- .../source/lean/buffer/opengl-buffer.ads | 4 +- .../lean/geometry/opengl-geometry-colored.adb | 1 + .../lean/geometry/opengl-geometry-colored.ads | 6 +- .../opengl-geometry-colored_textured.adb | 20 +---- .../opengl-geometry-colored_textured.ads | 6 +- .../geometry/opengl-geometry-lit_colored.ads | 1 + .../opengl-geometry-lit_colored_skinned.adb | 2 +- .../opengl-geometry-lit_colored_skinned.ads | 6 +- .../opengl-geometry-lit_colored_textured.adb | 6 +- .../opengl-geometry-lit_colored_textured.ads | 6 +- ...-geometry-lit_colored_textured_skinned.adb | 33 +------ ...-geometry-lit_colored_textured_skinned.ads | 7 +- .../geometry/opengl-geometry-lit_textured.adb | 4 +- .../geometry/opengl-geometry-lit_textured.ads | 6 +- .../opengl-geometry-lit_textured_skinned.adb | 33 ------- .../opengl-geometry-lit_textured_skinned.ads | 6 +- .../geometry/opengl-geometry-textured.adb | 8 +- .../geometry/opengl-geometry-textured.ads | 6 +- .../geometry/opengl-geometry-texturing.adb | 66 ++------------ .../geometry/opengl-geometry-texturing.ads | 24 ++--- .../source/lean/geometry/opengl-geometry.adb | 21 ++--- .../source/lean/geometry/opengl-geometry.ads | 20 +++-- .../geometry/opengl-primitive-indexed.adb | 4 +- .../geometry/opengl-primitive-indexed.ads | 3 + .../opengl-primitive-long_indexed.adb | 5 +- .../opengl-primitive-long_indexed.ads | 4 + .../geometry/opengl-primitive-non_indexed.adb | 2 + .../geometry/opengl-primitive-non_indexed.ads | 3 + .../opengl-primitive-short_indexed.adb | 17 ++-- .../opengl-primitive-short_indexed.ads | 5 ++ .../source/lean/geometry/opengl-primitive.adb | 4 + .../source/lean/geometry/opengl-primitive.ads | 5 +- .../model/opengl-model-capsule-textured.ads | 3 +- .../opengl-model-circle-lit_textured.adb | 3 - .../lean/model/opengl-model-texturing.adb | 12 +++ 3-mid/opengl/source/lean/opengl-camera.adb | 35 ++++---- 3-mid/opengl/source/lean/opengl-camera.ads | 23 ++--- .../source/lean/opengl-frame_buffer.adb | 20 ++++- .../source/lean/opengl-frame_buffer.ads | 4 +- 3-mid/opengl/source/lean/opengl-terrain.ads | 1 + 3-mid/opengl/source/lean/opengl-texture.adb | 65 ++++++++------ 3-mid/opengl/source/lean/opengl-texture.ads | 3 +- .../opengl/source/lean/opengl-texture_set.adb | 87 +------------------ .../opengl/source/lean/opengl-texture_set.ads | 58 +------------ 3-mid/opengl/source/lean/opengl-viewport.adb | 8 +- 3-mid/opengl/source/lean/opengl-visual.adb | 22 +---- 3-mid/opengl/source/lean/opengl-visual.ads | 48 +++++----- .../lean/renderer/opengl-renderer-lean.adb | 17 ++-- .../opengl/source/opengl-errors-debugging.adb | 2 +- .../mixed_shapes/launch_mixed_shapes.adb | 49 +++++++---- 60 files changed, 304 insertions(+), 520 deletions(-) diff --git a/3-mid/opengl/source/demo/opengl-demo.adb b/3-mid/opengl/source/demo/opengl-demo.adb index ed43359..d6a7371 100644 --- a/3-mid/opengl/source/demo/opengl-demo.adb +++ b/3-mid/opengl/source/demo/opengl-demo.adb @@ -157,6 +157,7 @@ is the_ball_4_Model : constant Model.sphere.lit_colored_textured.view := Model.sphere.lit_colored_textured.new_Sphere (Radius => 1.0, + Color => (Green, Opaque), texture_Details => texture_Set.to_Set ([1 => the_Texture]), Image => the_Texture); diff --git a/3-mid/opengl/source/lean/buffer/opengl-buffer-general.adb b/3-mid/opengl/source/lean/buffer/opengl-buffer-general.adb index 853f3a2..b72d408 100644 --- a/3-mid/opengl/source/lean/buffer/opengl-buffer-general.adb +++ b/3-mid/opengl/source/lean/buffer/opengl-buffer-general.adb @@ -4,6 +4,7 @@ with GL.Pointers; + package body openGL.Buffer.general is -------------------------- @@ -53,6 +54,7 @@ is From'Size / 8, +From (From'First)'Address, to_GL_Enum (Usage)); + Errors.log; end return; end to_Buffer; @@ -78,6 +80,7 @@ is Offset => GLintptr ((Position - 1) * Vertex_Size_in_bits / 8), Size => new_Vertices'Size / 8, Data => +new_Vertices (new_Vertices'First)'Address); + Errors.log; else Self.destroy; @@ -89,9 +92,8 @@ is To'Size / 8, +To (To'First)'Address, to_GL_Enum (Self.Usage)); + Errors.log; end if; - - Errors.log; end set; diff --git a/3-mid/opengl/source/lean/buffer/opengl-buffer-general.ads b/3-mid/opengl/source/lean/buffer/opengl-buffer-general.ads index ed2d420..1550279 100644 --- a/3-mid/opengl/source/lean/buffer/opengl-buffer-general.ads +++ b/3-mid/opengl/source/lean/buffer/opengl-buffer-general.ads @@ -5,6 +5,7 @@ generic type Element is private; type Element_Array is array (Index range <>) of Element; + package openGL.Buffer.general -- -- A generic for producing various types of openGL vertex buffer objects. diff --git a/3-mid/opengl/source/lean/buffer/opengl-buffer-indices.ads b/3-mid/opengl/source/lean/buffer/opengl-buffer-indices.ads index 1c6d595..1d0c2c6 100644 --- a/3-mid/opengl/source/lean/buffer/opengl-buffer-indices.ads +++ b/3-mid/opengl/source/lean/buffer/opengl-buffer-indices.ads @@ -1,6 +1,7 @@ with openGL.Buffer.general; + package openGL.Buffer.indices is new openGL.Buffer.general (base_Object => Buffer.element_array_Object, Index => long_Index_t, Element => Index_t, diff --git a/3-mid/opengl/source/lean/buffer/opengl-buffer-long_indices.ads b/3-mid/opengl/source/lean/buffer/opengl-buffer-long_indices.ads index 5f35626..948d6e7 100644 --- a/3-mid/opengl/source/lean/buffer/opengl-buffer-long_indices.ads +++ b/3-mid/opengl/source/lean/buffer/opengl-buffer-long_indices.ads @@ -1,6 +1,7 @@ with openGL.Buffer.general; + package openGL.Buffer.long_indices is new openGL.Buffer.general (base_Object => Buffer.element_array_Object, Index => long_Index_t, Element => long_Index_t, diff --git a/3-mid/opengl/source/lean/buffer/opengl-buffer-normals.ads b/3-mid/opengl/source/lean/buffer/opengl-buffer-normals.ads index 7aa1bfd..32a558e 100644 --- a/3-mid/opengl/source/lean/buffer/opengl-buffer-normals.ads +++ b/3-mid/opengl/source/lean/buffer/opengl-buffer-normals.ads @@ -1,6 +1,7 @@ with openGL.Buffer.general; + package openGL.Buffer.normals is new openGL.Buffer.general (base_Object => Buffer.array_Object, Index => Index_t, Element => Normal, diff --git a/3-mid/opengl/source/lean/buffer/opengl-buffer-short_indices.ads b/3-mid/opengl/source/lean/buffer/opengl-buffer-short_indices.ads index cb4a72b..c5dc1e6 100644 --- a/3-mid/opengl/source/lean/buffer/opengl-buffer-short_indices.ads +++ b/3-mid/opengl/source/lean/buffer/opengl-buffer-short_indices.ads @@ -1,6 +1,7 @@ with openGL.Buffer.general; + package openGL.Buffer.short_indices is new openGL.Buffer.general (base_Object => Buffer.element_array_Object, Index => long_Index_t, Element => short_Index_t, diff --git a/3-mid/opengl/source/lean/buffer/opengl-buffer-texture_coords.ads b/3-mid/opengl/source/lean/buffer/opengl-buffer-texture_coords.ads index 1e7e997..15101d1 100644 --- a/3-mid/opengl/source/lean/buffer/opengl-buffer-texture_coords.ads +++ b/3-mid/opengl/source/lean/buffer/opengl-buffer-texture_coords.ads @@ -1,6 +1,7 @@ with openGL.Buffer.general; + package openGL.Buffer.texture_coords is new openGL.Buffer.general (base_Object => Buffer.array_Object, Index => Index_t, Element => Coordinate_2D, diff --git a/3-mid/opengl/source/lean/buffer/opengl-buffer-vertex.ads b/3-mid/opengl/source/lean/buffer/opengl-buffer-vertex.ads index bc381c3..d649f6c 100644 --- a/3-mid/opengl/source/lean/buffer/opengl-buffer-vertex.ads +++ b/3-mid/opengl/source/lean/buffer/opengl-buffer-vertex.ads @@ -1,6 +1,7 @@ with openGL.Buffer.general; + package openGL.Buffer.vertex is new openGL.Buffer.general (base_Object => Buffer.array_Object, Index => Index_t, Element => Site, diff --git a/3-mid/opengl/source/lean/buffer/opengl-buffer.adb b/3-mid/opengl/source/lean/buffer/opengl-buffer.adb index 5fa7b8f..773ebce 100644 --- a/3-mid/opengl/source/lean/buffer/opengl-buffer.adb +++ b/3-mid/opengl/source/lean/buffer/opengl-buffer.adb @@ -3,6 +3,7 @@ with openGL.Tasks, ada.unchecked_Deallocation; + package body openGL.Buffer is use type a_Name; @@ -17,7 +18,7 @@ is Name : aliased a_Name; begin Tasks.check; - glGenBuffers (1, Name'unchecked_Access); + glGenBuffers (1, Name'unchecked_Access); Errors.log; return Name; end new_vbo_Name; @@ -28,8 +29,9 @@ is Name : aliased a_Name := vbo_Name; begin Tasks.check; - glDeleteBuffers (1, Name'unchecked_Access); + glDeleteBuffers (1, Name'unchecked_Access); Errors.log; end free; + pragma Unreferenced (free); diff --git a/3-mid/opengl/source/lean/buffer/opengl-buffer.ads b/3-mid/opengl/source/lean/buffer/opengl-buffer.ads index 0543f9d..31adfee 100644 --- a/3-mid/opengl/source/lean/buffer/opengl-buffer.ads +++ b/3-mid/opengl/source/lean/buffer/opengl-buffer.ads @@ -3,6 +3,7 @@ with GL.lean, ada.unchecked_Conversion; + package openGL.Buffer -- -- Models a buffer object. @@ -11,7 +12,7 @@ is -------------- --- Core Types -- - subtype a_Name is GL.GLuint; -- An openGL vertex buffer 'Name', which is a natural integer. + subtype a_Name is GL.GLuint; -- An openGL vertex buffer 'Name'. type a_Kind is (array_Buffer, element_array_Buffer); type Usage is (stream_Draw, static_Draw, dynamic_Draw); @@ -121,4 +122,5 @@ private -- procedure verify_Name (Self : in out Object'Class); + end openGL.Buffer; diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry-colored.adb b/3-mid/opengl/source/lean/geometry/opengl-geometry-colored.adb index 70cf47c..8e3cdd1 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry-colored.adb +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry-colored.adb @@ -12,6 +12,7 @@ with Interfaces.C.Strings, System.storage_Elements; + package body openGL.Geometry.colored is use GL.lean, GL.Pointers; diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry-colored.ads b/3-mid/opengl/source/lean/geometry/opengl-geometry-colored.ads index bd3435a..7981e4a 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry-colored.ads +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry-colored.ads @@ -35,9 +35,7 @@ is private - type Item is new Geometry.item with - record - null; - end record; + type Item is new Geometry.item with null record; + end openGL.Geometry.colored; diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry-colored_textured.adb b/3-mid/opengl/source/lean/geometry/opengl-geometry-colored_textured.adb index fa33a61..042f52b 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry-colored_textured.adb +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry-colored_textured.adb @@ -13,6 +13,7 @@ with Interfaces.C.Strings, System.storage_Elements; + package body openGL.Geometry.colored_textured is use GL.lean, @@ -188,23 +189,4 @@ is end Indices_are; - -- overriding - -- procedure enable_Textures (Self : in out Item) - -- is - -- use GL, - -- GL.Binding, - -- openGL.Texture; - -- begin - -- Tasks.check; - -- - -- glActiveTexture (gl.GL_TEXTURE0); - -- Errors.log; - -- - -- if Self.Texture = openGL.Texture.null_Object - -- then enable (white_Texture); - -- else enable (Self.Texture); - -- end if; - -- end enable_Textures; - - end openGL.Geometry.colored_textured; diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry-colored_textured.ads b/3-mid/opengl/source/lean/geometry/opengl-geometry-colored_textured.ads index 98f6a3c..985cef0 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry-colored_textured.ads +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry-colored_textured.ads @@ -43,11 +43,7 @@ private package textured_Geometry is new texturing.Mixin; - - type Item is new textured_Geometry.item with - record - null; - end record; + type Item is new textured_Geometry.item with null record; end openGL.Geometry.colored_textured; diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored.ads b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored.ads index efbba7a..1806da8 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored.ads +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored.ads @@ -37,4 +37,5 @@ private type Item is new Geometry.item with null record; + end openGL.Geometry.lit_colored; diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_skinned.adb b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_skinned.adb index 4c73483..0fa3f4c 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_skinned.adb +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_skinned.adb @@ -2,7 +2,6 @@ with openGL.Shader, openGL.Attribute, openGL.Buffer.general, - openGL.Texture, openGL.Tasks, openGL.Errors, @@ -209,6 +208,7 @@ is end define_Program; + -------------- -- Attributes -- diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_skinned.ads b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_skinned.ads index 0103101..071e83d 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_skinned.ads +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_skinned.ads @@ -1,9 +1,10 @@ with openGL.Program.lit.colored_skinned; + package openGL.Geometry.lit_colored_skinned -- --- Supports per-vertex site color, texture, lighting and skinning. +-- Supports per-vertex site color, lighting and skinning. -- is type Item is new openGL.Geometry.item with private; @@ -28,8 +29,10 @@ is bone_Ids : Vector_4; bone_Weights : Vector_4; end record; + pragma Convention (C, Vertex); + type Vertex_array is array (long_Index_t range <>) of aliased Vertex; @@ -55,4 +58,5 @@ private overriding procedure enable_Textures (Self : in out Item); + end openGL.Geometry.lit_colored_skinned; diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_textured.adb b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_textured.adb index 6b95cc8..ef111b0 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_textured.adb +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_textured.adb @@ -68,6 +68,7 @@ is type Geometry_view is access all Geometry.lit_colored_textured.item'Class; + function new_Geometry (texture_is_Alpha : in Boolean) return access Geometry.lit_colored_textured.item'Class is use type openGL.Program.lit.view; @@ -195,6 +196,7 @@ is textured_Geometry.create_Uniforms (for_Program => the_Program.Program.all'Access); end define; + Self : constant Geometry_view := new Geometry.lit_colored_textured.item; begin @@ -225,6 +227,7 @@ is end new_Geometry; + ---------- -- Vertex -- @@ -241,6 +244,7 @@ is end is_Transparent; + -------------- -- Attributes -- @@ -257,7 +261,7 @@ is begin if Self.Vertices = null then - self.Vertices := new openGL_Buffer_of_geometry_Vertices.Object' (Forge.to_Buffer (Now, + Self.Vertices := new openGL_Buffer_of_geometry_Vertices.Object' (Forge.to_Buffer (Now, usage => Buffer.static_Draw)); else set (openGL_Buffer_of_geometry_Vertices.Object (Self.Vertices.all), diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_textured.ads b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_textured.ads index 1762a4d..a2bbaf4 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_textured.ads +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_textured.ads @@ -10,7 +10,6 @@ is package textured_Geometry is new texturing.Mixin; - -- type Item is new openGL.Geometry.item with private; type Item is new textured_Geometry.item with private; type View is access all Item'Class; @@ -46,10 +45,7 @@ is private - type Item is new textured_Geometry.item with - record - null; - end record; + type Item is new textured_Geometry.item with null record; end openGL.Geometry.lit_colored_textured; diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_textured_skinned.adb b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_textured_skinned.adb index 2c56205..5a90c49 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_textured_skinned.adb +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_textured_skinned.adb @@ -70,6 +70,7 @@ is end is_Transparent; + --------- -- Forge -- @@ -282,36 +283,4 @@ is end Vertices_are; - - -- overriding - -- procedure enable_Textures (Self : in out Item) - -- is - -- use GL, - -- GL.Binding, - -- openGL.Texture; - -- begin - -- Tasks.check; - -- - -- glActiveTexture (gl.GL_TEXTURE0); - -- Errors.log; - -- - -- if Self.Texture = openGL.Texture.null_Object - -- then - -- if not white_Texture.is_Defined - -- then - -- declare - -- use Palette; - -- white_Image : constant openGL.Image := [1 .. 2 => [1 .. 2 => +White]]; - -- begin - -- white_Texture := openGL.Texture.Forge.to_Texture (white_Image); - -- end; - -- end if; - -- - -- white_Texture.enable; - -- else - -- Self.Texture.enable; - -- end if; - -- end enable_Textures; - - end openGL.Geometry.lit_colored_textured_skinned; diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_textured_skinned.ads b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_textured_skinned.ads index de1b2e4..684d755 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_textured_skinned.ads +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_textured_skinned.ads @@ -37,6 +37,7 @@ is pragma Convention (C, Vertex); + type Vertex_array is array (long_Index_t range <>) of aliased Vertex; @@ -58,11 +59,7 @@ private package textured_Geometry is new texturing.Mixin; - - type Item is new textured_Geometry.item with - record - null; - end record; + type Item is new textured_Geometry.item with null record; end openGL.Geometry.lit_colored_textured_skinned; diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured.adb b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured.adb index d0bf300..832f91c 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured.adb +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured.adb @@ -71,7 +71,7 @@ is 4 => to_Asset ("assets/opengl/shader/lit_textured.frag")))); the_Program := new openGL.Program.lit.item; the_Program.define ( vertex_Shader'Access, - fragment_Shader'Access); + fragment_Shader'Access); the_Program.enable; Attribute_1 := new_Attribute (Name => Name_1, @@ -160,7 +160,6 @@ is - ---------- -- Vertex -- @@ -183,7 +182,6 @@ is - -------------- -- Attributes -- diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured.ads b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured.ads index 1aa6826..d08c66a 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured.ads +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured.ads @@ -47,11 +47,7 @@ private package textured_Geometry is new texturing.Mixin; - - type Item is new textured_Geometry.item with - record - null; - end record; + type Item is new textured_Geometry.item with null record; end openGL.Geometry.lit_textured; diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured_skinned.adb b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured_skinned.adb index 02c213b..33e3f1b 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured_skinned.adb +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured_skinned.adb @@ -106,7 +106,6 @@ is -- Define the shaders and program. -- vertex_Shader .define (Shader.Vertex, "assets/opengl/shader/lit_textured_skinned.vert"); - -- fragment_Shader.define (Shader.Fragment, "assets/opengl/shader/lit_textured_skinned.frag"); fragment_Shader.define (Shader.Fragment, (asset_Names' (1 => to_Asset ("assets/opengl/shader/version.header"), 2 => to_Asset ("assets/opengl/shader/lighting-frag.snippet"), 3 => to_Asset ("assets/opengl/shader/texturing-frag.snippet"), @@ -254,36 +253,4 @@ is end Vertices_are; - - -- overriding - -- procedure enable_Textures (Self : in out Item) - -- is - -- use GL, - -- GL.Binding, - -- openGL.Texture; - -- begin - -- Tasks.check; - -- - -- glActiveTexture (gl.GL_TEXTURE0); - -- Errors.log; - -- - -- if Self.Texture = openGL.Texture.null_Object - -- then - -- if not white_Texture.is_Defined - -- then - -- declare - -- use Palette; - -- white_Image : constant openGL.Image := [1 .. 2 => [1 .. 2 => +White]]; - -- begin - -- white_Texture := openGL.Texture.Forge.to_Texture (white_Image); - -- end; - -- end if; - -- - -- white_Texture.enable; - -- else - -- Self.Texture.enable; - -- end if; - -- end enable_Textures; - - end openGL.Geometry.lit_textured_skinned; diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured_skinned.ads b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured_skinned.ads index 1b96700..47f056d 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured_skinned.ads +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured_skinned.ads @@ -57,11 +57,7 @@ private package textured_Geometry is new texturing.Mixin; - - type Item is new textured_Geometry.item with - record - null; - end record; + type Item is new textured_Geometry.item with null record; end openGL.Geometry.lit_textured_skinned; diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry-textured.adb b/3-mid/opengl/source/lean/geometry/opengl-geometry-textured.adb index a67a303..16b310c 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry-textured.adb +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry-textured.adb @@ -3,11 +3,11 @@ with openGL.Shader, openGL.Program, openGL.Attribute, + openGL.Errors, openGL.Tasks, GL.lean, GL.Pointers, - System, Interfaces.C.Strings, System.storage_Elements; @@ -97,10 +97,12 @@ is glBindAttribLocation (program => the_Program.gl_Program, index => the_Program.Attribute (named => Name_1).gl_Location, name => +Attribute_1_Name_ptr); + Errors.log; glBindAttribLocation (program => the_Program.gl_Program, index => the_Program.Attribute (named => Name_2).gl_Location, name => +Attribute_2_Name_ptr); + Errors.log; textured_Geometry.create_Uniforms (for_Program => the_Program.all'Access); end; @@ -112,7 +114,6 @@ is - -------------- -- Attributes -- @@ -130,13 +131,12 @@ is Element => Vertex, Element_Array => Vertex_array); - procedure Vertices_are (Self : in out Item; Now : in Vertex_array) is use openGL_Buffer_of_geometry_Vertices.Forge; begin Self.Vertices := new openGL_Buffer_of_geometry_Vertices.Object' (to_Buffer (Now, - usage => Buffer.static_Draw)); + Usage => Buffer.static_Draw)); -- Set the bounds. -- declare diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry-textured.ads b/3-mid/opengl/source/lean/geometry/opengl-geometry-textured.ads index 8f17ea5..69f9958 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry-textured.ads +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry-textured.ads @@ -45,11 +45,7 @@ private package textured_Geometry is new texturing.Mixin; - - type Item is new textured_Geometry.item with - record - null; - end record; + type Item is new textured_Geometry.item with null record; end openGL.Geometry.textured; diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry-texturing.adb b/3-mid/opengl/source/lean/geometry/opengl-geometry-texturing.adb index 7f55243..039403d 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry-texturing.adb +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry-texturing.adb @@ -1,5 +1,6 @@ with openGL.Model, + openGL.Errors, GL.lean, GL.Binding, ada.Strings.fixed; @@ -47,40 +48,6 @@ is - - -- procedure enable (for_Model : in openGL.Model.view; - -- Uniforms : in texturing.Uniforms; - -- texture_Set : in openGL.texture_Set.Item) - -- is - -- use GL.Binding, - -- GL.lean; - -- - -- use type GLint; - -- - -- begin - -- if for_Model.texture_Count > 0 - -- then - -- for i in 1 .. openGL.texture_Set.texture_Id (for_Model.texture_Count) - -- loop - -- Uniforms.Textures (i).tiling_Uniform .Value_is (Vector_2' ((for_Model.Tiling (Which => i).S, - -- for_Model.Tiling (Which => i).T))); - -- Uniforms.Textures (i).fade_Uniform .Value_is (Real (for_Model.Fade (Which => i))); - -- Uniforms.Textures (i).texture_applied_Uniform.Value_is (for_Model.texture_Applied (Which => i)); - -- - -- glUniform1i (Uniforms.Textures (i).texture_Uniform.gl_Variable, - -- GLint (i) - 1); - -- glActiveTexture (all_texture_Units (i)); - -- glBindTexture (GL_TEXTURE_2D, - -- texture_Set.Textures (i).Object.Name); - -- end loop; - -- end if; - -- - -- Uniforms.Count.Value_is (for_Model.texture_Count); - -- end enable; - - - - procedure enable (for_Model : in openGL.Model.view; Uniforms : in texturing.Uniforms) -- texture_Set : in openGL.texture_Set.Item) @@ -101,10 +68,10 @@ is Uniforms.Textures (i).texture_applied_Uniform.Value_is (for_Model.texture_Applied (Which => i)); glUniform1i (Uniforms.Textures (i).texture_Uniform.gl_Variable, - GLint (i) - 1); - glActiveTexture (all_texture_Units (i)); + GLint (i) - 1); Errors.log; + glActiveTexture (all_texture_Units (i)); Errors.log; glBindTexture (GL_TEXTURE_2D, - for_Model.texture_Object (i).Name); + for_Model.texture_Object (i).Name); Errors.log; end loop; end if; @@ -149,11 +116,9 @@ is package body Mixin is - use openGL.texture_Set; - - texture_Uniforms : texturing.Uniforms; + procedure create_Uniforms (for_Program : in openGL.Program.view) is begin @@ -167,7 +132,6 @@ is Which : in texture_Set.texture_ID := 1) is begin - -- Self.texture_Set.Textures (Which).Fade := Now; Self.Model.Fade_is (Which => Which, Now => Now); end Fade_is; @@ -178,7 +142,6 @@ is function Fade (Self : in Item; Which : in texture_Set.texture_ID := 1) return texture_Set.fade_Level is begin - -- return Self.texture_Set.Textures (Which).Fade; return Self.Model.Fade (Which => Which); end Fade; @@ -189,9 +152,6 @@ is Which : in texture_Set.texture_ID := 1) is begin - -- Texture_is (in_Set => Self.texture_Set, - -- Which => Which, - -- Now => Now); Self.Model.texture_Object_is (Which => Which, Now => Now); end Texture_is; @@ -202,8 +162,6 @@ is function Texture (Self : in Item; Which : texture_Set.texture_ID := 1) return openGL.Texture.Object is begin - -- return openGL.texture_Set.Texture (in_Set => Self.texture_Set, - -- Which => Which); return Self.Model.texture_Object (Which); end Texture; @@ -214,17 +172,15 @@ is Which : in texture_Set.texture_ID := 1) is begin - -- Self.texture_Set.Textures (Which).Applied := Now; Self.Model.texture_Applied_is (Which, Now); end texture_Applied_is; overriding - function texture_Applied (Self : in Item; Which : in texture_Set.texture_ID := 1) return Boolean + function texture_Applied (Self : in Item; Which : in texture_Set.texture_ID := 1) return Boolean is begin - -- return Self.texture_Set.Textures (Which).Applied; return Self.Model.texture_Applied (Which); end texture_Applied; @@ -235,7 +191,6 @@ is Which : in texture_Set.texture_ID := 1) is begin - -- Self.texture_Set.Textures (Which).Tiling := Now; Self.Model.Tiling_is (Which => Which, Now => Now); end Tiling_is; @@ -246,23 +201,15 @@ is function Tiling (Self : in Item; Which : in texture_Set.texture_ID := 1) return texture_Set.Tiling is begin - -- return Self.texture_Set.Textures (Which).Tiling; return Self.Model.Tiling (Which); end Tiling; - - - - overriding procedure enable_Textures (Self : in out Item) is begin - -- texturing.enable (for_Model => Self.Model.all'Access, - -- Uniforms => texture_Uniforms, - -- texture_Set => Self.texture_Set); texturing.enable (for_Model => Self.Model.all'Access, Uniforms => texture_Uniforms); end enable_Textures; @@ -271,5 +218,4 @@ is end Mixin; - end openGL.Geometry.texturing; diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry-texturing.ads b/3-mid/opengl/source/lean/geometry/opengl-geometry-texturing.ads index 183fcaa..956a8b4 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry-texturing.ads +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry-texturing.ads @@ -40,15 +40,9 @@ is --- Operations -- - -- procedure enable (for_Model : in openGL.Model.view; - -- Uniforms : in texturing.Uniforms; - -- texture_Set : in openGL.texture_Set.Item); - procedure enable (for_Model : in openGL.Model.view; Uniforms : in texturing.Uniforms); - - procedure create (Uniforms : out texturing.Uniforms; for_Program : in openGL.Program.view); @@ -68,17 +62,17 @@ is overriding - procedure Fade_is (Self : in out Item; Now : in texture_Set.fade_Level; - Which : in texture_Set.texture_ID := 1); + procedure Fade_is (Self : in out Item; Now : in texture_Set.fade_Level; + Which : in texture_Set.texture_ID := 1); overriding - function Fade (Self : in Item; Which : texture_Set.texture_ID := 1) return texture_Set.fade_Level; + function Fade (Self : in Item; Which : texture_Set.texture_ID := 1) return texture_Set.fade_Level; overriding - procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object; - Which : in texture_Set.texture_ID := 1); + procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object; + Which : in texture_Set.texture_ID := 1); overriding - function Texture (Self : in Item; Which : in texture_Set.texture_ID := 1) return openGL.Texture.Object; + function Texture (Self : in Item; Which : in texture_Set.texture_ID := 1) return openGL.Texture.Object; overriding @@ -100,13 +94,9 @@ is private - type Item is new Geometry.item with - record - null; --texture_Set : openGL.texture_Set.item; - end record; + type Item is new Geometry.item with null record; end Mixin; - end openGL.Geometry.texturing; diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry.adb b/3-mid/opengl/source/lean/geometry/opengl-geometry.adb index 72e96f3..92165f2 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry.adb +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry.adb @@ -45,7 +45,6 @@ is - -------------- -- Attributes -- @@ -112,7 +111,7 @@ is function Fade (Self : in Item; Which : texture_Set.texture_ID := 1) return texture_Set.fade_Level is begin - raise program_Error with "Geometry has no texture."; + raise Error with "Geometry has no texture."; return texture_Set.fade_Level'Last; end Fade; @@ -121,7 +120,7 @@ is function Texture (Self : in Item; Which : in texture_Set.texture_ID := 1) return openGL.Texture.Object is begin - raise program_Error with "Geometry has no texture."; + raise Error with "Geometry has no texture."; return openGL.Texture.null_Object; end Texture; @@ -130,7 +129,7 @@ is function texture_Applied (Self : in Item; Which : in texture_Set.texture_ID := 1) return Boolean is begin - raise program_Error with "Geometry has no texture."; + raise Error with "Geometry has no texture."; return False; end texture_Applied; @@ -139,7 +138,7 @@ is function Tiling (Self : in Item; Which : in texture_Set.texture_ID := 1) return texture_Set.Tiling is begin - raise program_Error with "Geometry has no texture."; + raise Error with "Geometry has no texture."; return (S => 0.0, T => 0.0); end Tiling; @@ -162,7 +161,7 @@ is - function Bounds (self : in Item'Class) return openGL.Bounds + function Bounds (Self : in Item'Class) return openGL.Bounds is begin return Self.Bounds; @@ -197,7 +196,6 @@ is - -------------- -- Operations -- @@ -232,7 +230,6 @@ is - ----------- -- Normals -- @@ -309,6 +306,7 @@ is pragma Unreferenced (facet_Count_in); + ---------- -- Facets -- @@ -329,6 +327,7 @@ is -- 'Facets_of' returns all non-redundant facets. + function any_Facets_of (face_Kind : in primitive.facet_Kind; Indices : in any_Indices) return access Facets is @@ -361,9 +360,11 @@ is is when Triangles | triangle_Fan => + the_Facets (Count) := [P1, P2, P3]; when triangle_Strip => + if Each mod 2 = 0 then -- Is an even facet. the_Facets (Count) := [P1, P3, P2]; @@ -388,6 +389,7 @@ is end any_Facets_of; + function Facets_of is new any_Facets_of (Index_t, Indices); pragma Unreferenced (Facets_of); @@ -480,7 +482,7 @@ is free (the_Facets); free (the_facet_Normals); - return the_Normals.all'Unchecked_Access; + return the_Normals.all'unchecked_Access; end any_Normals_of; @@ -537,7 +539,6 @@ is - --------------- -- Transparency -- diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry.ads b/3-mid/opengl/source/lean/geometry/opengl-geometry.ads index 975fb4b..6c00c74 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry.ads +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry.ads @@ -47,20 +47,20 @@ is procedure Model_is (Self : in out Item; Now : in Model_view); function Model (Self : in Item) return Model_view; - procedure Label_is (Self : in out Item'Class; Now : in String); - function Label (Self : in Item'Class) return String; + procedure Label_is (Self : in out Item'Class; Now : in String); + function Label (Self : in Item'Class) return String; --- Texturing -- - procedure Fade_is (Self : in out Item; Now : in texture_Set.fade_Level; - Which : in texture_Set.texture_ID := 1) is null; - function Fade (Self : in Item; Which : in texture_Set.texture_ID := 1) return texture_Set.fade_Level; + procedure Fade_is (Self : in out Item; Now : in texture_Set.fade_Level; + Which : in texture_Set.texture_ID := 1) is null; + function Fade (Self : in Item; Which : in texture_Set.texture_ID := 1) return texture_Set.fade_Level; - procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object; - Which : in texture_Set.texture_ID := 1) is null; - function Texture (Self : in Item; Which : in texture_Set.texture_ID := 1) return openGL.Texture.Object; + procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object; + Which : in texture_Set.texture_ID := 1) is null; + function Texture (Self : in Item; Which : in texture_Set.texture_ID := 1) return openGL.Texture.Object; procedure texture_Applied_is (Self : in out Item; Now : in Boolean; Which : in texture_Set.texture_ID := 1) is null; @@ -135,11 +135,15 @@ private generic type any_Index_t is range <>; with function get_Site (Index : in any_Index_t) return Vector_3; + function get_Bounds (Count : in Natural) return openGL.Bounds; + generic type any_Index_t is range <>; with function get_Color (Index : in any_Index_t) return rgba_Color; + function get_Transparency (Count : in Natural) return Boolean; + end openGL.Geometry; diff --git a/3-mid/opengl/source/lean/geometry/opengl-primitive-indexed.adb b/3-mid/opengl/source/lean/geometry/opengl-primitive-indexed.adb index b613f8c..58a9dd9 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-primitive-indexed.adb +++ b/3-mid/opengl/source/lean/geometry/opengl-primitive-indexed.adb @@ -6,6 +6,7 @@ with GL.Binding, GL.lean; + package body openGL.Primitive.indexed is --------- @@ -48,7 +49,7 @@ is Self.facet_Kind := Kind; Self.Indices := new openGL.Buffer.indices.Object' (to_Buffer (buffer_Indices'Access, - usage => Buffer.static_Draw)); + Usage => Buffer.static_Draw)); Self.line_Width := line_Width; end define; @@ -88,6 +89,7 @@ is end destroy; + -------------- -- Attributes -- diff --git a/3-mid/opengl/source/lean/geometry/opengl-primitive-indexed.ads b/3-mid/opengl/source/lean/geometry/opengl-primitive-indexed.ads index ed1d1c2..170ca90 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-primitive-indexed.ads +++ b/3-mid/opengl/source/lean/geometry/opengl-primitive-indexed.ads @@ -2,6 +2,7 @@ private with openGL.Buffer.indices; + package openGL.Primitive.indexed -- -- Provides a class for indexed openGL primitives. @@ -37,6 +38,7 @@ is procedure destroy (Self : in out Item); + -------------- -- Attributes -- @@ -45,6 +47,7 @@ is procedure Indices_are (Self : in out Item; Now : in long_Indices); + -------------- -- Operations -- diff --git a/3-mid/opengl/source/lean/geometry/opengl-primitive-long_indexed.adb b/3-mid/opengl/source/lean/geometry/opengl-primitive-long_indexed.adb index 6008bfa..13596fb 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-primitive-long_indexed.adb +++ b/3-mid/opengl/source/lean/geometry/opengl-primitive-long_indexed.adb @@ -6,6 +6,7 @@ with ada.unchecked_Deallocation; + package body openGL.Primitive.long_indexed is --------- @@ -25,7 +26,7 @@ is Self.facet_Kind := Kind; Self.Indices := new Buffer.long_indices.Object' (to_Buffer (buffer_Indices'Access, - usage => Buffer.static_Draw)); + Usage => Buffer.static_Draw)); end define; @@ -52,6 +53,7 @@ is end destroy; + -------------- -- Attributes -- @@ -70,6 +72,7 @@ is end Indices_are; + -------------- -- Operations -- diff --git a/3-mid/opengl/source/lean/geometry/opengl-primitive-long_indexed.ads b/3-mid/opengl/source/lean/geometry/opengl-primitive-long_indexed.ads index 97bbd03..13bfe3c 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-primitive-long_indexed.ads +++ b/3-mid/opengl/source/lean/geometry/opengl-primitive-long_indexed.ads @@ -2,6 +2,7 @@ private with openGL.Buffer.long_indices; + package openGL.Primitive.long_indexed -- -- Provides a class for long indexed openGL primitives. @@ -27,6 +28,7 @@ is procedure destroy (Self : in out Item); + -------------- -- Attributes -- @@ -34,6 +36,7 @@ is procedure Indices_are (Self : in out Item; Now : in long_Indices); + -------------- -- Operations -- @@ -50,4 +53,5 @@ private Indices : Buffer.long_indices.view; end record; + end openGL.Primitive.long_indexed; diff --git a/3-mid/opengl/source/lean/geometry/opengl-primitive-non_indexed.adb b/3-mid/opengl/source/lean/geometry/opengl-primitive-non_indexed.adb index 823381c..f80df64 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-primitive-non_indexed.adb +++ b/3-mid/opengl/source/lean/geometry/opengl-primitive-non_indexed.adb @@ -3,6 +3,7 @@ with openGL.Tasks, GL.Binding; + package body openGL.Primitive.non_indexed is --------- @@ -29,6 +30,7 @@ is end new_Primitive; + overriding procedure destroy (Self : in out Item) is null; diff --git a/3-mid/opengl/source/lean/geometry/opengl-primitive-non_indexed.ads b/3-mid/opengl/source/lean/geometry/opengl-primitive-non_indexed.ads index 5a6d20b..3f3759c 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-primitive-non_indexed.ads +++ b/3-mid/opengl/source/lean/geometry/opengl-primitive-non_indexed.ads @@ -10,6 +10,7 @@ is type Views is array (Index_t range <>) of View; + --------- -- Forge -- @@ -23,6 +24,7 @@ is function new_Primitive (Kind : in facet_Kind; vertex_Count : in Natural) return Primitive.non_indexed.view; + -------------- -- Operations -- @@ -39,4 +41,5 @@ private vertex_Count : Natural := 0; end record; + end openGL.Primitive.non_indexed; diff --git a/3-mid/opengl/source/lean/geometry/opengl-primitive-short_indexed.adb b/3-mid/opengl/source/lean/geometry/opengl-primitive-short_indexed.adb index bc9fd06..7c17e67 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-primitive-short_indexed.adb +++ b/3-mid/opengl/source/lean/geometry/opengl-primitive-short_indexed.adb @@ -6,6 +6,7 @@ with ada.unchecked_Deallocation; + package body openGL.Primitive.short_indexed is --------- @@ -25,7 +26,7 @@ is Self.facet_Kind := Kind; Self.Indices := new Buffer.short_indices.Object' (to_Buffer (buffer_Indices'Access, - usage => Buffer.static_Draw)); + Usage => Buffer.static_Draw)); end define; @@ -43,7 +44,7 @@ is Self.facet_Kind := Kind; Self.Indices := new Buffer.short_indices.Object' (to_Buffer (buffer_Indices'Access, - usage => Buffer.static_Draw)); + Usage => Buffer.static_Draw)); end define; @@ -61,7 +62,7 @@ is Self.facet_Kind := Kind; Self.Indices := new Buffer.short_indices.Object' (to_Buffer (buffer_Indices'Access, - usage => Buffer.static_Draw)); + Usage => Buffer.static_Draw)); end define; @@ -110,6 +111,7 @@ is end destroy; + -------------- -- Attributes -- @@ -118,13 +120,14 @@ is is use Buffer.short_indices; buffer_Indices : aliased short_Indices := [Now'Range => <>]; + begin for Each in buffer_Indices'Range loop buffer_Indices (Each) := Now (Each) - 1; -- Adjust indices to zero-based-indexing for GL. end loop; - Self.Indices.set (to => buffer_Indices); + Self.Indices.set (To => buffer_Indices); end Indices_are; @@ -133,13 +136,14 @@ is is use Buffer.short_indices; buffer_Indices : aliased short_Indices := [Now'Range => <>]; + begin for Each in buffer_Indices'Range loop buffer_Indices (Each) := short_Index_t (Now (Each) - 1); -- Adjust indices to zero-based-indexing for GL. end loop; - Self.Indices.set (to => buffer_Indices); + Self.Indices.set (To => buffer_Indices); end Indices_are; @@ -148,13 +152,14 @@ is is use Buffer.short_indices; buffer_Indices : aliased short_Indices := [Now'Range => <>]; + begin for Each in buffer_Indices'Range loop buffer_Indices (Each) := short_Index_t (Now (Each) - 1); -- Adjust indices to zero-based-indexing for GL. end loop; - Self.Indices.set (to => buffer_Indices); + Self.Indices.set (To => buffer_Indices); end Indices_are; diff --git a/3-mid/opengl/source/lean/geometry/opengl-primitive-short_indexed.ads b/3-mid/opengl/source/lean/geometry/opengl-primitive-short_indexed.ads index 73cfc90..4a27810 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-primitive-short_indexed.ads +++ b/3-mid/opengl/source/lean/geometry/opengl-primitive-short_indexed.ads @@ -2,6 +2,7 @@ private with openGL.Buffer.short_indices; + package openGL.Primitive.short_indexed -- -- Provides a class for short indexed openGL primitives. @@ -14,6 +15,7 @@ is type Views is array (Index_t range <>) of View; + --------- -- Forge -- @@ -37,6 +39,7 @@ is procedure destroy (Self : in out Item); + -------------- -- Attributes -- @@ -46,6 +49,7 @@ is procedure Indices_are (Self : in out Item; Now : in long_Indices); + -------------- -- Operations -- @@ -62,4 +66,5 @@ private Indices : Buffer.short_indices.view; end record; + end openGL.Primitive.short_indexed; diff --git a/3-mid/opengl/source/lean/geometry/opengl-primitive.adb b/3-mid/opengl/source/lean/geometry/opengl-primitive.adb index bb0e103..7b13a2a 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-primitive.adb +++ b/3-mid/opengl/source/lean/geometry/opengl-primitive.adb @@ -1,8 +1,10 @@ with openGL.Tasks, + openGL.Errors, GL.Binding, ada.unchecked_Deallocation; + package body openGL.Primitive is --------- @@ -16,6 +18,7 @@ is end define; + procedure free (Self : in out View) is procedure deallocate is new ada.Unchecked_Deallocation (Primitive.item'Class, @@ -88,6 +91,7 @@ is if Self.line_Width /= unused_line_Width then glLineWidth (glFloat (Self.line_Width)); + Errors.log; end if; end render; diff --git a/3-mid/opengl/source/lean/geometry/opengl-primitive.ads b/3-mid/opengl/source/lean/geometry/opengl-primitive.ads index b9e8ac8..c7ace62 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-primitive.ads +++ b/3-mid/opengl/source/lean/geometry/opengl-primitive.ads @@ -5,6 +5,7 @@ private with ada.unchecked_Conversion; + package openGL.Primitive -- -- Provides a base class for openGL primitives. @@ -28,7 +29,7 @@ is -- Forge -- - procedure define (Self : in out Item; Kind : in facet_Kind); + procedure define (Self : in out Item; Kind : in facet_Kind); procedure destroy (Self : in out Item) is abstract; procedure free (Self : in out View); @@ -67,7 +68,7 @@ private Texture : openGL.Texture.Object := openGL.Texture.null_Object; is_Transparent : Boolean; Bounds : openGL.Bounds; - line_Width : Real := unused_line_Width; + line_Width : Real := unused_line_Width; end record; diff --git a/3-mid/opengl/source/lean/model/opengl-model-capsule-textured.ads b/3-mid/opengl/source/lean/model/opengl-model-capsule-textured.ads index db9c372..36e71b5 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-capsule-textured.ads +++ b/3-mid/opengl/source/lean/model/opengl-model-capsule-textured.ads @@ -10,7 +10,8 @@ package openGL.Model.capsule.textured is package textured_Model is new texturing.Mixin (openGL.Model.capsule.item); - type Item is new textured_Model.textured_item with private; type View is access all Item'Class; + type Item is new textured_Model.textured_item with private; + type View is access all Item'Class; --------- diff --git a/3-mid/opengl/source/lean/model/opengl-model-circle-lit_textured.adb b/3-mid/opengl/source/lean/model/opengl-model-circle-lit_textured.adb index 10bbdf9..be9cbd5 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-circle-lit_textured.adb +++ b/3-mid/opengl/source/lean/model/opengl-model-circle-lit_textured.adb @@ -86,9 +86,6 @@ is for i in 1 .. Self.texture_Details.Count loop - put_Line ("KKK" & Self.texture_Details'Image); - - Id := texture_Id (i); -- the_Geometry.Fade_is (which => Id, diff --git a/3-mid/opengl/source/lean/model/opengl-model-texturing.adb b/3-mid/opengl/source/lean/model/opengl-model-texturing.adb index 7e4de0d..11d8d44 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-texturing.adb +++ b/3-mid/opengl/source/lean/model/opengl-model-texturing.adb @@ -1,3 +1,7 @@ +with + ada.unchecked_Deallocation; + + package body openGL.Model.texturing is @@ -135,8 +139,16 @@ is procedure texture_Details_is (Self : in out textured_Item; Now : in openGL.texture_Set.item) is + procedure free is new ada.unchecked_Deallocation (Animation, Animation_view); begin + free (Self.texture_Set.Animation); + Self.texture_Set := Now; + + if Now.Animation /= null + then + Self.texture_Set.Animation := new texture_Set.Animation' (Now.Animation.all); + end if; end texture_Details_is; diff --git a/3-mid/opengl/source/lean/opengl-camera.adb b/3-mid/opengl/source/lean/opengl-camera.adb index fca5072..58c815a 100644 --- a/3-mid/opengl/source/lean/opengl-camera.adb +++ b/3-mid/opengl/source/lean/opengl-camera.adb @@ -2,6 +2,7 @@ with ada.Text_IO, ada.Exceptions; + package body openGL.Camera is use math.Algebra.linear, @@ -36,7 +37,7 @@ is -- Attributes -- - function to_World_Site (Self : in Item; Window_Site : in math.Vector_3) return math.Vector_3 + function to_World_Site (Self : in Item; window_Site : in math.Vector_3) return math.Vector_3 is perspective_Transform : constant math.Matrix_4x4 := to_Perspective (FoVy => Self.FoVy, Aspect => Self.Aspect, @@ -56,11 +57,11 @@ is - procedure Site_is (Self : in out Item; now : in math.Vector_3) + procedure Site_is (Self : in out Item; Now : in math.Vector_3) is begin Self.world_Transform := to_transform_Matrix ((Self.Spin, - now)); + Now)); Self.update_View_Transform; end Site_is; @@ -87,7 +88,7 @@ is procedure Spin_is (Self : in out Item'Class; now : in math.Matrix_3x3) is begin - set_Rotation (Self.world_Transform, to => now); + set_Rotation (Self.world_Transform, To => Now); Self.update_View_Transform; end Spin_is; @@ -129,10 +130,10 @@ is end Aspect; - procedure Aspect_is (Self : in out Item'Class; now : in math.Real) + procedure Aspect_is (Self : in out Item'Class; Now : in math.Real) is begin - Self.Aspect := now; + Self.Aspect := Now; end Aspect_is; @@ -144,7 +145,7 @@ is end near_Plane_Distance; - procedure near_Plane_Distance_is (Self : in out Item'Class; now : in math.Real) + procedure near_Plane_Distance_is (Self : in out Item'Class; Now : in math.Real) is begin Self.near_Plane_Distance := now; @@ -159,10 +160,10 @@ is end far_Plane_Distance; - procedure far_Plane_Distance_is (Self : in out Item'Class; now : in math.Real) + procedure far_Plane_Distance_is (Self : in out Item'Class; Now : in math.Real) is begin - Self.far_Plane_Distance := now; + Self.far_Plane_Distance := Now; end far_Plane_Distance_is; @@ -224,7 +225,7 @@ is end Viewport; - procedure Renderer_is (Self : in out Item; now : in Renderer.lean.view) + procedure Renderer_is (Self : in out Item; Now : in Renderer.lean.view) is begin Self.Renderer := now; @@ -253,7 +254,7 @@ is end vanish_Point_Size_min; - procedure vanish_Point_Size_min_is (Self : in out Item'Class; now : in Real) + procedure vanish_Point_Size_min_is (Self : in out Item'Class; Now : in Real) is begin Self.Culler.vanish_Point_Size_min_is (now); @@ -271,17 +272,17 @@ is end Impostor_Size_min; - procedure Impostor_Size_min_is (Self : in out Item; now : in Real) + procedure Impostor_Size_min_is (Self : in out Item; Now : in Real) is begin - Self.Impostorer.Impostor_Size_min_is (now); + Self.Impostorer.Impostor_Size_min_is (Now); end Impostor_Size_min_is; - procedure allow_Impostors (Self : in out Item; now : in Boolean := True) + procedure allow_Impostors (Self : in out Item; Now : in Boolean := True) is begin - Self.Impostors_allowed := now; + Self.Impostors_allowed := Now; end allow_Impostors; @@ -363,11 +364,11 @@ is -- procedure render (Self : in out Item; Visuals : in Visual.views; - to : in Surface.view := null) + To : in Surface.view := null) is pragma Unreferenced (To); -- TODO: Finish using surfaces. begin - Self.cull_Engine.cull (Visuals, do_cull => Self.is_Culling); + Self.cull_Engine.cull (Visuals, do_Cull => Self.is_Culling); end render; diff --git a/3-mid/opengl/source/lean/opengl-camera.ads b/3-mid/opengl/source/lean/opengl-camera.ads index f59a289..31685ae 100644 --- a/3-mid/opengl/source/lean/opengl-camera.ads +++ b/3-mid/opengl/source/lean/opengl-camera.ads @@ -6,6 +6,7 @@ with openGL.Surface, openGL.Renderer.lean; + package openGL.Camera -- -- Simulates a camera. @@ -30,12 +31,12 @@ is fairly_Far : constant := 1_000_000.0; default_field_of_view_Angle : constant Degrees := 60.0; - procedure Renderer_is (Self : in out Item; now : in Renderer.lean.view); + procedure Renderer_is (Self : in out Item; Now : in Renderer.lean.view); - procedure Site_is (Self : in out Item; now : in math.Vector_3); + procedure Site_is (Self : in out Item; Now : in math.Vector_3); function Site (Self : in Item) return math.Vector_3; - procedure Spin_is (Self : in out Item'Class; now : in math.Matrix_3x3); + procedure Spin_is (Self : in out Item'Class; Now : in math.Matrix_3x3); function Spin (Self : in Item'Class) return math.Matrix_3x3; procedure Position_is (Self : in out Item'Class; Site : in math.Vector_3; @@ -46,13 +47,13 @@ is procedure FoVy_is (Self : in out Item'Class; Now : in math.Degrees); function Aspect (Self : in Item'Class) return math.Real; -- X/Y Aspect ratio. - procedure Aspect_is (Self : in out Item'Class; now : in math.Real); + procedure Aspect_is (Self : in out Item'Class; Now : in math.Real); function near_Plane_Distance (Self : in Item'Class) return math.Real; -- Distance to the near clipping plane. function far_Plane_Distance (Self : in Item'Class) return math.Real; -- Distance to the far clipping plane. - procedure near_Plane_Distance_is (Self : in out Item'Class; now : in math.Real); - procedure far_Plane_Distance_is (Self : in out Item'Class; now : in math.Real); + procedure near_Plane_Distance_is (Self : in out Item'Class; Now : in math.Real); + procedure far_Plane_Distance_is (Self : in out Item'Class; Now : in math.Real); function view_Transform (Self : in Item'Class) return math.Matrix_4x4; function projection_Transform (Self : in Item'Class) return math.Matrix_4x4; @@ -61,7 +62,7 @@ is procedure Viewport_is (Self : in out Item'Class; Width, Height : in Positive); - function to_World_Site (Self : in Item; Window_Site : in math.Vector_3) return math.Vector_3; + function to_World_Site (Self : in Item; window_Site : in math.Vector_3) return math.Vector_3; -- -- Returns the 'window space' site transformed to the equivalent 'world space' site. @@ -69,16 +70,16 @@ is procedure disable_cull (Self : in out Item); function vanish_Point_Size_min (Self : in Item'Class) return Real; - procedure vanish_Point_Size_min_is (Self : in out Item'Class; now : in Real); + procedure vanish_Point_Size_min_is (Self : in out Item'Class; Now : in Real); -- -- Visuals whose projected size falls below this minimum will be culled. function Impostor_Size_min (Self : in Item) return Real; - procedure Impostor_Size_min_is (Self : in out Item; now : in Real); + procedure Impostor_Size_min_is (Self : in out Item; Now : in Real); -- -- Visuals whose projected size falls below this minimum will be substituted with impostors. - procedure allow_Impostors (Self : in out Item; now : in Boolean := True); + procedure allow_Impostors (Self : in out Item; Now : in Boolean := True); -------------- @@ -86,7 +87,7 @@ is -- procedure render (Self : in out Item; Visuals : in Visual.views; - to : in Surface.view := null); + To : in Surface.view := null); function current_Planes (Self : in Item) return Frustum.plane_Array; -- diff --git a/3-mid/opengl/source/lean/opengl-frame_buffer.adb b/3-mid/opengl/source/lean/opengl-frame_buffer.adb index 2604283..4c7f7c5 100644 --- a/3-mid/opengl/source/lean/opengl-frame_buffer.adb +++ b/3-mid/opengl/source/lean/opengl-frame_buffer.adb @@ -5,6 +5,7 @@ with openGL.Tasks, openGL.Errors; + package body openGL.Frame_Buffer is @@ -27,17 +28,26 @@ is Self.Texture := openGL.Texture.Forge.to_Texture (Dimensions' (Width, Height)); glGenFramebuffers (1, Self.Name'Access); + Errors.log; -- Attach each texture to the first color buffer of an frame buffer object and clear it. -- glBindFramebuffer (GL_FRAMEBUFFER, Self.Name); + Errors.log; + glFramebufferTexture2D (GL_FRAMEBUFFER, GL_COLOR_ATTACHMENT0, GL_TEXTURE_2D, Self.Texture.Name, 0); + Errors.log; + glClear (GL_COLOR_BUFFER_BIT); + Errors.log; + glBindFramebuffer (GL_FRAMEBUFFER, 0); + Errors.log; + return Self; end to_frame_Buffer; @@ -53,8 +63,10 @@ is Self : Item; begin Tasks.check; + Self.Texture := openGL.Texture.null_Object; glGenFramebuffers (1, Self.Name'Access); + Errors.log; return Self; end to_frame_Buffer; @@ -68,7 +80,10 @@ is use GL.lean; begin Tasks.check; + glDeleteFramebuffers (1, Self.Name'Access); + Errors.log; + Self.Texture.destroy; end destruct; @@ -99,7 +114,6 @@ is GL.lean; begin Tasks.check; - openGL.Errors.log; Self.Texture := Now; @@ -121,7 +135,7 @@ is - function is_complete (Self : in Item) return Boolean + function is_Complete (Self : in Item) return Boolean is use GL, GL.lean; @@ -147,6 +161,7 @@ is check_is_OK : constant Boolean := Tasks.check with Unreferenced; begin glBindFramebuffer (GL_FRAMEBUFFER, Self.Name); + Errors.log; if not Self.is_Complete then @@ -163,6 +178,7 @@ is check_is_OK : constant Boolean := Tasks.check with Unreferenced; begin glBindFramebuffer (GL_FRAMEBUFFER, 0); + Errors.log; end disable; diff --git a/3-mid/opengl/source/lean/opengl-frame_buffer.ads b/3-mid/opengl/source/lean/opengl-frame_buffer.ads index e68e90d..69bfb2e 100644 --- a/3-mid/opengl/source/lean/opengl-frame_buffer.ads +++ b/3-mid/opengl/source/lean/opengl-frame_buffer.ads @@ -1,6 +1,7 @@ with openGL.Texture; + package openGL.Frame_Buffer is @@ -26,6 +27,7 @@ is -------------- --- Attributes -- + subtype Buffer_Name is GL.GLuint; -- An openGL frame buffer 'Name'. function Name (Self : in Item) return Buffer_Name; @@ -33,7 +35,7 @@ is function Texture (Self : in Item) return openGL.Texture.Object; procedure Texture_is (Self : in out Item; now : in openGL.Texture.Object); - function is_complete (Self : in Item) return Boolean; + function is_Complete (Self : in Item) return Boolean; -------------- diff --git a/3-mid/opengl/source/lean/opengl-terrain.ads b/3-mid/opengl/source/lean/opengl-terrain.ads index 23270f1..84cf0a4 100644 --- a/3-mid/opengl/source/lean/opengl-terrain.ads +++ b/3-mid/opengl/source/lean/opengl-terrain.ads @@ -1,6 +1,7 @@ with openGL.Visual; + package openGL.Terrain -- -- Provides a constructor for heightmap terrain. diff --git a/3-mid/opengl/source/lean/opengl-texture.adb b/3-mid/opengl/source/lean/opengl-texture.adb index 8bad11d..ac6fa38 100644 --- a/3-mid/opengl/source/lean/opengl-texture.adb +++ b/3-mid/opengl/source/lean/opengl-texture.adb @@ -28,6 +28,8 @@ is begin Tasks.check; glGenTextures (1, the_Name'Access); + Errors.log; + return the_Name; end new_texture_Name; @@ -39,7 +41,8 @@ is begin Tasks.check; glDeleteTextures (1, the_Name'Access); - end free; + Errors.log; +end free; --------- @@ -52,6 +55,7 @@ is function to_Texture (Name : in texture_Name) return Object is Self : Texture.Object; + begin Self.Name := Name; -- TODO: Fill in remaining fields by querying GL. @@ -72,16 +76,18 @@ is Self.Name := new_texture_Name; Self.enable; - glPixelStorei (GL_UNPACK_ALIGNMENT, 1); + glPixelStorei (GL_UNPACK_ALIGNMENT, 1); Errors.log; - glTexParameteri (GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE); - glTexParameteri (GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); + glTexParameteri (GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE); Errors.log; + + glTexParameteri (GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); Errors.log; -- glTexParameteri (GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT); -- glTexParameteri (GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT); - glTexParameteri (GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR); - glTexParameteri (GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); + glTexParameteri (GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR); Errors.log; + + glTexParameteri (GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); Errors.log; return Self; end to_Texture; @@ -197,13 +203,11 @@ is 0, GL_RGB, GL_UNSIGNED_BYTE, - +the_Image (1, 1).Red'Address); - Errors.log; + +the_Image (1, 1).Red'Address); Errors.log; if use_Mipmaps then - glGenerateMipmap (GL_TEXTURE_2D); - Errors.log; + glGenerateMipmap (GL_TEXTURE_2D); Errors.log; end if; end set_Image; @@ -242,13 +246,11 @@ is 0, GL_RGBA, GL_UNSIGNED_BYTE, - +the_Image (1, 1).Primary.Red'Address); - Errors.log; + +the_Image (1, 1).Primary.Red'Address); Errors.log; if use_Mipmaps then - glGenerateMipmap (GL_TEXTURE_2D); - Errors.log; + glGenerateMipmap (GL_TEXTURE_2D); Errors.log; end if; end set_Image; @@ -273,8 +275,7 @@ is gl.Binding.glTexParameteri (GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT); Errors.log; gl.Binding.glTexParameteri (GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT); Errors.log; - glBindTexture (GL.GL_TEXTURE_2D, Self.Name); - Errors.log; + glBindTexture (GL.GL_TEXTURE_2D, Self.Name); Errors.log; end enable; @@ -320,6 +321,7 @@ is function fetch (From : access name_Map_of_texture'Class; texture_Name : in asset_Name) return Object is Name : constant unbounded_String := to_unbounded_String (to_String (texture_Name)); + begin if From.Contains (Name) then @@ -391,30 +393,36 @@ is GLsizei (Size.Height), 0, GL_RGBA, GL_UNSIGNED_BYTE, - null); -- NB: Actual image is not initialised. + null); Errors.log; -- NB: Actual image is not initialised. - else -- No existing, unused texture found, so create a new one. + else -- No existing, unused texture found, so create a new one. the_Texture.Pool := From.all'unchecked_Access; the_Texture.Name := new_texture_Name; the_Texture.enable; - glPixelStorei (GL_UNPACK_ALIGNMENT, 1); - glTexParameteri (GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, - GL_CLAMP_TO_EDGE); - glTexParameteri (GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, - GL_CLAMP_TO_EDGE); + glPixelStorei (GL_UNPACK_ALIGNMENT, 1); Errors.log; - glTexParameteri (GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, - GL_LINEAR); - glTexParameteri (GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, + glTexParameteri (GL_TEXTURE_2D, + GL_TEXTURE_WRAP_S, + GL_CLAMP_TO_EDGE); Errors.log; + + glTexParameteri (GL_TEXTURE_2D, + GL_TEXTURE_WRAP_T, + GL_CLAMP_TO_EDGE); Errors.log; + + glTexParameteri (GL_TEXTURE_2D, + GL_TEXTURE_MAG_FILTER, GL_LINEAR); + glTexParameteri (GL_TEXTURE_2D, + GL_TEXTURE_MIN_FILTER, + GL_LINEAR); Errors.log; gltexImage2D (gl_TEXTURE_2D, 0, gl_RGBA, GLsizei (Size.Width), GLsizei (Size.Height), 0, GL_RGBA, GL_UNSIGNED_BYTE, - null); -- NB: Actual image is not initialised. + null); Errors.log; -- NB: Actual image is not initialised. end if; the_Texture.Dimensions := Size; @@ -428,7 +436,8 @@ is is use type texture_Name; begin - if the_Texture.Name = 0 then + if the_Texture.Name = 0 + then return; end if; diff --git a/3-mid/opengl/source/lean/opengl-texture.ads b/3-mid/opengl/source/lean/opengl-texture.ads index 5fe1d87..4358594 100644 --- a/3-mid/opengl/source/lean/opengl-texture.ads +++ b/3-mid/opengl/source/lean/opengl-texture.ads @@ -3,6 +3,7 @@ with ada.Strings.unbounded.Hash, ada.Containers.hashed_Maps; + package openGL.Texture -- -- Provides openGL textures. @@ -73,8 +74,6 @@ is -- -- For rapid allocation/deallocation of texture objects. - -- TODO: Move this into a child package ? - type Pool is private; type Pool_view is access all Pool; diff --git a/3-mid/opengl/source/lean/opengl-texture_set.adb b/3-mid/opengl/source/lean/opengl-texture_set.adb index 36b834b..d07fd28 100644 --- a/3-mid/opengl/source/lean/opengl-texture_set.adb +++ b/3-mid/opengl/source/lean/opengl-texture_set.adb @@ -19,33 +19,6 @@ is - -- procedure animate (the_Animation : in out Animation; - -- texture_Applies : in out texture_Apply_array) - -- is - -- use ada.Calendar; - -- - -- Now : constant ada.Calendar.Time := Clock; - -- - -- begin - -- if Now >= the_Animation.next_frame_Time - -- then - -- declare - -- next_frame_Id : constant frame_Id := (if the_Animation.Current < the_Animation.frame_Count then the_Animation.Current + 1 - -- else 1); - -- old_Frame : Frame renames the_Animation.Frames (the_Animation.Current); - -- new_Frame : Frame renames the_Animation.Frames (next_frame_Id); - -- begin - -- texture_Applies (old_Frame.texture_Id) := False; - -- texture_Applies (new_Frame.texture_Id) := True; - -- - -- the_Animation.Current := next_frame_Id; - -- the_Animation.next_frame_Time := Now + the_Animation.frame_Duration; - -- end; - -- end if; - -- end animate; - - - procedure animate (Self : in out Item) is use ada.Calendar; @@ -72,33 +45,13 @@ is - ----------- - --- Details + --------- + --- Forge -- - -- function to_Details (texture_Assets : in asset_Names; - -- Animation : in Animation_view := null) return Details - -- is - -- Result : Details; - -- begin - -- Result.texture_Count := texture_Assets'Length; - -- - -- for i in 1 .. texture_Assets'Length - -- loop - -- Result.Textures (i) := texture_Assets (i); - -- end loop; - -- - -- Result.Animation := Animation; - -- - -- return Result; - -- end to_Details; - - - function to_Set (texture_Assets : in asset_Names; texture_Tilings : in Tilings := [others => (S => 1.0, T => 1.0)]; - Animation : in Animation_view := null) return Item is Result : Item (Count => texture_Assets'Length); @@ -126,42 +79,6 @@ is - -------------- - --- Attributes - -- - - -- function get_Details (Self : in Item) return Detail_array - -- is - -- begin - -- return Self.Details; - -- end get_Details; - -- - -- - -- - -- procedure Details_are (Self : in out Item; Now : in Detail_array) - -- is - -- begin - -- Self.Details := Now; - -- end Details_are; - -- - -- - -- - -- function get_Animation (Self : in Item) return Animation_view - -- is - -- begin - -- return Self.Animation; - -- end get_Animation; - -- - -- - -- - -- procedure Animation_is (Self : in out Item; Now : in Animation_view) - -- is - -- begin - -- Self.Animation := Now; - -- end Animation_is; - - - ----------- --- Streams -- diff --git a/3-mid/opengl/source/lean/opengl-texture_set.ads b/3-mid/opengl/source/lean/opengl-texture_set.ads index b47f9c3..4b1f554 100644 --- a/3-mid/opengl/source/lean/opengl-texture_set.ads +++ b/3-mid/opengl/source/lean/opengl-texture_set.ads @@ -17,17 +17,9 @@ is max_Textures : constant := 16; -- 32; - type detail_Count is range 0 .. max_Textures; - -- type Item (Count : detail_Count := 1) is private; - -- - -- null_Set : constant Item; - - - - --------------- --- Texture Ids -- @@ -60,13 +52,6 @@ is type fade_Levels is array (texture_Id range <>) of fade_Level; - --------- - --- Apply - -- - - -- type texture_Apply_array is array (texture_Set.texture_Id) of Boolean; - - ------------- --- Animation -- @@ -96,42 +81,19 @@ is type Animation_view is access all Animation; - -- procedure animate (the_Animation : in out Animation; - -- texture_Applies : in out texture_Apply_array); - - - type Detail is record Object : texture.Object; Texture : asset_Name; Fade : fade_Level; texture_Tiling : Tiling; - texture_Apply : Boolean; -- If the textures is to be applied to the visual. + texture_Apply : Boolean; -- If the texture is to be applied to the visual. end record; type Detail_array is array (detail_Count range <>) of Detail; - ----------- - --- Details - -- - - -- type Details is - -- record - -- texture_Count : Natural := 0; - -- Fades : fade_Levels (texture_Id) := [others => 0.0]; - -- Textures : asset_Names (1 .. Positive (texture_Id'Last)) := [others => null_Asset]; - -- Objects : texture.Objects (1 .. Positive (texture_Id'Last)) := [others => texture.null_Object]; - -- texture_Tilings : Tilings := [others => (S => 1.0, - -- T => 1.0)]; - -- texture_Applies : texture_Apply_array := [1 => True, others => False]; -- The textures to be applied to the visual. - -- Animation : Animation_view; - -- end record; - - - type Item (Count : detail_Count := 1) is record Details : Detail_array (1 .. Count); @@ -141,19 +103,10 @@ is null_Set : constant Item; - - - --------- --- Forge -- - -- function to_Details (texture_Assets : in asset_Names; - -- Animation : in Animation_view := null) return Details; - -- - -- no_Details : constant Details; - - function to_Set (texture_Assets : in asset_Names; texture_Tilings : in Tilings := [others => (S => 1.0, T => 1.0)]; @@ -161,17 +114,11 @@ is -------------- - --- Attributes + -- Operations -- procedure animate (Self : in out Item); - -- function get_Details (Self : in Item) return Detail_array; - -- procedure Details_are (Self : in out Item; Now : in Detail_array); - -- - -- function get_Animation (Self : in Item) return Animation_view; - -- procedure Animation_is (Self : in out Item; Now : in Animation_view); - private @@ -191,7 +138,6 @@ private for Animation_view'read use read; - -- no_Details : constant Details := (others => <>); null_Set : constant Item := (Count => 0, others => <>); diff --git a/3-mid/opengl/source/lean/opengl-viewport.adb b/3-mid/opengl/source/lean/opengl-viewport.adb index 7d59ae6..c3f6350 100644 --- a/3-mid/opengl/source/lean/opengl-viewport.adb +++ b/3-mid/opengl/source/lean/opengl-viewport.adb @@ -1,6 +1,8 @@ with GL.Binding, - openGL.Tasks; + openGL.Tasks, + openGL.Errors; + package body openGL.Viewport is @@ -14,7 +16,7 @@ is begin Tasks.check; glGetIntegerv (gl_VIEWPORT, - Extent (1)'unchecked_Access); + Extent (1)'unchecked_Access); Errors.log; return (Integer (Extent (3)), Integer (Extent (4))); @@ -29,7 +31,7 @@ is Tasks.check; glViewport (0, 0, GLint (Now.Width), - GLint (Now.Height)); + GLint (Now.Height)); Errors.log; end Extent_is; diff --git a/3-mid/opengl/source/lean/opengl-visual.adb b/3-mid/opengl/source/lean/opengl-visual.adb index 9b6de7b..30c7f53 100644 --- a/3-mid/opengl/source/lean/opengl-visual.adb +++ b/3-mid/opengl/source/lean/opengl-visual.adb @@ -13,7 +13,6 @@ is is begin return new Visual.item' (Model => Model, - model_Transform => Identity_4x4, camera_Transform => Identity_4x4, Transform => Identity_4x4, mvp_Transform => Identity_4x4, @@ -66,7 +65,7 @@ is - function is_Terrain (Self : in Item) return Boolean + function is_Terrain (Self : in Item) return Boolean is begin return Self.is_Terrain; @@ -139,21 +138,6 @@ is end mvp_Transform_is; - function model_Transform (Self : in Item) return Matrix_4x4 - is - begin - return Self.model_Transform; - end model_Transform; - - - procedure model_Transform_is (Self : in out Item; Now : in Matrix_4x4) - is - begin - Self.model_Transform := Now; - end model_Transform_is; - - - function camera_Transform (Self : in Item) return Matrix_4x4 is begin @@ -174,7 +158,6 @@ is use linear_Algebra_3d; begin set_Rotation (Self.Transform, Now); - -- set_Rotation (Self.model_Transform, Now); end Spin_is; @@ -183,7 +166,6 @@ is use linear_Algebra_3d; begin return get_Rotation (Self.Transform); - -- return get_Rotation (Self.model_Transform); end Spin_of; @@ -193,7 +175,6 @@ is use linear_Algebra_3d; begin set_Translation (Self.Transform, Now); - -- set_Translation (Self.model_Transform, Now); end Site_is; @@ -202,7 +183,6 @@ is use linear_Algebra_3d; begin return get_Translation (Self.Transform); - -- return get_Translation (Self.model_Transform); end Site_of; diff --git a/3-mid/opengl/source/lean/opengl-visual.ads b/3-mid/opengl/source/lean/opengl-visual.ads index d691e87..f862b68 100644 --- a/3-mid/opengl/source/lean/opengl-visual.ads +++ b/3-mid/opengl/source/lean/opengl-visual.ads @@ -2,6 +2,7 @@ with openGL.Program, openGL.Model; + package openGL.Visual is type Item is tagged private; @@ -31,38 +32,38 @@ is -- Attributes -- - procedure Model_is (Self : in out Item; Now : in Model.view); - function Model (Self : in Item) return Model.view; + procedure Model_is (Self : in out Item; Now : in Model.view); + function Model (Self : in Item) return Model.view; - procedure Scale_is (Self : in out Item; Now : in Vector_3); - function Scale (Self : in Item) return Vector_3; + procedure Scale_is (Self : in out Item; Now : in Vector_3); + function Scale (Self : in Item) return Vector_3; - procedure is_Terrain (Self : in out Item; Now : in Boolean := True); - function is_Terrain (Self : in Item) return Boolean; + procedure is_Terrain (Self : in out Item; Now : in Boolean := True); + function is_Terrain (Self : in Item) return Boolean; - procedure face_Count_is (Self : in out Item; Now : in Natural); - function face_Count (Self : in Item) return Natural; + procedure face_Count_is (Self : in out Item; Now : in Natural); + function face_Count (Self : in Item) return Natural; - procedure apparent_Size_is (Self : in out Item; Now : in Real); - function apparent_Size (Self : in Item) return Real; + procedure apparent_Size_is (Self : in out Item; Now : in Real); + function apparent_Size (Self : in Item) return Real; - procedure mvp_Transform_is (Self : in out Item; Now : in Matrix_4x4); - function mvp_Transform (Self : in Item) return Matrix_4x4; + procedure mvp_Transform_is (Self : in out Item; Now : in Matrix_4x4); + function mvp_Transform (Self : in Item) return Matrix_4x4; - procedure model_Transform_is (Self : in out Item; Now : in Matrix_4x4); - function model_Transform (Self : in Item) return Matrix_4x4; + -- procedure model_Transform_is (Self : in out Item; Now : in Matrix_4x4); + -- function model_Transform (Self : in Item) return Matrix_4x4; procedure camera_Transform_is (Self : in out Item; Now : in Matrix_4x4); function camera_Transform (Self : in Item) return Matrix_4x4; - procedure Transform_is (Self : in out Item; Now : in Matrix_4x4); - function Transform (Self : in Item) return Matrix_4x4; + procedure Transform_is (Self : in out Item; Now : in Matrix_4x4); + function Transform (Self : in Item) return Matrix_4x4; - procedure Site_is (Self : in out Item; Now : in Vector_3); - function Site_of (Self : in Item) return Vector_3; + procedure Site_is (Self : in out Item; Now : in Vector_3); + function Site_of (Self : in Item) return Vector_3; - procedure Spin_is (Self : in out Item; Now : in Matrix_3x3); - function Spin_of (Self : in Item) return Matrix_3x3; + procedure Spin_is (Self : in out Item; Now : in Matrix_3x3); + function Spin_of (Self : in Item) return Matrix_3x3; procedure program_Parameters_are (Self : in out Item; Now : in program.Parameters_view); function program_Parameters (Self : in Item) return program.Parameters_view; @@ -76,17 +77,16 @@ private Model : openGL.Model.view; Scale : Vector_3 := [1.0, 1.0, 1.0]; - model_Transform : Matrix_4x4; camera_Transform : Matrix_4x4; Transform : Matrix_4x4; mvp_Transform : Matrix_4x4; program_Parameters : program.Parameters_view; - is_Terrain : Boolean := False; - face_Count : Positive := 1; + is_Terrain : Boolean := False; + face_Count : Positive := 1; - apparent_Size : Real; -- A measure of how large the visual is in screen size. + apparent_Size : Real; -- A measure of how large the visual is in screen size. end record; end openGL.Visual; diff --git a/3-mid/opengl/source/lean/renderer/opengl-renderer-lean.adb b/3-mid/opengl/source/lean/renderer/opengl-renderer-lean.adb index f11b030..7b84538 100644 --- a/3-mid/opengl/source/lean/renderer/opengl-renderer-lean.adb +++ b/3-mid/opengl/source/lean/renderer/opengl-renderer-lean.adb @@ -697,9 +697,9 @@ is Heap_less_than'unrestricted_Access); end if; - glDisable (GL_BLEND); - glEnable (GL_DEPTH_TEST); - glDepthMask (gl_TRUE); -- Make depth buffer read/write. + glDisable (GL_BLEND); Errors.log; + glEnable (GL_DEPTH_TEST); Errors.log; + glDepthMask (gl_TRUE); Errors.log; -- Make depth buffer read/write. for Each in 1 .. opaque_Count loop @@ -710,6 +710,7 @@ is current_Program := the_Couple.Geometry.Program; end if; + current_Program.enable; -- TODO: Only need to do this when program changes ? current_Program.mvp_Transform_is (the_Couple.Visual.mvp_Transform); current_Program.model_Matrix_is (the_Couple.Visual.Transform); @@ -759,13 +760,13 @@ is Heap_less_than'unrestricted_Access); end if; - glDepthMask (gl_False); -- Make depth buffer read-only, for correct transparency. + glDepthMask (gl_False); Errors.log; -- Make depth buffer read-only, for correct transparency. - glEnable (GL_BLEND); - gl.lean.glBlendEquation (gl.lean.GL_FUNC_ADD); + glEnable (GL_BLEND); Errors.log; + gl.lean.glBlendEquation (gl.lean.GL_FUNC_ADD); Errors.log; glBlendFunc (GL_SRC_ALPHA, - GL_ONE_MINUS_SRC_ALPHA); + GL_ONE_MINUS_SRC_ALPHA); Errors.log; for Each in 1 .. lucid_Count loop @@ -786,7 +787,7 @@ is the_Couple.Geometry.render; end loop; - glDepthMask (gl_True); + glDepthMask (gl_True); Errors.log; end; Errors.log; diff --git a/3-mid/opengl/source/opengl-errors-debugging.adb b/3-mid/opengl/source/opengl-errors-debugging.adb index 126ad2d..2b69ab2 100644 --- a/3-mid/opengl/source/opengl-errors-debugging.adb +++ b/3-mid/opengl/source/opengl-errors-debugging.adb @@ -3,5 +3,5 @@ separate (openGL.Errors) function Debugging return Boolean is begin - return True; + return False; end Debugging; diff --git a/4-high/gel/applet/demo/sprite/mixed_shapes/launch_mixed_shapes.adb b/4-high/gel/applet/demo/sprite/mixed_shapes/launch_mixed_shapes.adb index fefb652..961f2c2 100644 --- a/4-high/gel/applet/demo/sprite/mixed_shapes/launch_mixed_shapes.adb +++ b/4-high/gel/applet/demo/sprite/mixed_shapes/launch_mixed_shapes.adb @@ -8,6 +8,7 @@ with physics.Model, openGL.Model.box.colored, + openGL.Model.sphere.lit_textured, openGL.Model.sphere.lit_colored_textured, openGL.Model.capsule.lit_colored_textured, openGL.Model.capsule.textured, @@ -89,17 +90,17 @@ is hs : constant := 1.0; gl_Heights : constant openGL.IO.height_Map_view := openGL.IO.to_height_Map (image_Filename => terrain_Heights, - Scale => 2.0); + Scale => 10.0); the_heightfield_Model : constant openGL.Model.terrain.view - := openGL.Model.terrain.new_Terrain (heights_Asset => terrain_Heights, - Row => 1, - Col => 1, - Heights => openGL.Model.terrain.height_Map_view (gl_Heights), - color_Map => terrain_Texture, - texture_Details => texture_Set.to_Set ([1 => terrain_Texture]), - Tiling => (s => (0.0, 1.0), - t => (0.0, 1.0))); + := openGL.Model.terrain.new_Terrain (heights_Asset => terrain_Heights, + Row => 1, + Col => 1, + Heights => openGL.Model.terrain.height_Map_view (gl_Heights), + color_Map => terrain_Texture, + texture_Details => texture_Set.to_Set ([1 => terrain_Texture]), + Tiling => (s => (0.0, 1.0), + t => (0.0, 1.0))); the_heightfield_physics_Model : constant physics.Model.view := physics.Model.forge.new_physics_Model (shape_Info => (Kind => physics.Model.heightfield, @@ -127,6 +128,8 @@ begin Light : openGL.Light.item := the_Applet.Renderer.new_Light; begin Light.Site_is ([0.0, 1000.0, 0.0]); + Light.ambient_Coefficient_is (0.1); + -- Light.Kind_is (openGL.Light.Diffuse); the_Applet.Renderer.set (Light); end; @@ -167,10 +170,18 @@ begin sphere_Radius => 1.0), Mass => 1.0); - the_ball_Model : constant openGL.Model.sphere.lit_colored_textured.view - := openGL.Model.sphere.lit_colored_textured.new_Sphere (Radius => 1.0, - Image => openGL.to_Asset ("assets/gel/golf_green-16x16.tga"), - texture_Details => texture_Set.to_Set ([1 => openGL.to_Asset ("assets/gel/Face1.bmp")])); + -- the_ball_Model : constant openGL.Model.sphere.lit_colored_textured.view + -- := openGL.Model.sphere.lit_colored_textured.new_Sphere (Radius => 1.0, + -- -- Image => openGL.to_Asset ("assets/gel/golf_green-16x16.tga"), + -- Image => openGL.to_Asset ("assets/gel/texture/earth_map.bmp"), + -- -- texture_Details => texture_Set.to_Set ([1 => openGL.to_Asset ("assets/gel/Face1.bmp")])); + -- texture_Details => texture_Set.to_Set ([1 => openGL.to_Asset ("assets/gel/texture/earth_map.bmp")])); + the_ball_Model : constant openGL.Model.sphere.lit_textured.view + := openGL.Model.sphere.lit_textured.new_Sphere (Radius => 1.0, + -- Image => openGL.to_Asset ("assets/gel/golf_green-16x16.tga"), + Image => openGL.to_Asset ("assets/gel/texture/earth_map.bmp"), + -- texture_Details => texture_Set.to_Set ([1 => openGL.to_Asset ("assets/gel/Face1.bmp")])); + texture_Details => texture_Set.to_Set ([1 => openGL.to_Asset ("assets/gel/texture/earth_map.bmp")])); the_Ball : constant gel.Sprite.view := gel.Sprite.forge.new_Sprite (Name => "demo.Ball", World => the_Applet.gui_World.all'Access, @@ -260,12 +271,12 @@ begin s : constant := 0.5; the_hull_Model : constant openGL.Model.box.colored.view := openGL.Model.box.colored.new_Box (Size => [s*2.0, s*2.0, s*2.0], - Faces => [Front => (Colors => [others => (Shade_of (Grey, 1.0), Opaque)]), - Rear => (Colors => [others => (Shade_of (Grey, 0.5), Opaque)]), - Upper => (Colors => [others => (Shade_of (Grey, 0.4), Opaque)]), - Lower => (Colors => [others => (Shade_of (Grey, 0.3), Opaque)]), - Left => (Colors => [others => (Shade_of (Grey, 0.2), Opaque)]), - Right => (Colors => [others => (Shade_of (Grey, 0.1), Opaque)])]); + Faces => [Front => (Colors => [others => (Shade_of (Green, 1.0), Opaque)]), + Rear => (Colors => [others => (Shade_of (Green, 0.5), Opaque)]), + Upper => (Colors => [others => (Shade_of (Green, 0.4), Opaque)]), + Lower => (Colors => [others => (Shade_of (Green, 0.3), Opaque)]), + Left => (Colors => [others => (Shade_of (Green, 0.2), Opaque)]), + Right => (Colors => [others => (Shade_of (Green, 0.1), Opaque)])]); the_hull_physics_Model : constant physics.Model.view := physics.Model.forge.new_physics_Model (shape_Info => (Kind => physics.Model.hull, Points => new physics.Vector_3_array' ([-s, -s, s],