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

opengl.model.sphere.lit_colored_textured: Update texturing and add color.

Browse Source
This commit is contained in:
Rod Kay
2023-10-21 14:21:26 +11:00
parent 833584970a
commit 8ea8928fd0
2 changed files with 19 additions and 20 deletions
Download Patch File Download Diff File Expand all files Collapse all files

29
3-mid/opengl/source/lean/model/opengl-model-sphere-lit_colored_textured.adb
View File

@@ -1,8 +1,6 @@
with with
openGL.Palette,
openGL.Geometry.lit_colored_textured, openGL.Geometry.lit_colored_textured,
openGL.Texture, openGL.Texture,
openGL.IO,
openGL.Primitive.indexed; openGL.Primitive.indexed;
@@ -13,9 +11,11 @@ is
-- --
function new_Sphere (Radius : in Real; function new_Sphere (Radius : in Real;
lat_Count : in Positive := default_latitude_Count; lat_Count : in Positive := default_latitude_Count;
long_Count : in Positive := default_longitude_Count; long_Count : in Positive := default_longitude_Count;
Image : in asset_Name := null_Asset) return View Color : in openGL.lucid_Color := (openGL.Palette.Grey,
Opacity => 1.0);
Image : in asset_Name := null_Asset) return View
is is
Self : constant View := new Item; Self : constant View := new Item;
begin begin
@@ -23,6 +23,7 @@ is
Self.lat_Count := lat_Count; Self.lat_Count := lat_Count;
Self.long_Count := long_Count; Self.long_Count := long_Count;
Self.Color := Color;
Self.Image := Image; Self.Image := Image;
return Self; return Self;
@@ -45,11 +46,9 @@ is
function to_GL_Geometries (Self : access Item; Textures : access Texture.name_Map_of_texture'Class; 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 Fonts : in Font.font_id_Map_of_font) return Geometry.views
is is
pragma unreferenced (Textures, Fonts); pragma unreferenced (Fonts);
use openGL.Geometry, use openGL.Geometry.lit_colored_textured;
openGL.Palette,
openGL.Geometry.lit_colored_textured;
lat_Count : Positive renames Self.lat_Count; lat_Count : Positive renames Self.lat_Count;
long_Count : Positive renames Self.long_Count; long_Count : Positive renames Self.long_Count;
@@ -92,8 +91,7 @@ is
the_Vertices (the_Vertices'First).Normal := Normalised (north_Pole); the_Vertices (the_Vertices'First).Normal := Normalised (north_Pole);
the_Vertices (the_Vertices'First).Shine := 0.5; the_Vertices (the_Vertices'First).Shine := 0.5;
the_Vertices (the_Vertices'First).Coords := (S => 0.5, T => 1.0); the_Vertices (the_Vertices'First).Coords := (S => 0.5, T => 1.0);
the_Vertices (the_Vertices'First).Color := (Primary => +White, the_Vertices (the_Vertices'First).Color := +Self.Color;
Alpha => opaque_Value);
the_Sites (the_Vertices'Last) := south_Pole; the_Sites (the_Vertices'Last) := south_Pole;
@@ -101,8 +99,7 @@ is
the_Vertices (the_Vertices'Last).Normal := Normalised (south_Pole); the_Vertices (the_Vertices'Last).Normal := Normalised (south_Pole);
the_Vertices (the_Vertices'Last).Shine := 0.5; the_Vertices (the_Vertices'Last).Shine := 0.5;
the_Vertices (the_Vertices'Last).Coords := (S => 0.5, T => 0.0); the_Vertices (the_Vertices'Last).Coords := (S => 0.5, T => 0.0);
the_Vertices (the_Vertices'Last).Color := (Primary => +White, the_Vertices (the_Vertices'Last).Color := +Self.Color;
Alpha => opaque_Value);
for lat_Id in 2 .. lat_Count - 1 for lat_Id in 2 .. lat_Count - 1
loop loop
@@ -118,8 +115,7 @@ is
the_Vertices (vert_Id).Site := the_Site; the_Vertices (vert_Id).Site := the_Site;
the_Vertices (vert_Id).Normal := Normalised (the_Site); the_Vertices (vert_Id).Normal := Normalised (the_Site);
the_Vertices (vert_Id).Shine := 0.5; the_Vertices (vert_Id).Shine := 0.5;
the_Vertices (vert_Id).Color := (Primary => +White, the_Vertices (vert_Id).Color := +Self.Color;
Alpha => opaque_Value);
the_Vertices (vert_Id).Coords := (S => a / Degrees_360, the_Vertices (vert_Id).Coords := (S => a / Degrees_360,
T => 1.0 - b / Degrees_180); T => 1.0 - b / Degrees_180);
@@ -138,8 +134,7 @@ is
the_Vertices (vert_Id).Site := the_Site; the_Vertices (vert_Id).Site := the_Site;
the_Vertices (vert_Id).Normal := Normalised (the_Site); the_Vertices (vert_Id).Normal := Normalised (the_Site);
the_Vertices (vert_Id).Shine := 0.5; the_Vertices (vert_Id).Shine := 0.5;
the_Vertices (vert_Id).Color := (Primary => +White, the_Vertices (vert_Id).Color := +Self.Color;
Alpha => opaque_Value);
the_Vertices (vert_Id).Coords := (S => a / Degrees_360, the_Vertices (vert_Id).Coords := (S => a / Degrees_360,
T => 1.0 - b / Degrees_180); T => 1.0 - b / Degrees_180);
end loop; end loop;

10
3-mid/opengl/source/lean/model/opengl-model-sphere-lit_colored_textured.ads
View File

@@ -1,5 +1,6 @@
with with
openGL.Font, openGL.Font,
openGL.Palette,
openGL.Geometry; openGL.Geometry;
@@ -13,9 +14,11 @@ is
function new_Sphere (Radius : in Real; function new_Sphere (Radius : in Real;
lat_Count : in Positive := default_latitude_Count; lat_Count : in Positive := default_latitude_Count;
long_Count : in Positive := default_longitude_Count; long_Count : in Positive := default_longitude_Count;
Image : in asset_Name := null_Asset) return View; Color : in openGL.lucid_Color := (openGL.Palette.Grey,
Opacity => 1.0);
Image : in asset_Name := null_Asset) return View;
overriding overriding
@@ -46,6 +49,7 @@ private
type Item is new Model.sphere.item with -- TODO: Add 'Color' component. type Item is new Model.sphere.item with -- TODO: Add 'Color' component.
record record
Color : openGL.lucid_Color;
Image : asset_Name := null_Asset; -- Usually a mercator projection to be mapped onto the sphere. Image : asset_Name := null_Asset; -- Usually a mercator projection to be mapped onto the sphere.
end record; end record;