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

opengl.model: Add basic texturing subprograms.

Browse Source
This commit is contained in:
Rod Kay
2023-05-31 15:22:25 +10:00
parent ce41c9afef
commit 4861f54232
19 changed files with 547 additions and 32 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
3-mid/opengl/applet/demo/renderer/render_models/launch_render_models.adb
View File

@@ -80,6 +80,7 @@ begin
the_Visuals (3).Site_is ([0.0, 0.0, -50.0]);
-- Main loop.
--
while not Demo.Done

48
3-mid/opengl/source/demo/opengl-demo.adb
View File

@@ -118,6 +118,8 @@ is
end destroy;
function Models return openGL.Model.views
is
use Model,
@@ -260,37 +262,39 @@ is
the_segment_line_Model.add_Segment (end_Site => [2.0, 2.0, 0.0]);
the_segment_line_Model.add_Segment (end_Site => [0.0, 2.0, 0.0]);
return [ the_ground_Model.all'Access,
the_polygon_Model.all'Access,
the_text_Model.all'Access,
the_arrow_Model.all'Access,
the_ball_1_Model.all'Access,
the_ball_2_Model.all'Access,
the_ball_3_Model.all'Access,
return [ the_ground_Model.all'Access,
the_polygon_Model.all'Access,
the_text_Model.all'Access,
the_arrow_Model.all'Access,
the_ball_1_Model.all'Access,
the_ball_2_Model.all'Access,
the_ball_3_Model.all'Access,
the_billboard_Model.all'Access,
the_colored_billboard_Model.all'Access,
the_box_1_Model.all'Access,
the_box_2_Model.all'Access,
the_box_3_Model.all'Access,
the_billboard_Model.all'Access,
the_colored_billboard_Model.all'Access,
the_box_1_Model.all'Access,
the_box_2_Model.all'Access,
the_box_3_Model.all'Access,
the_capsule_Model.all'Access,
the_grid_Model.all'Access,
the_capsule_Model.all'Access,
the_grid_Model.all'Access,
the_hexagon_Model.all'Access,
the_textured_hexagon_Model.all'Access,
the_hexagon_Model.all'Access,
the_textured_hexagon_Model.all'Access,
the_faceted_hexagon_column_Model.all'Access,
the_rounded_hexagon_column_Model.all'Access,
the_faceted_hexagon_column_Model.all'Access,
the_rounded_hexagon_column_Model.all'Access,
the_line_Model.all'Access,
the_collada_Model.all'Access,
the_wavefront_Model.all'Access,
the_line_Model.all'Access,
the_collada_Model.all'Access,
the_wavefront_Model.all'Access,
the_segment_line_Model.all'Access];
the_segment_line_Model.all'Access];
end Models;
procedure layout (the_Visuals : in Visual.views)
is
initial_X : constant openGL.Real := -6.0;

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

@@ -139,6 +139,7 @@ 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
@@ -146,11 +147,14 @@ is
pragma unreferenced (Textures, Fonts);
begin
Self.build_GL_Geometries;
Self.Geometry.Model_is (Self.all'unchecked_Access);
return [1 => Self.Geometry];
end to_GL_Geometries;
procedure build_GL_Geometries (Self : in out Item)
is
use Geometry;
@@ -486,10 +490,52 @@ is
end if;
Self.Geometry.is_Transparent (now => False);
Self.Geometry.Label_is (to_String (Self.Model) & "-" & to_String (Self.Texture));
Self.Geometry.Label_is (to_String (Self.Model) & "-" & to_String (Self.Texture));
end;
end build_GL_Geometries;
------------
-- Texturing
--
overriding
procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_Id;
Now : in texture_Set.fade_Level)
is
begin
null;
end Fade_is;
overriding
function Fade (Self : in Item; Which : in texture_Set.texture_Id) return texture_Set.fade_Level
is
begin
return 0.0;
end Fade;
procedure Texture_is (Self : in out Item; Which : in texture_Set.texture_Id;
Now : in openGL.asset_Name)
is
begin
null;
end Texture_is;
overriding
function texture_Count (Self : in Item) return Natural
is
begin
return 1;
end texture_Count;
end openGL.Model.any;

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

@@ -39,6 +39,24 @@ is
unsupported_model_Format : exception;
------------
-- Texturing
--
overriding
function Fade (Self : in Item; Which : in texture_Set.texture_Id) return texture_Set.fade_Level;
overriding
procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_Id;
Now : in texture_Set.fade_Level);
procedure Texture_is (Self : in out Item; Which : in texture_Set.texture_Id;
Now : in asset_Name);
overriding
function texture_Count (Self : in Item) return Natural;
private

45
3-mid/opengl/source/lean/model/opengl-model-billboard-textured.adb
View File

@@ -110,6 +110,8 @@ is
end if;
end;
the_Face.Model_is (Self.all'unchecked_Access);
return [1 => the_Face.all'Access];
end to_GL_Geometries;
@@ -195,4 +197,47 @@ is
end Image_is;
------------
-- Texturing
--
overriding
procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_Id;
Now : in texture_Set.fade_Level)
is
begin
null;
end Fade_is;
overriding
function Fade (Self : in Item; Which : in texture_Set.texture_Id) return texture_Set.fade_Level
is
begin
return 0.0;
end Fade;
procedure Texture_is (Self : in out Item; Which : in texture_Set.texture_Id;
Now : in openGL.asset_Name)
is
begin
null;
end Texture_is;
overriding
function texture_Count (Self : in Item) return Natural
is
begin
return 1;
end texture_Count;
end openGL.Model.billboard.textured;

18
3-mid/opengl/source/lean/model/opengl-model-billboard-textured.ads
View File

@@ -46,6 +46,24 @@ is
procedure Image_is (Self : in out Item; Now : in lucid_Image);
------------
-- Texturing
--
overriding
function Fade (Self : in Item; Which : in texture_Set.texture_Id) return texture_Set.fade_Level;
overriding
procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_Id;
Now : in texture_Set.fade_Level);
procedure Texture_is (Self : in out Item; Which : in texture_Set.texture_Id;
Now : in asset_Name);
overriding
function texture_Count (Self : in Item) return Natural;
private

60
3-mid/opengl/source/lean/model/opengl-model-box-lit_textured.adb
View File

@@ -74,8 +74,9 @@ is
if Self.Faces (Front).texture_Name /= null_Asset
then
front_Face.Texture_is (Textures.fetch (Self.Faces (Front).texture_Name));
front_Face.Texture_is (Textures.fetch (Self.Faces (Front).texture_Name));
front_Face.is_Transparent (now => front_Face.Texture.is_Transparent);
front_Face.Model_is (Self.all'unchecked_Access);
end if;
end;
@@ -93,8 +94,9 @@ is
if Self.Faces (Rear).texture_Name /= null_Asset
then
rear_Face.Texture_is (Textures.fetch (Self.Faces (Rear).texture_Name));
rear_Face.Texture_is (Textures.fetch (Self.Faces (Rear).texture_Name));
rear_Face.is_Transparent (now => rear_Face.Texture.is_Transparent);
rear_Face.Model_is (Self.all'unchecked_Access);
end if;
end;
@@ -112,8 +114,9 @@ is
if Self.Faces (Upper).texture_Name /= null_Asset
then
upper_Face.Texture_is (Textures.fetch (Self.Faces (Upper).texture_Name));
upper_Face.Texture_is (Textures.fetch (Self.Faces (Upper).texture_Name));
upper_Face.is_Transparent (now => upper_Face.Texture.is_Transparent);
upper_Face.Model_is (Self.all'unchecked_Access);
end if;
end;
@@ -133,6 +136,7 @@ is
then
lower_Face.Texture_is (Textures.fetch (Self.Faces (Lower).texture_Name));
lower_Face.is_Transparent (now => lower_Face.Texture.is_Transparent);
lower_Face.Model_is (Self.all'unchecked_Access);
end if;
end;
@@ -150,8 +154,9 @@ is
if Self.Faces (Left).texture_Name /= null_Asset
then
left_Face.Texture_is (Textures.fetch (Self.Faces (Left).texture_Name));
left_Face.Texture_is (Textures.fetch (Self.Faces (Left).texture_Name));
left_Face.is_Transparent (now => left_Face.Texture.is_Transparent);
left_Face.Model_is (Self.all'unchecked_Access);
end if;
end;
@@ -169,8 +174,9 @@ is
if Self.Faces (Right).texture_Name /= null_Asset
then
right_Face.Texture_is (Textures.fetch (Self.Faces (Right).texture_Name));
right_Face.Texture_is (Textures.fetch (Self.Faces (Right).texture_Name));
right_Face.is_Transparent (now => right_Face.Texture.is_Transparent);
right_Face.Model_is (Self.all'unchecked_Access);
end if;
end;
@@ -184,4 +190,48 @@ is
end to_GL_Geometries;
------------
-- Texturing
--
overriding
procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_Id;
Now : in texture_Set.fade_Level)
is
begin
null;
end Fade_is;
overriding
function Fade (Self : in Item; Which : in texture_Set.texture_Id) return texture_Set.fade_Level
is
begin
return 0.0;
end Fade;
procedure Texture_is (Self : in out Item; Which : in texture_Set.texture_Id;
Now : in openGL.asset_Name)
is
begin
null;
end Texture_is;
overriding
function texture_Count (Self : in Item) return Natural
is
begin
return 1;
end texture_Count;
end openGL.Model.box.lit_textured;

19
3-mid/opengl/source/lean/model/opengl-model-box-lit_textured.ads
View File

@@ -39,6 +39,25 @@ is
Fonts : in Font.font_id_Map_of_font) return Geometry.views;
------------
-- Texturing
--
overriding
function Fade (Self : in Item; Which : in texture_Set.texture_Id) return texture_Set.fade_Level;
overriding
procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_Id;
Now : in texture_Set.fade_Level);
procedure Texture_is (Self : in out Item; Which : in texture_Set.texture_Id;
Now : in asset_Name);
overriding
function texture_Count (Self : in Item) return Natural;
private
type Item is new Model.box.item with

50
3-mid/opengl/source/lean/model/opengl-model-box-textured.adb
View File

@@ -81,8 +81,9 @@ is
if Self.Faces (Front).texture_Name /= null_Asset
then
front_Face.Texture_is (Textures.fetch (Self.Faces (Front).texture_Name));
front_Face.Texture_is (Textures.fetch (Self.Faces (Front).texture_Name));
front_Face.is_Transparent (now => front_Face.Texture.is_Transparent);
front_Face.Model_is (Self.all'unchecked_Access);
end if;
end;
@@ -102,6 +103,7 @@ is
then
rear_Face.Texture_is (Textures.fetch (Self.Faces (Front).texture_Name));
rear_Face.is_Transparent (now => rear_Face.Texture.is_Transparent);
rear_Face.Model_is (Self.all'unchecked_Access);
end if;
end;
@@ -121,6 +123,7 @@ is
then
upper_Face.Texture_is (Textures.fetch (Self.Faces (Front).texture_Name));
upper_Face.is_Transparent (now => upper_Face.Texture.is_Transparent);
upper_Face.Model_is (Self.all'unchecked_Access);
end if;
end;
@@ -140,6 +143,7 @@ is
then
lower_Face.Texture_is (Textures.fetch (Self.Faces (Front).texture_Name));
lower_Face.is_Transparent (now => lower_Face.Texture.is_Transparent);
lower_Face.Model_is (Self.all'unchecked_Access);
end if;
end;
@@ -159,6 +163,7 @@ is
then
left_Face.Texture_is (Textures.fetch (Self.Faces (Front).texture_Name));
left_Face.is_Transparent (now => left_Face.Texture.is_Transparent);
left_Face.Model_is (Self.all'unchecked_Access);
end if;
end;
@@ -178,6 +183,7 @@ is
then
right_Face.Texture_is (Textures.fetch (Self.Faces (Front).texture_Name));
right_Face.is_Transparent (now => right_Face.Texture.is_Transparent);
right_Face.Model_is (Self.all'unchecked_Access);
end if;
end;
@@ -191,4 +197,46 @@ is
end to_GL_Geometries;
------------
-- Texturing
--
overriding
procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_Id;
Now : in texture_Set.fade_Level)
is
begin
null;
end Fade_is;
overriding
function Fade (Self : in Item; Which : in texture_Set.texture_Id) return texture_Set.fade_Level
is
begin
return 0.0;
end Fade;
procedure Texture_is (Self : in out Item; Which : in texture_Set.texture_Id;
Now : in openGL.asset_Name)
is
begin
null;
end Texture_is;
overriding
function texture_Count (Self : in Item) return Natural
is
begin
return 1;
end texture_Count;
end openGL.Model.box.textured;

18
3-mid/opengl/source/lean/model/opengl-model-box-textured.ads
View File

@@ -40,6 +40,24 @@ is
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
--
overriding
function Fade (Self : in Item; Which : in texture_Set.texture_Id) return texture_Set.fade_Level;
overriding
procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_Id;
Now : in texture_Set.fade_Level);
procedure Texture_is (Self : in out Item; Which : in texture_Set.texture_Id;
Now : in asset_Name);
overriding
function texture_Count (Self : in Item) return Natural;
private

45
3-mid/opengl/source/lean/model/opengl-model-capsule-lit_textured.adb
View File

@@ -190,6 +190,8 @@ is
begin
the_shaft_Geometry.add (Primitive.view (the_Primitive));
end;
the_shaft_Geometry.Model_is (Self.all'unchecked_Access);
end;
@@ -386,6 +388,8 @@ is
end;
end;
cap_Geometry.Model_is (Self.all'unchecked_Access);
return cap_Geometry;
end new_Cap;
@@ -400,4 +404,45 @@ is
end to_GL_Geometries;
------------
-- Texturing
--
overriding
procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_Id;
Now : in texture_Set.fade_Level)
is
begin
null;
end Fade_is;
overriding
function Fade (Self : in Item; Which : in texture_Set.texture_Id) return texture_Set.fade_Level
is
begin
return 0.0;
end Fade;
procedure Texture_is (Self : in out Item; Which : in texture_Set.texture_Id;
Now : in openGL.asset_Name)
is
begin
null;
end Texture_is;
overriding
function texture_Count (Self : in Item) return Natural
is
begin
return 1;
end texture_Count;
end openGL.Model.capsule.lit_textured;

18
3-mid/opengl/source/lean/model/opengl-model-capsule-lit_textured.ads
View File

@@ -28,6 +28,24 @@ is
Fonts : in Font.font_id_Map_of_font) return Geometry.views;
------------
-- Texturing
--
overriding
function Fade (Self : in Item; Which : in texture_Set.texture_Id) return texture_Set.fade_Level;
overriding
procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_Id;
Now : in texture_Set.fade_Level);
procedure Texture_is (Self : in out Item; Which : in texture_Set.texture_Id;
Now : in asset_Name);
overriding
function texture_Count (Self : in Item) return Natural;
private

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

@@ -114,6 +114,7 @@ is
end loop;
the_Geometry.is_Transparent (True); -- TODO: Do transparency properly.
the_Geometry.Model_is (Self.all'unchecked_Access);
return the_Geometry;
end new_Face;
@@ -138,8 +139,6 @@ 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;

45
3-mid/opengl/source/lean/model/opengl-model-sphere-lit_textured.adb
View File

@@ -186,8 +186,53 @@ is
the_Geometry.add (Primitive.view (the_Primitive));
end;
the_Geometry.Model_is (Self.all'unchecked_Access);
return [1 => Geometry.view (the_Geometry)];
end to_GL_Geometries;
------------
-- Texturing
--
overriding
procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_Id;
Now : in texture_Set.fade_Level)
is
begin
null;
end Fade_is;
overriding
function Fade (Self : in Item; Which : in texture_Set.texture_Id) return texture_Set.fade_Level
is
begin
return 0.0;
end Fade;
procedure Texture_is (Self : in out Item; Which : in texture_Set.texture_Id;
Now : in openGL.asset_Name)
is
begin
Self.Image := Now;
end Texture_is;
overriding
function texture_Count (Self : in Item) return Natural
is
begin
return 1;
end texture_Count;
end openGL.Model.sphere.lit_textured;

20
3-mid/opengl/source/lean/model/opengl-model-sphere-lit_textured.ads
View File

@@ -25,10 +25,28 @@ is
Fonts : in Font.font_id_Map_of_font) return Geometry.views;
------------
-- Texturing
--
overriding
function Fade (Self : in Item; Which : in texture_Set.texture_Id) return texture_Set.fade_Level;
overriding
procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_Id;
Now : in texture_Set.fade_Level);
procedure Texture_is (Self : in out Item; Which : in texture_Set.texture_Id;
Now : in asset_Name);
overriding
function texture_Count (Self : in Item) return Natural;
private
type Item is new Model.sphere.item with -- TODO: Add 'Color' component.
type Item is new Model.sphere.item with
record
Image : asset_Name := null_Asset;
end record;

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

@@ -226,6 +226,8 @@ is
the_Geometry.add (Primitive.view (the_Primitive));
end;
the_Geometry.Model_is (Self.all'unchecked_Access);
return [1 => Geometry.view (the_Geometry)];
end to_GL_Geometries;
@@ -282,4 +284,45 @@ is
end set_Bounds;
------------
-- Texturing
--
overriding
procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_Id;
Now : in texture_Set.fade_Level)
is
begin
null;
end Fade_is;
overriding
function Fade (Self : in Item; Which : in texture_Set.texture_Id) return texture_Set.fade_Level
is
begin
return 0.0;
end Fade;
procedure Texture_is (Self : in out Item; Which : in texture_Set.texture_Id;
Now : in openGL.asset_Name)
is
begin
Self.color_Map := Now;
end Texture_is;
overriding
function texture_Count (Self : in Item) return Natural
is
begin
return 1;
end texture_Count;
end openGL.Model.terrain;

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

@@ -37,6 +37,25 @@ is
Fonts : in Font.font_id_Map_of_font) return Geometry.views;
------------
-- Texturing
--
overriding
function Fade (Self : in Item; Which : in texture_Set.texture_Id) return texture_Set.fade_Level;
overriding
procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_Id;
Now : in texture_Set.fade_Level);
procedure Texture_is (Self : in out Item; Which : in texture_Set.texture_Id;
Now : in asset_Name);
overriding
function texture_Count (Self : in Item) return Natural;
private
type Item is new Model.item with

43
3-mid/opengl/source/lean/model/opengl-model-text-lit_colored.adb
View File

@@ -279,6 +279,7 @@ is
the_Geometry.add (Primitive.view (the_Primitive));
the_Geometry.Vertices_are (the_Vertices);
the_Geometry.Texture_is (Texture.Forge.to_Texture (Self.Font.gl_Texture));
the_Geometry.Model_is (Self.all'unchecked_Access);
the_Geometry.is_Transparent;
return [1 => Geometry.view (the_Geometry)];
@@ -286,4 +287,46 @@ is
end to_GL_Geometries;
------------
-- Texturing
--
overriding
procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_Id;
Now : in texture_Set.fade_Level)
is
begin
null;
end Fade_is;
overriding
function Fade (Self : in Item; Which : in texture_Set.texture_Id) return texture_Set.fade_Level
is
begin
return 0.0;
end Fade;
procedure Texture_is (Self : in out Item; Which : in texture_Set.texture_Id;
Now : in openGL.asset_Name)
is
begin
null;
end Texture_is;
overriding
function texture_Count (Self : in Item) return Natural
is
begin
return 1;
end texture_Count;
end openGL.Model.Text.lit_colored;

18
3-mid/opengl/source/lean/model/opengl-model-text-lit_colored.ads
View File

@@ -38,6 +38,24 @@ is
function Font (Self : in Item) return openGL.Font.view;
------------
-- Texturing
--
overriding
function Fade (Self : in Item; Which : in texture_Set.texture_Id) return texture_Set.fade_Level;
overriding
procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_Id;
Now : in texture_Set.fade_Level);
procedure Texture_is (Self : in out Item; Which : in texture_Set.texture_Id;
Now : in asset_Name);
overriding
function texture_Count (Self : in Item) return Natural;
private