nichkara/lace
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

opengl: Work on multi-texturing.

Browse Source
This commit is contained in:
Rod Kay
2023-05-09 18:04:18 +10:00
parent d3e4119172
commit 1beb8e1140
12 changed files with 212 additions and 26 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
3-mid/opengl/applet/demo/culler/many_boxes_textured_x1/launch_many_boxes_textured_x1_demo.adb
View File

@@ -76,6 +76,9 @@ begin
Demo.Renderer.set (the_Light);
end;
-- openGL.Demo.Camera.allow_Impostors;
-- Main loop.
--
while not Demo.Done

41
3-mid/opengl/applet/demo/textures/render_two_textures/launch_render_two_textures.adb
View File

@@ -3,9 +3,12 @@ with
openGL.Visual,
openGL.Light,
openGL.Palette,
openGL.Geometry.texturing,
-- openGL.IO,
openGL.Demo;
with Ada.Text_IO; use Ada.Text_IO;
procedure launch_render_two_Textures
--
@@ -22,8 +25,9 @@ is
--------------
-- 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_1st_Texture : constant asset_Name := to_Asset ("assets/opengl/texture/blobber_floor.png");
the_1st_Texture : constant asset_Name := to_Asset ("assets/crawl-blob-1.png");
the_2nd_Texture : constant asset_Name := to_Asset ("assets/crawl-blob-2.png");
the_textured_hexagon_Model : constant Model.hexagon.lit_textured_x2.view
:= Model.hexagon.lit_textured_x2.new_Hexagon (Radius => 0.5,
@@ -45,6 +49,11 @@ is
light_Site : constant openGL.Vector_3 := [0.0, 0.0, 15.0];
cone_Direction : constant openGL.Vector_3 := [0.0, 0.0, -1.0];
use openGL.Geometry.texturing;
Fade : fade_Level := fade_Level'First;
increment_Fade : Boolean := True;
Epoch : Natural := 0;
begin
Demo.print_Usage;
Demo.define ("openGL 'render two Textures' Demo",
@@ -82,6 +91,34 @@ begin
Demo.Renderer.render;
Demo.FPS_Counter.increment; -- Frames per second display.
if Epoch mod 20 = 0
then
the_textured_hexagon_Model.Fade_1_is (Fade);
the_textured_hexagon_Model.Fade_2_is (1.0 - Fade);
-- the_textured_hexagon_Model.needs_Rebuild;
--
-- the_textured_hexagon_Model.Fade_1_is (1.0);
-- the_textured_hexagon_Model.Fade_2_is (0.0);
-- put_Line ("my Fade: " & Fade'Image);
if increment_Fade
then
Fade := Fade + fade_Level'Small;
else
Fade := Fade - fade_Level'Small;
end if;
if Fade = fade_Level'Last then increment_Fade := False;
elsif Fade = fade_Level'First then increment_Fade := True;
end if;
end if;
Epoch := Epoch + 1;
end loop;
Demo.destroy;
end launch_render_two_Textures;

10
3-mid/opengl/assets/shader/texturing.frag
View File

@@ -13,8 +13,14 @@ apply_Texturing (vec2 Coords)
* texture (Textures [i], Coords).a
* (1.0 - Fade [i]);
Color.a = max (Color.a, texture (Textures [i],
Coords).a);
// Color.a += texture (Textures [i], Coords).a * (1.0 - Fade[1]);
Color.a = max (Color.a,
texture (Textures [i],Coords).a * (1.0 - Fade[i]));
// Color.a = max (Color.a,
// texture (Textures [i],Coords).a);
}
return Color;

5
3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured_x2.adb
View File

@@ -5,6 +5,7 @@ with
openGL.Attribute,
openGL.Texture,
openGL.Palette,
openGL.Model,
openGL.Tasks,
openGL.Errors,
@@ -312,6 +313,10 @@ is
is
use openGL.Geometry.texturing;
begin
Self.Textures.Textures (1).Fade := Self.Model.Fade_1;
Self.Textures.Textures (2).Fade := Self.Model.Fade_2;
enable (Self.Textures, Self.Program);
end enable_Texture;

4
3-mid/opengl/source/lean/geometry/opengl-geometry-texturing.adb
View File

@@ -6,6 +6,8 @@ with
ada.Strings.fixed;
with ada.Text_IO; use ada.Text_IO;
package body openGL.Geometry.texturing
is
@@ -156,6 +158,8 @@ is
uniform_Name : constant String := "Fade[" & Trim (Natural'Image (i - 1), Left) & "]";
Uniform : constant openGL.Variable.uniform.float := Program.uniform_Variable (uniform_Name);
begin
-- put_Line ("Fade:" & the_Textures.Textures (texture_Id (i)).Fade'Image);
Uniform.Value_is (Real (the_Textures.Textures (texture_Id (i)).Fade));
end;
end loop;

9
3-mid/opengl/source/lean/geometry/opengl-geometry.adb
View File

@@ -50,6 +50,15 @@ is
-- Attributes
--
procedure Model_is (Self : in out Item; Now : in Model_view)
is
begin
Self.Model := Now;
end Model_is;
function Label (Self : in Item'Class) return String
is
begin

12
3-mid/opengl/source/lean/geometry/opengl-geometry.ads
View File

@@ -4,6 +4,9 @@ with
openGL.Program,
openGL.Texture;
limited
with
openGL.Model;
private
with
@@ -38,6 +41,11 @@ is
-- Attributes
--
type Model_view is access all openGL.Model.item'Class;
procedure Model_is (Self : in out Item; Now : in Model_view);
procedure Label_is (Self : in out Item'Class; Now : in String);
function Label (Self : in Item'Class) return String;
@@ -90,16 +98,16 @@ is
Sites : in openGL.Sites) return access Normals;
private
use ada.Strings.unbounded;
type Textures is array (texture_Id) of openGL.Texture.Object;
type Item is abstract tagged limited
record
Model : Model_view;
Label : unbounded_String;
Program : openGL.Program.view;
Vertices : Buffer.view;

75
3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured_x2.adb
View File

@@ -27,23 +27,6 @@ is
--- 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
@@ -116,8 +99,66 @@ is
upper_Face := new_Face (Vertices => the_Vertices);
end;
upper_Face.Model_is (Self.all'unchecked_Access);
return (1 => upper_Face.all'Access);
end to_GL_Geometries;
------------
-- Texturing
--
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
procedure Fade_1_is (Self : in out Item; Now : in openGL.Geometry.texturing.fade_Level)
is
begin
Self.Face.Fade_1 := Now;
end Fade_1_is;
overriding
procedure Fade_2_is (Self : in out Item; Now : in openGL.Geometry.texturing.fade_Level)
is
begin
Self.Face.Fade_2 := Now;
end Fade_2_is;
overriding
function Fade_1 (Self : in Item) return Geometry.Texturing.fade_Level
is
begin
return Self.Face.Fade_1;
end Fade_1;
overriding
function Fade_2 (Self : in Item) return Geometry.Texturing.fade_Level
is
begin
return Self.Face.Fade_2;
end Fade_2;
end openGL.Model.hexagon.lit_textured_x2;

23
3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured_x2.ads
View File

@@ -32,13 +32,32 @@ is
--- Attributes
--
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;
------------
-- Texturing
--
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;
procedure Fade_1_is (Self : in out Item; Now : in openGL.Geometry.texturing.fade_Level);
overriding
procedure Fade_2_is (Self : in out Item; Now : in openGL.Geometry.texturing.fade_Level);
overriding
function Fade_1 (Self : in Item) return Geometry.Texturing.fade_Level;
overriding
function Fade_2 (Self : in Item) return Geometry.Texturing.fade_Level;
private

40
3-mid/opengl/source/lean/model/opengl-model.adb
View File

@@ -211,4 +211,44 @@ is
Self.needs_Rebuild := True;
end needs_Rebuild;
------------
-- Texturing
--
procedure Fade_1_is (Self : in out Item; Now : in Geometry.Texturing.fade_Level)
is
begin
raise program_Error with "Model does not support texturing.";
end Fade_1_is;
procedure Fade_2_is (Self : in out Item; Now : in Geometry.Texturing.fade_Level)
is
begin
raise program_Error with "Model does not support texturing.";
end Fade_2_is;
function Fade_1 (Self : in Item) return Geometry.Texturing.fade_Level
is
begin
raise program_Error with "Model does not support texturing.";
return 0.0;
end Fade_1;
function Fade_2 (Self : in Item) return Geometry.Texturing.fade_Level
is
begin
raise program_Error with "Model does not support texturing.";
return 0.0;
end Fade_2;
end openGL.Model;

15
3-mid/opengl/source/lean/model/opengl-model.ads
View File

@@ -2,7 +2,7 @@ with
openGL.remote_Model,
openGL.Font,
openGL.Texture,
openGL.Geometry;
openGL.Geometry.texturing;
package openGL.Model
@@ -68,6 +68,19 @@ is
Fonts : in Font.font_id_Map_of_font);
------------
-- Texturing
--
procedure Fade_1_is (Self : in out Item; Now : in Geometry.Texturing.fade_Level);
procedure Fade_2_is (Self : in out Item; Now : in Geometry.Texturing.fade_Level);
function Fade_1 (Self : in Item) return Geometry.Texturing.fade_Level;
function Fade_2 (Self : in Item) return Geometry.Texturing.fade_Level;
private
type Item is abstract new remote_Model.item with

1
3-mid/opengl/source/lean/renderer/opengl-renderer-lean.adb
View File

@@ -549,6 +549,7 @@ is
and the_Visual.Model. lucid_Geometries = null)
then
the_Visual.Model.create_GL_Geometries (Self.Textures'Access, Self.Fonts);
-- put_Line ("Rebuild");
elsif the_Visual.Model.is_Modified
then