From 86721ca2db0c45bb9da1ad7f62404aed60deee12 Mon Sep 17 00:00:00 2001 From: Rod Kay Date: Mon, 1 May 2023 21:17:12 +1000 Subject: [PATCH] openGL: Add preliminary multi-texturing code. --- .../launch_render_two_textures.adb | 87 ++++ .../render_two_textures.gpr | 16 + .../opengl/assets/shader/lit_textured_x2.frag | 142 ++++++ .../opengl/assets/shader/lit_textured_x2.vert | 29 ++ .../opengl-geometry-lit_textured_x2.adb | 406 ++++++++++++++++++ .../opengl-geometry-lit_textured_x2.ads | 66 +++ .../source/lean/geometry/opengl-geometry.adb | 217 +++++++++- .../source/lean/geometry/opengl-geometry.ads | 57 ++- .../opengl-model-hexagon-lit_textured_x2.adb | 123 ++++++ .../opengl-model-hexagon-lit_textured_x2.ads | 51 +++ .../source/lean/shader/opengl-program-lit.adb | 47 +- 11 files changed, 1227 insertions(+), 14 deletions(-) create mode 100644 3-mid/opengl/applet/demo/textures/render_two_textures/launch_render_two_textures.adb create mode 100644 3-mid/opengl/applet/demo/textures/render_two_textures/render_two_textures.gpr create mode 100644 3-mid/opengl/assets/shader/lit_textured_x2.frag create mode 100644 3-mid/opengl/assets/shader/lit_textured_x2.vert create mode 100644 3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured_x2.adb create mode 100644 3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured_x2.ads create mode 100644 3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured_x2.adb create mode 100644 3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured_x2.ads diff --git a/3-mid/opengl/applet/demo/textures/render_two_textures/launch_render_two_textures.adb b/3-mid/opengl/applet/demo/textures/render_two_textures/launch_render_two_textures.adb new file mode 100644 index 0000000..e65e5f3 --- /dev/null +++ b/3-mid/opengl/applet/demo/textures/render_two_textures/launch_render_two_textures.adb @@ -0,0 +1,87 @@ +with + openGL.Model.hexagon.lit_textured_x2, + openGL.Visual, + openGL.Light, + openGL.Palette, + -- openGL.IO, + openGL.Demo; + + +procedure launch_render_two_Textures +-- +-- Renders a hexagon grid. +-- +is + use openGL, + openGL.Math, + openGL.linear_Algebra_3D, + openGL.Palette, + openGL.Light; + + + -------------- + -- The model. + -- + the_1st_Texture : constant asset_Name := to_Asset ("assets/opengl/texture/blobber_floor.png"); + the_2nd_Texture : constant asset_Name := to_Asset ("assets/opengl/texture/crawl_blob-1.png"); + + the_textured_hexagon_Model : constant Model.hexagon.lit_textured_x2.view + := Model.hexagon.lit_textured_x2.new_Hexagon (Radius => 0.5, + Face => (Texture_1 => the_1st_Texture, + Texture_2 => the_2nd_Texture, + Fade_1 => 0.5, + Fade_2 => 0.5)); + ---------------- + --- The visual. + -- + use openGL.Visual.Forge; + + the_Hex : constant openGL.Visual.view := new_Visual (the_textured_hexagon_Model.all'Access); + + -------------- + --- The light. + -- + the_Light : openGL.Light.item := Demo.Renderer.new_Light; + light_Site : constant openGL.Vector_3 := [0.0, 0.0, 15.0]; + cone_Direction : constant openGL.Vector_3 := [0.0, 0.0, -1.0]; + +begin + Demo.print_Usage; + Demo.define ("openGL 'render two Textures' Demo", + Width => 1_000, + Height =>1_000); + + Demo.Camera.Position_is ([0.0, 2.0, 0.0], + x_Rotation_from (to_Radians (90.0))); + + -- Set up the light. + -- + the_Light. Kind_is (Diffuse); + the_Light. Site_is (light_Site); + the_Light. Color_is (White); + the_Light.ambient_Coefficient_is (0.8); + the_Light. cone_Angle_is (5.0); + the_Light. cone_Direction_is (cone_Direction); + + Demo.Renderer.set (the_Light); + + + -- Main loop. + -- + while not Demo.Done + loop + Demo.Dolly.evolve; + Demo.Done := Demo.Dolly.quit_Requested; + + Demo.Camera.render ([1 => the_Hex]); + + while not Demo.Camera.cull_Completed + loop + delay Duration'Small; + end loop; + + Demo.Renderer.render; + Demo.FPS_Counter.increment; -- Frames per second display. + end loop; + Demo.destroy; +end launch_render_two_Textures; diff --git a/3-mid/opengl/applet/demo/textures/render_two_textures/render_two_textures.gpr b/3-mid/opengl/applet/demo/textures/render_two_textures/render_two_textures.gpr new file mode 100644 index 0000000..a8e0334 --- /dev/null +++ b/3-mid/opengl/applet/demo/textures/render_two_textures/render_two_textures.gpr @@ -0,0 +1,16 @@ +with + "opengl_demo", + "lace_shared"; + +project render_two_Textures +is + for Object_Dir use "build"; + for Exec_Dir use "."; + for Main use ("launch_render_two_textures.adb"); + + package Ide renames Lace_shared.Ide; + package Builder renames Lace_shared.Builder; + package Compiler renames Lace_shared.Compiler; + package Binder renames Lace_shared.Binder; + +end render_two_Textures; diff --git a/3-mid/opengl/assets/shader/lit_textured_x2.frag b/3-mid/opengl/assets/shader/lit_textured_x2.frag new file mode 100644 index 0000000..0d44dc1 --- /dev/null +++ b/3-mid/opengl/assets/shader/lit_textured_x2.frag @@ -0,0 +1,142 @@ +#version 140 + +struct light +{ + vec4 Site; + vec3 Color; + float Attenuation; + float ambient_Coefficient; + float cone_Angle; + vec3 cone_Direction; +}; + + +uniform mat4 model_Transform; +uniform mat3 inverse_model_Rotation; +uniform vec3 camera_Site; +uniform vec3 specular_Color; // The materials specular color. + +uniform int texture_Count; +uniform sampler2D Textures [32]; +uniform float Fade [32]; + +uniform int light_Count; +uniform light Lights [10]; + + +in vec3 frag_Site; +in vec3 frag_Normal; +in vec2 frag_Coords; +in float frag_Shine; + +out vec4 final_Color; + + +vec3 +apply_Light (light Light, + vec3 surface_Color, + vec3 Normal, + vec3 surface_Site, + vec3 Surface_to_Camera) +{ + vec3 Surface_to_Light; + float Attenuation = 1.0; + + if (Light.Site.w == 0.0) + { + // Directional light. + // + Surface_to_Light = normalize (-Light.Site.xyz); + Attenuation = 1.0; // No attenuation for directional lights. + } + else + { + // Point light. + // + vec3 Surface_to_Light_vector = Light.Site.xyz - surface_Site; + float Distance_to_Light = length (Surface_to_Light_vector); + + Surface_to_Light = normalize (Surface_to_Light_vector); + Attenuation = 1.0 + / ( 1.0 + + Light.Attenuation + * pow (Distance_to_Light, 2)); + + // Cone restrictions which affects attenuation. + // + float Light_to_Surface_Angle = degrees (acos (dot (-Surface_to_Light, + normalize (Light.cone_Direction)))); + + if (Light_to_Surface_Angle > Light.cone_Angle) + { + Attenuation = 0.0; + } + } + + vec3 lit_surface_Color = surface_Color * Light.Color; + vec3 Ambient = Light.ambient_Coefficient * lit_surface_Color; + float diffuse_Coefficient = max (0.0, + dot (Normal, + Surface_to_Light)); + vec3 Diffuse = diffuse_Coefficient * lit_surface_Color; + float specular_Coefficient = 0.0; + + if (diffuse_Coefficient > 0.0) + specular_Coefficient = pow (max (0.0, + dot (Surface_to_Camera, + reflect (-Surface_to_Light, + Normal))), + frag_Shine); + + vec3 Specular = specular_Coefficient * specular_Color * Light.Color; + + return Ambient + Attenuation * (Diffuse + Specular); // Linear color (before gamma correction). +} + + + +void +main() +{ + vec3 surface_Site = vec3 ( model_Transform + * vec4 (frag_Site, 1)); + + vec4 surface_Color = vec4 (0); + + for (int i = 0; i < texture_Count; ++i) + { +// surface_Color += texture (Textures [i], +// frag_Coords); + + surface_Color.rgb += texture (Textures [i], + frag_Coords).rgb * (1.0 - Fade [i]); + + surface_Color.a = max (surface_Color.a, texture (Textures [i], + frag_Coords).a); + } + + surface_Color = surface_Color; // / texture_Count; + + vec3 Surface_to_Camera = normalize (camera_Site - surface_Site); + vec3 Normal = normalize ( frag_Normal + * inverse_model_Rotation); + + // Combine color from all the lights. + // + vec3 linear_Color = vec3 (0); + + for (int i = 0; i < light_Count; ++i) + { + linear_Color += apply_Light (Lights [i], + surface_Color.rgb, + Normal, + surface_Site, + Surface_to_Camera); + } + + vec3 Gamma = vec3 (1.0 / 2.2); + + final_Color = vec4 (pow (linear_Color, // Final color (after gamma correction). + Gamma), + surface_Color.a); +} \ No newline at end of file diff --git a/3-mid/opengl/assets/shader/lit_textured_x2.vert b/3-mid/opengl/assets/shader/lit_textured_x2.vert new file mode 100644 index 0000000..50be162 --- /dev/null +++ b/3-mid/opengl/assets/shader/lit_textured_x2.vert @@ -0,0 +1,29 @@ +#version 140 + +uniform mat4 mvp_Transform; +uniform vec3 Scale; + +in vec3 Site; +in vec3 Normal; +in vec2 Coords; +in float Shine; + +out vec3 frag_Site; +out vec3 frag_Normal; +out vec2 frag_Coords; +out float frag_Shine; + + +void main() +{ + // Pass some variables to the fragment shader. + // + frag_Site = Site; + frag_Normal = Normal; + frag_Coords = Coords; + frag_Shine = Shine; + + // Apply all matrix transformations to 'Site'. + // + gl_Position = mvp_Transform * vec4 (Site * Scale, 1); +} \ No newline at end of file diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured_x2.adb b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured_x2.adb new file mode 100644 index 0000000..e12f3b4 --- /dev/null +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured_x2.adb @@ -0,0 +1,406 @@ +with + openGL.Buffer.general, + openGL.Shader, + openGL.Program.lit, + openGL.Attribute, + openGL.Variable.uniform, + openGL.Texture, + openGL.Palette, + openGL.Tasks, + openGL.Errors, + + GL.Binding, + GL.lean, + GL.Pointers, + + ada.Strings.fixed, + Interfaces.C.Strings, + System.storage_Elements; + +with ada.Text_IO; use ada.Text_IO; + + +package body openGL.Geometry.lit_textured_x2 +is + use GL.lean, + GL.Pointers, + Interfaces; + + ----------- + -- Globals + -- + + vertex_Shader : aliased Shader.item; + fragment_Shader : aliased Shader.item; + + the_Program : openGL.Program.lit.view; + white_Texture : openGL.Texture.Object; + + Name_1 : constant String := "Site"; + Name_2 : constant String := "Normal"; + Name_3 : constant String := "Coords"; + -- Name_4 : constant String := "Coords_2"; + Name_5 : constant String := "Shine"; + + Attribute_1_Name : aliased C.char_array := C.to_C (Name_1); + Attribute_2_Name : aliased C.char_array := C.to_C (Name_2); + Attribute_3_Name : aliased C.char_array := C.to_C (Name_3); + -- Attribute_4_Name : aliased C.char_array := C.to_C (Name_4); + Attribute_5_Name : aliased C.char_array := C.to_C (Name_5); + + Attribute_1_Name_ptr : aliased constant C.strings.chars_ptr := C.strings.to_chars_ptr (Attribute_1_Name'Access); + Attribute_2_Name_ptr : aliased constant C.strings.chars_ptr := C.strings.to_chars_ptr (Attribute_2_Name'Access); + Attribute_3_Name_ptr : aliased constant C.strings.chars_ptr := C.strings.to_chars_ptr (Attribute_3_Name'Access); + -- Attribute_4_Name_ptr : aliased constant C.strings.chars_ptr := C.strings.to_chars_ptr (Attribute_4_Name'Access); + Attribute_5_Name_ptr : aliased constant C.strings.chars_ptr := C.strings.to_chars_ptr (Attribute_5_Name'Access); + + + --------- + -- Forge + -- + + function new_Geometry return View + is + use System, + System.storage_Elements; + use type openGL.Program.lit.view; + + Self : constant View := new Geometry.lit_textured_x2.item; + + begin + Tasks.check; + + if the_Program = null + then -- Define the shaders and program. + declare + use Palette, + Attribute.Forge; + + Sample : Vertex; + + Attribute_1 : Attribute.view; + Attribute_2 : Attribute.view; + Attribute_3 : Attribute.view; + -- Attribute_4 : Attribute.view; + Attribute_5 : Attribute.view; + + white_Image : constant Image := [1 .. 2 => [1 .. 2 => +White]]; + + begin + white_Texture := openGL.Texture.Forge.to_Texture (white_Image); + + vertex_Shader .define (Shader.Vertex, "assets/opengl/shader/lit_textured_x2.vert"); + fragment_Shader.define (Shader.Fragment, "assets/opengl/shader/lit_textured_x2.frag"); + + the_Program := new openGL.Program.lit.item; + the_Program.define ( vertex_Shader'Access, + fragment_Shader'Access); + the_Program.enable; + + Attribute_1 := new_Attribute (Name => Name_1, + gl_Location => the_Program.attribute_Location (Name_1), + Size => 3, + data_Kind => attribute.GL_FLOAT, + Stride => lit_textured_x2.Vertex'Size / 8, + Offset => 0, + Normalized => False); + + Attribute_2 := new_Attribute (Name => Name_2, + gl_Location => the_Program.attribute_Location (Name_2), + Size => 3, + data_Kind => attribute.GL_FLOAT, + Stride => lit_textured_x2.Vertex'Size / 8, + Offset => Sample.Normal (1)'Address + - Sample.Site (1)'Address, + Normalized => False); + + Attribute_3 := new_Attribute (Name => Name_3, + gl_Location => the_Program.attribute_Location (Name_3), + Size => 2, + data_Kind => attribute.GL_FLOAT, + Stride => lit_textured_x2.Vertex'Size / 8, + Offset => Sample.Coords.S'Address + - Sample.Site (1)'Address, + Normalized => False); + + -- Attribute_4 := new_Attribute (Name => Name_4, + -- gl_Location => the_Program.attribute_Location (Name_4), + -- Size => 2, + -- data_Kind => attribute.GL_FLOAT, + -- Stride => lit_textured_x2.Vertex'Size / 8, + -- Offset => Sample.Coords_2.S'Address + -- - Sample.Site (1)'Address, + -- Normalized => False); + + Attribute_5 := new_Attribute (Name => Name_5, + gl_Location => the_Program.attribute_Location (Name_5), + Size => 1, + data_Kind => attribute.GL_FLOAT, + Stride => lit_textured_x2.Vertex'Size / 8, + Offset => Sample.Shine 'Address + - Sample.Site (1)'Address, + Normalized => False); + + the_Program.add (Attribute_1); + the_Program.add (Attribute_2); + the_Program.add (Attribute_3); + -- the_Program.add (Attribute_4); + the_Program.add (Attribute_5); + + 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; + + glBindAttribLocation (program => the_Program.gl_Program, + index => the_Program.Attribute (named => Name_3).gl_Location, + name => +Attribute_3_Name_ptr); + Errors.log; + + -- glBindAttribLocation (program => the_Program.gl_Program, + -- index => the_Program.Attribute (named => Name_4).gl_Location, + -- name => +Attribute_4_Name_ptr); + -- Errors.log; + + glBindAttribLocation (program => the_Program.gl_Program, + index => the_Program.Attribute (named => Name_5).gl_Location, + name => +Attribute_5_Name_ptr); + Errors.log; + end; + end if; + + Self.Program_is (the_Program.all'Access); + return Self; + end new_Geometry; + + + ---------- + -- Vertex + -- + + function is_Transparent (Self : in Vertex_array) return Boolean -- TODO: Do these properly. + is + pragma Unreferenced (Self); + begin + return False; + end is_Transparent; + + + + function is_Transparent (Self : in Vertex_large_array) return Boolean + is + pragma Unreferenced (Self); + begin + return False; + end is_Transparent; + + + -------------- + -- Attributes + -- + + package openGL_Buffer_of_geometry_Vertices is new Buffer.general (base_Object => Buffer.array_Object, + Index => Index_t, + Element => Vertex, + Element_Array => Vertex_array); + + package openGL_large_Buffer_of_geometry_Vertices is new Buffer.general (base_Object => Buffer.array_Object, + Index => long_Index_t, + Element => Vertex, + Element_Array => Vertex_large_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)); + Self.is_Transparent := is_Transparent (Now); + + -- Set the bounds. + -- + declare + function get_Site (Index : in Index_t) return Vector_3 + is (Now (Index).Site); + + function bounding_Box is new get_Bounds (Index_t, get_Site); + begin + Self.Bounds_are (bounding_Box (Count => Now'Length)); + end; + end Vertices_are; + + + + procedure Vertices_are (Self : in out Item; Now : in Vertex_large_array) + is + use openGL_large_Buffer_of_geometry_Vertices.Forge; + begin + Self.Vertices := new openGL_large_Buffer_of_geometry_Vertices.Object' (to_Buffer (Now, + usage => Buffer.static_Draw)); + Self.is_Transparent := is_Transparent (Now); + + -- Set the bounds. + -- + declare + function get_Site (Index : in long_Index_t) return Vector_3 + is (Now (Index).Site); + + function bounding_Box is new get_Bounds (long_Index_t, get_Site); + begin + Self.Bounds_are (bounding_Box (Count => Now'Length)); + end; + end Vertices_are; + + + + overriding + procedure Indices_are (Self : in out Item; Now : in Indices; + for_Facia : in Positive) + is + begin + raise Error with "TODO"; + end Indices_are; + + + + procedure Fade_is (Self : in out Item; Which : texture_ID; Now : in fade_Level) + is + begin + Self.Textures.Textures (Which).Fade := Now; + end Fade_is; + + + function Fade (Self : in Item; Which : texture_ID) return fade_Level + is + begin + return Self.Textures.Textures (Which).Fade; + end Fade; + + + + + + procedure Texture_is (Self : in out Item; Which : texture_ID; Now : in openGL.Texture.Object) + is + begin + Texture_is (in_Set => Self.Textures, + Which => Which, + Now => Now); + end Texture_is; + + + + function Texture (Self : in Item; Which : texture_ID) return openGL.Texture.Object + is + begin + return Texture (in_Set => Self.Textures, + Which => Which); + end Texture; + + + + overriding + procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object) + is + begin + Texture_is (in_Set => Self.Textures, + Now => Now); + end Texture_is; + + overriding + function Texture (Self : in Item) return openGL.Texture.Object + is + begin + return Texture (in_Set => Self.Textures, + Which => 1); + end Texture; + + + + overriding + procedure enable_Texture (Self : in Item) + is + -- check_is_OK : constant Boolean := openGL.Tasks.Check + -- with unreferenced; + + begin + enable (Self.Textures, Self.Program); + + -- Tasks.check; + + -- for i in 1 .. Self.Textures.Count + -- loop + -- declare + -- use ada.Strings, + -- ada.Strings.fixed; + -- + -- use type GL.GLint; + -- + -- -- "bone_Matrices[" & Trim (Integer'Image (i - 1), Left) & "]"); + -- + -- type texture_Units is array (texture_Id) of GLenum; + -- all_texture_Units : constant texture_Units := (GL_TEXTURE0, + -- GL_TEXTURE1, + -- GL_TEXTURE2, + -- GL_TEXTURE3, + -- GL_TEXTURE4, + -- GL_TEXTURE5, + -- GL_TEXTURE6, + -- GL_TEXTURE7, + -- GL_TEXTURE8, + -- GL_TEXTURE9, + -- GL_TEXTURE10, + -- GL_TEXTURE11, + -- GL_TEXTURE12, + -- GL_TEXTURE13, + -- GL_TEXTURE14, + -- GL_TEXTURE15, + -- GL_TEXTURE16, + -- GL_TEXTURE17, + -- GL_TEXTURE18, + -- GL_TEXTURE19, + -- GL_TEXTURE20, + -- GL_TEXTURE21, + -- GL_TEXTURE22, + -- GL_TEXTURE23, + -- GL_TEXTURE24, + -- GL_TEXTURE25, + -- GL_TEXTURE26, + -- GL_TEXTURE27, + -- GL_TEXTURE28, + -- GL_TEXTURE29, + -- GL_TEXTURE30, + -- GL_TEXTURE31); + -- + -- uniform_Name : aliased C.char_array := C.to_C ("Textures[" & Trim (Integer'Image (i - 1), Left) & "]"); + -- uniform_Name_ptr : aliased constant C.strings.chars_ptr := C.strings.to_chars_ptr (uniform_Name'unchecked_Access); + -- loc : constant GL.GLint := glGetUniformLocation (Self.Program.gl_Program, +uniform_Name_ptr); + -- begin + -- -- put_Line ("1-openGL.Program.lit.set_Uniforms:" & loc'Image); + -- + -- glUniform1i (loc, + -- GLint (i) - 1); + -- + -- glActiveTexture (all_texture_Units (texture_Id (i))); + -- glBindTexture (GL_TEXTURE_2D, + -- Self.Textures.Textures (texture_Id (i)).Object.Name); + -- end; + -- + -- + -- declare + -- the_texture_count_Uniform : constant openGL.Variable.uniform.int := Self.Program.uniform_Variable ("texture_Count"); + -- begin + -- the_texture_count_Uniform.Value_is (Self.Textures.Count); + -- end; + -- end loop; + + end enable_Texture; + + +end openGL.Geometry.lit_textured_x2; diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured_x2.ads b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured_x2.ads new file mode 100644 index 0000000..c15adc0 --- /dev/null +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured_x2.ads @@ -0,0 +1,66 @@ +package openGL.Geometry.lit_textured_x2 +-- +-- Supports per-vertex site texture and lighting. +-- +is + type Item is new openGL.Geometry.item with private; + type View is access all Item'Class; + + + function new_Geometry return View; + + + ---------- + -- Vertex + -- + + type Vertex is + record + Site : Vector_3; + Normal : Vector_3; + Coords : Coordinate_2D; + Shine : Real; + end record; + + type Vertex_array is array ( Index_t range <>) of aliased Vertex; + type Vertex_large_array is array (long_Index_t range <>) of aliased Vertex; + + + -------------- + -- Attributes + -- + + procedure Vertices_are (Self : in out Item; Now : in Vertex_array); + procedure Vertices_are (Self : in out Item; Now : in Vertex_large_array); + + overriding + procedure Indices_are (Self : in out Item; Now : in Indices; + for_Facia : in Positive); + + procedure Fade_is (Self : in out Item; Which : texture_ID; Now : in fade_Level); + function Fade (Self : in Item; Which : texture_ID) return fade_Level; + + + procedure Texture_is (Self : in out Item; Which : texture_ID; Now : in openGL.Texture.Object); + function Texture (Self : in Item; Which : texture_ID) return openGL.Texture.Object; + + overriding + procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object); + + overriding + function Texture (Self : in Item) return openGL.Texture.Object; + + + +private + + type Item is new Geometry.item with + record + Textures : texture_Set; + end record; + + + overriding + procedure enable_Texture (Self : in Item); + +end openGL.Geometry.lit_textured_x2; diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry.adb b/3-mid/opengl/source/lean/geometry/opengl-geometry.adb index c2c3203..723fb76 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry.adb +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry.adb @@ -1,9 +1,19 @@ with openGL.Primitive.indexed, openGL.Primitive.long_indexed, + openGL.Variable.uniform, + openGL.Tasks, + GL.Binding, + GL.lean, + GL.Pointers, + + ada.Strings.fixed, ada.unchecked_Deallocation, - ada.unchecked_Conversion; + ada.unchecked_Conversion, + + interfaces.C.Strings; + package body openGL.Geometry is @@ -93,22 +103,103 @@ is - function Texture (Self : in Item'Class) return openGL.Texture.Object + + + + + + -- procedure Texture_is (Self : in out Item'Class; Which : texture_ID; Now : in openGL.Texture.Object) + -- is + -- begin + -- Self.Textures.Textures (Which) := (0.0, Now); + -- Self.is_Transparent := Self.is_Transparent + -- or Now .is_Transparent; + -- + -- if Natural (Which) > Self.Textures.Count + -- then + -- Self.Textures.Count := Natural (Which); + -- end if; + -- end Texture_is; + -- + -- + -- function Texture (Self : in Item'Class; Which : texture_ID) return openGL.Texture.Object + -- is + -- begin + -- return Self.Textures.Textures (Which).Object; + -- end Texture; + + + + + function Texture (Self : in Item) return openGL.Texture.Object is begin - return Self.Texture; + raise program_Error with "Geometry has no texture."; + return openGL.Texture.null_Object; end Texture; - procedure Texture_is (Self : in out Item'Class; Now : in openGL.Texture.Object) + -- procedure Texture_is (Self : in out Item'Class; Now : in openGL.Texture.Object) + -- is + -- begin + -- Self.Textures.Textures (1).Object := Now; + -- Self.is_Transparent := Self.is_Transparent + -- or Now .is_Transparent; + -- + -- if Self.Textures.Count = 0 + -- then + -- Self.Textures.Count := 1; + -- end if; + -- end Texture_is; + -- + + + procedure Texture_is (in_Set : in out texture_Set; Which : texture_ID; Now : in openGL.Texture.Object) is begin - Self.Texture := Now; - Self.is_Transparent := Self.is_Transparent - or Now .is_Transparent; + in_Set.Textures (Which) := (0.0, Now); + in_Set.is_Transparent := in_Set.is_Transparent + or Now .is_Transparent; + + if Natural (Which) > in_Set.Count + then + in_Set.Count := Natural (Which); + end if; end Texture_is; + function Texture (in_Set : in texture_Set; Which : texture_ID) return openGL.Texture.Object + is + begin + return in_Set.Textures (Which).Object; + end Texture; + + + + + function Texture (in_Set : in texture_Set) return openGL.Texture.Object + is + begin + return in_Set.Textures (1).Object; + end Texture; + + + procedure Texture_is (in_Set : in out texture_Set; Now : in openGL.Texture.Object) + is + begin + in_Set.Textures (1).Object := Now; + in_Set.is_Transparent := in_Set.is_Transparent + or Now .is_Transparent; + + if in_Set.Count = 0 + then + in_Set.Count := 1; + end if; + end Texture_is; + + + + procedure Program_is (Self : in out Item; Now : in openGL.Program.view) is @@ -143,8 +234,12 @@ is function is_Transparent (Self : in Item) return Boolean is begin - return Self.is_Transparent - or Self.Texture.is_Transparent; + return Self.is_Transparent; + -- or Self.Textures.Textures (1).Object.is_Transparent + -- or Self.Textures.Textures (2).Object.is_Transparent; -- TODO: Loop over all textures. + -- -- return Self.is_Transparent + -- -- or Self.Texture_1.is_Transparent + -- -- or Self.Texture_2.is_Transparent; end is_Transparent; @@ -465,6 +560,110 @@ is end Normals_of; + + + ----------- + -- Textures + -- + + procedure enable (the_Textures : in texture_Set; + Program : in openGL.Program.view) + is + use GL, + GL.Binding, + openGL.Texture; + + -- check_is_OK : constant Boolean := openGL.Tasks.Check + -- with unreferenced; + + begin + Tasks.check; + + for i in 1 .. the_Textures.Count + loop + declare + use GL.lean, + GL.Pointers, + ada.Strings, + ada.Strings.fixed, + Interfaces; + + use type GL.GLint; + + type texture_Units is array (texture_Id) of GLenum; + + all_texture_Units : constant texture_Units := (GL_TEXTURE0, + GL_TEXTURE1, + GL_TEXTURE2, + GL_TEXTURE3, + GL_TEXTURE4, + GL_TEXTURE5, + GL_TEXTURE6, + GL_TEXTURE7, + GL_TEXTURE8, + GL_TEXTURE9, + GL_TEXTURE10, + GL_TEXTURE11, + GL_TEXTURE12, + GL_TEXTURE13, + GL_TEXTURE14, + GL_TEXTURE15, + GL_TEXTURE16, + GL_TEXTURE17, + GL_TEXTURE18, + GL_TEXTURE19, + GL_TEXTURE20, + GL_TEXTURE21, + GL_TEXTURE22, + GL_TEXTURE23, + GL_TEXTURE24, + GL_TEXTURE25, + GL_TEXTURE26, + GL_TEXTURE27, + GL_TEXTURE28, + GL_TEXTURE29, + GL_TEXTURE30, + GL_TEXTURE31); + + uniform_Name : aliased C.char_array := C.to_C ("Textures[" & Trim (Natural'Image (i - 1), Left) & "]"); + uniform_Name_ptr : aliased constant C.strings.chars_ptr := C.strings.to_chars_ptr (uniform_Name'unchecked_Access); + loc : constant GL.GLint := glGetUniformLocation (Program.gl_Program, +uniform_Name_ptr); + Id : constant texture_Id := texture_Id (i); + begin + -- put_Line ("1-openGL.Program.lit.set_Uniforms:" & loc'Image); + + glUniform1i (loc, + GLint (i) - 1); + + glActiveTexture (all_texture_Units (Id)); + glBindTexture (GL_TEXTURE_2D, + the_Textures.Textures (Id).Object.Name); + end; + + + declare + use ada.Strings, + ada.Strings.fixed; + + uniform_Name : constant String := "Fade[" & Trim (Natural'Image (i - 1), Left) & "]"; + Uniform : constant openGL.Variable.uniform.float := Program.uniform_Variable (uniform_Name); + begin + Uniform.Value_is (Real (the_Textures.Textures (texture_Id (i)).Fade)); + end; + end loop; + + + declare + the_texture_count_Uniform : constant openGL.Variable.uniform.int := Program.uniform_Variable ("texture_Count"); + begin + the_texture_count_Uniform.Value_is (the_Textures.Count); + end; + end enable; + + + + + --------- -- Bounds -- diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry.ads b/3-mid/opengl/source/lean/geometry/opengl-geometry.ads index eb79669..fb8b1a1 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry.ads +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry.ads @@ -39,8 +39,53 @@ is procedure Label_is (Self : in out Item'Class; Now : in String); function Label (Self : in Item'Class) return String; - procedure Texture_is (Self : in out Item'Class; Now : in Texture.Object); - function Texture (Self : in Item'Class) return Texture.Object; + + + max_Textures : constant := 32; + + type texture_Id is range 1 .. max_Textures; + + + -- procedure Texture_is (Self : in out Item'Class; Which : texture_ID; Now : in Texture.Object); + -- function Texture (Self : in Item'Class; Which : texture_ID) return Texture.Object; + -- + procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object) is null; + function Texture (Self : in Item) return openGL.Texture.Object; + + + + + -- ************************************************************************* + -- TODO: Move all texture code to a new 'openGL.Geometry.texturing' package. + + type fade_Level is delta 0.001 range 0.0 .. 1.0; -- '0.0' is no fading, '1.0' is fully faded (ie invisible). + + type fadeable_Texture is + record + Fade : fade_Level := 0.0; + Object : openGL.Texture.Object := openGL.Texture.null_Object; + end record; + + type fadeable_Textures is array (texture_Id range 1 .. max_Textures) of fadeable_Texture; + + type texture_Set is + record + Textures : fadeable_Textures; + Count : Natural := 0; + is_Transparent : Boolean := False; -- Any of the textures contains lucid colors. + end record; + + procedure enable (the_Textures : in texture_Set; + Program : in openGL.Program.view); + + procedure Texture_is (in_Set : in out texture_Set; Which : texture_ID; Now : in openGL.Texture.Object); + function Texture (in_Set : in texture_Set; Which : texture_ID) return openGL.Texture.Object; + + procedure Texture_is (in_Set : in out texture_Set; Now : in openGL.Texture.Object); + function Texture (in_Set : in texture_Set) return openGL.Texture.Object; + + + procedure Bounds_are (Self : in out Item'Class; Now : in Bounds); function Bounds (self : in Item'Class) return Bounds; -- Returns the bounds in object space. @@ -84,11 +129,14 @@ is private use ada.Strings.unbounded; + type Textures is array (texture_Id) of openGL.Texture.Object; + + + + type Item is abstract tagged limited record Label : unbounded_String; - Texture : openGL.Texture.Object := openGL.Texture.null_Object; - Program : openGL.Program.view; Vertices : Buffer.view; @@ -100,6 +148,7 @@ private end record; + generic type any_Index_t is range <>; with function get_Site (Index : in any_Index_t) return Vector_3; diff --git a/3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured_x2.adb b/3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured_x2.adb new file mode 100644 index 0000000..1f729ab --- /dev/null +++ b/3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured_x2.adb @@ -0,0 +1,123 @@ +with + openGL.Geometry.lit_textured_x2, + openGL.Primitive.indexed; + + +package body openGL.Model.hexagon.lit_textured_x2 +is + --------- + --- Forge + -- + + function new_Hexagon (Radius : in Real; + Face : in lit_textured_x2.Face) return View + is + Self : constant View := new Item; + begin + Self.Radius := Radius; + Self.Face := Face; + + return Self; + end new_Hexagon; + + + + + -------------- + --- Attributes + -- + + procedure Texture_1_is (Self : in out Item; Now : in openGL.asset_Name) + is + begin + Self.Face.Texture_1 := Now; + end Texture_1_is; + + + procedure Texture_2_is (Self : in out Item; Now : in openGL.asset_Name) + is + begin + Self.Face.Texture_2 := Now; + end Texture_2_is; + + + + + + overriding + function to_GL_Geometries (Self : access Item; Textures : access Texture.name_Map_of_texture'Class; + Fonts : in Font.font_id_Map_of_font) return Geometry.views + is + pragma unreferenced (Fonts); + + use Geometry.lit_textured_x2, + Texture; + + the_Sites : constant hexagon.Sites := vertex_Sites (Self.Radius); + the_Indices : aliased constant Indices := (1, 2, 3, 4, 5, 6, 7, 2); + + + function new_Face (Vertices : in geometry.lit_textured_x2.Vertex_array) return Geometry.lit_textured_x2.view + is + use Primitive; + + the_Geometry : constant Geometry.lit_textured_x2.view + := Geometry.lit_textured_x2.new_Geometry; + + the_Primitive : constant Primitive.indexed.view + := Primitive.indexed.new_Primitive (triangle_Fan, the_Indices); + begin + the_Geometry.Vertices_are (Vertices); + the_Geometry.add (Primitive.view (the_Primitive)); + + + if Self.Face.Texture_1 /= null_Asset + then + the_Geometry.Texture_is (Textures.fetch (Self.Face.Texture_1)); + the_Geometry.is_Transparent (now => the_Geometry.Texture.is_Transparent); + the_Geometry.Fade_is (which => 1, + now => Self.Face.Fade_1); + else + raise Program_Error; + end if; + + if Self.Face.Texture_2 /= null_Asset + then + the_Geometry.Texture_is (which => 2, + Now => Textures.fetch (Self.Face.Texture_2)); + + -- the_Geometry.Texture_2_is (Which => 2, Now => Textures.fetch (Self.Face.Texture_2)); + -- the_Geometry.is_Transparent (now => the_Geometry.Texture_2.is_Transparent); + the_Geometry.Fade_is (which => 2, + now => Self.Face.Fade_2); + end if; + + + return the_Geometry; + end new_Face; + + + upper_Face : Geometry.lit_textured_x2.view; + + begin + -- Upper Face + -- + declare + the_Vertices : constant Geometry.lit_textured_x2.Vertex_array + := (1 => (Site => (0.0, 0.0, 0.0), Normal => Normal, Coords => (0.50, 0.50), Shine => default_Shine), -- Center. + + 2 => (Site => the_Sites (1), Normal => Normal, Coords => (1.00, 0.50), Shine => default_Shine), -- Mid right. + 3 => (Site => the_Sites (2), Normal => Normal, Coords => (0.75, 1.00), Shine => default_Shine), -- Bottom right. + 4 => (Site => the_Sites (3), Normal => Normal, Coords => (0.25, 1.00), Shine => default_Shine), -- Bottom left. + 5 => (Site => the_Sites (4), Normal => Normal, Coords => (0.00, 0.50), Shine => default_Shine), -- Mid left. + 6 => (Site => the_Sites (5), Normal => Normal, Coords => (0.25, 0.00), Shine => default_Shine), -- Top left. + 7 => (Site => the_Sites (6), Normal => Normal, Coords => (0.75, 0.00), Shine => default_Shine)); -- Top right. + begin + upper_Face := new_Face (Vertices => the_Vertices); + end; + + return (1 => upper_Face.all'Access); + end to_GL_Geometries; + + +end openGL.Model.hexagon.lit_textured_x2; diff --git a/3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured_x2.ads b/3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured_x2.ads new file mode 100644 index 0000000..2ad2f3e --- /dev/null +++ b/3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured_x2.ads @@ -0,0 +1,51 @@ +with + openGL.Geometry, + openGL.Texture; + + +package openGL.Model.hexagon.lit_textured_x2 +-- +-- Models a lit, colored and textured hexagon. +-- +is + type Item is new Model.item with private; + type View is access all Item'Class; + + type Face is + record + Texture_1 : openGL.asset_Name := null_Asset; -- The texture to be applied to the hex. + Texture_2 : openGL.asset_Name := null_Asset; -- The texture to be applied to the hex. + Fade_1 : openGL.Geometry.fade_Level := 0.5; + Fade_2 : openGL.Geometry.fade_Level := 0.5; + end record; + + + --------- + --- Forge + -- + + function new_Hexagon (Radius : in Real; + Face : in lit_textured_x2.Face) return View; + + + -------------- + --- Attributes + -- + + procedure Texture_1_is (Self : in out Item; Now : in openGL.asset_Name); + procedure Texture_2_is (Self : in out Item; Now : in openGL.asset_Name); + + + overriding + function to_GL_Geometries (Self : access Item; Textures : access Texture.name_Map_of_texture'Class; + Fonts : in Font.font_id_Map_of_font) return Geometry.views; + + +private + + type Item is new Model.hexagon.item with + record + Face : lit_textured_x2.Face; + end record; + +end openGL.Model.hexagon.lit_textured_x2; diff --git a/3-mid/opengl/source/lean/shader/opengl-program-lit.adb b/3-mid/opengl/source/lean/shader/opengl-program-lit.adb index fb91bc2..701b407 100644 --- a/3-mid/opengl/source/lean/shader/opengl-program-lit.adb +++ b/3-mid/opengl/source/lean/shader/opengl-program-lit.adb @@ -1,6 +1,12 @@ with openGL.Conversions, - ada.Strings.fixed; + GL.lean, + GL.Binding, + GL.Pointers, + ada.Strings.fixed, + Interfaces.C.Strings; + +with ada.text_io; use ada.text_io; package body openGL.Program.lit @@ -93,6 +99,45 @@ is cone_direction_Uniform .Value_is ( Light.cone_Direction); end; end loop; + + + -- declare + -- use GL, + -- GL.lean, + -- GL.Binding, + -- GL.Pointers, + -- Interfaces; + -- + -- uniform_Name : aliased C.char_array := C.to_C ("Texture_1[0]"); + -- uniform_Name_ptr : aliased constant C.strings.chars_ptr := C.strings.to_chars_ptr (uniform_Name'unchecked_Access); + -- loc : GL.GLint := glGetUniformLocation (Self.gl_Program, +uniform_Name_ptr); + -- begin + -- put_Line ("1-openGL.Program.lit.set_Uniforms:" & loc'Image); + -- + -- glUniform1i (loc, 0); + -- glActiveTexture (GL_TEXTURE0); + -- glBindTexture (GL_TEXTURE_2D, 4); + -- end; + -- + -- + -- declare + -- use GL, + -- GL.lean, + -- GL.Binding, + -- GL.Pointers, + -- Interfaces; + -- + -- uniform_Name : aliased C.char_array := C.to_C ("Texture_1[1]"); + -- uniform_Name_ptr : aliased constant C.strings.chars_ptr := C.strings.to_chars_ptr (uniform_Name'unchecked_Access); + -- loc : GL.GLint := glGetUniformLocation (Self.gl_Program, +uniform_Name_ptr); + -- begin + -- put_Line ("2-openGL.Program.lit.set_Uniforms:" & loc'Image); + -- + -- glUniform1i (loc, 1); + -- glActiveTexture (GL_TEXTURE1); + -- glBindTexture (GL_TEXTURE_2D, 5); + -- end; + end set_Uniforms;