Add initial prototype.
This commit is contained in:
Rod Kay
495
3-mid/opengl/source/lean/model/opengl-model-any.adb
Normal file
495
3-mid/opengl/source/lean/model/opengl-model-any.adb
Normal file
@@ -0,0 +1,495 @@
|
||||
with
|
||||
openGL.Primitive.short_indexed,
|
||||
openGL.Primitive. indexed,
|
||||
openGL.Primitive.long_indexed,
|
||||
|
||||
openGL.Geometry.lit_textured,
|
||||
openGL.Geometry.lit_colored_textured_skinned,
|
||||
|
||||
openGL.Texture,
|
||||
openGL.Palette,
|
||||
|
||||
openGL.IO.wavefront,
|
||||
openGL.IO.collada,
|
||||
openGL.IO.lat_long_Radius,
|
||||
|
||||
ada.Strings.fixed,
|
||||
ada.Containers.hashed_Maps,
|
||||
|
||||
ada.unchecked_Deallocation;
|
||||
|
||||
|
||||
package body openGL.Model.any
|
||||
is
|
||||
|
||||
type lit_textured_skinned_Geometry_view is access all openGL.Geometry.lit_colored_textured_skinned.item'Class;
|
||||
|
||||
|
||||
---------
|
||||
--- Forge
|
||||
--
|
||||
|
||||
function to_Model (Model : in asset_Name;
|
||||
Texture : in asset_Name;
|
||||
Texture_is_lucid : in Boolean) return openGL.Model.any.item
|
||||
is
|
||||
begin
|
||||
return Self : openGL.Model.any.item := (openGL.Model.item with
|
||||
Model,
|
||||
Texture,
|
||||
Texture_is_lucid,
|
||||
Geometry => null)
|
||||
do
|
||||
Self.Bounds.Ball := 1.0;
|
||||
end return;
|
||||
end to_Model;
|
||||
|
||||
|
||||
function new_Model (Model : in asset_Name;
|
||||
Texture : in asset_Name;
|
||||
Texture_is_lucid : in Boolean) return openGL.Model.any.view
|
||||
is
|
||||
begin
|
||||
return new openGL.Model.any.item' (to_Model (Model, Texture, Texture_is_lucid));
|
||||
end new_Model;
|
||||
|
||||
|
||||
--------------
|
||||
--- Attributes
|
||||
--
|
||||
|
||||
function model_Name (Self : in Item) return asset_Name
|
||||
is
|
||||
begin
|
||||
return Self.Model;
|
||||
end model_Name;
|
||||
|
||||
|
||||
use openGL.IO;
|
||||
|
||||
function Hash (Self : in io.Vertex) return ada.Containers.Hash_type
|
||||
is
|
||||
begin
|
||||
return ada.Containers.Hash_type (Self.site_Id + 3 * Self.coord_Id + 5 * Self.normal_Id + 7 * Self.weights_Id);
|
||||
end Hash;
|
||||
|
||||
package io_vertex_Maps_of_gl_vertex_id is new ada.containers.Hashed_Maps (io.Vertex,
|
||||
long_Index_t,
|
||||
Hash,
|
||||
"=");
|
||||
subtype io_vertex_Map_of_gl_vertex_id is io_vertex_Maps_of_gl_vertex_id.Map;
|
||||
|
||||
type any_Vertex is
|
||||
record
|
||||
Site : Vector_3;
|
||||
Normal : Vector_3;
|
||||
Coords : Coordinate_2D;
|
||||
Shine : Real;
|
||||
Bones : bone_Weights (1 .. 4);
|
||||
end record;
|
||||
|
||||
type any_Vertex_array is array (long_Index_t range <>) of aliased any_Vertex;
|
||||
type any_Vertex_array_view is access all any_Vertex_array;
|
||||
|
||||
procedure deallocate is new ada.unchecked_Deallocation (any_Vertex_array,
|
||||
any_Vertex_array_view);
|
||||
|
||||
|
||||
function to_lit_textured_Vertices (From : in any_Vertex_array) return Geometry.lit_textured.Vertex_large_array
|
||||
is
|
||||
Result : Geometry.lit_textured.Vertex_large_array (From'Range);
|
||||
begin
|
||||
for i in From'Range
|
||||
loop
|
||||
Result (i) := (Site => From (i).Site,
|
||||
Normal => From (i).Normal,
|
||||
Coords => From (i).Coords,
|
||||
Shine => From (i).Shine);
|
||||
end loop;
|
||||
|
||||
return Result;
|
||||
end to_lit_textured_Vertices;
|
||||
|
||||
|
||||
|
||||
function to_lit_textured_skinned_Vertices (From : in any_Vertex_array) return Geometry.lit_colored_textured_skinned.Vertex_array
|
||||
is
|
||||
use Palette;
|
||||
Result : Geometry.lit_colored_textured_skinned.Vertex_array (From'Range);
|
||||
begin
|
||||
for i in From'Range
|
||||
loop
|
||||
Result (i) := (Site => From (i).Site,
|
||||
Normal => From (i).Normal,
|
||||
Coords => From (i).Coords,
|
||||
Shine => From (i).Shine,
|
||||
Color => (+White, opaque_Value),
|
||||
bone_Ids => [1 => Real (From (i).Bones (1).Bone),
|
||||
2 => Real (From (i).Bones (2).Bone),
|
||||
3 => Real (From (i).Bones (3).Bone),
|
||||
4 => Real (From (i).Bones (4).Bone)],
|
||||
bone_Weights => [1 => From (i).Bones (1).Weight,
|
||||
2 => From (i).Bones (2).Weight,
|
||||
3 => From (i).Bones (3).Weight,
|
||||
4 => From (i).Bones (4).Weight]);
|
||||
end loop;
|
||||
|
||||
return Result;
|
||||
end to_lit_textured_skinned_Vertices;
|
||||
|
||||
|
||||
|
||||
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 (Textures, Fonts);
|
||||
begin
|
||||
Self.build_GL_Geometries;
|
||||
return [1 => Self.Geometry];
|
||||
end to_GL_Geometries;
|
||||
|
||||
|
||||
|
||||
procedure build_GL_Geometries (Self : in out Item)
|
||||
is
|
||||
use Geometry;
|
||||
|
||||
model_Name : constant String := to_String (Self.Model);
|
||||
|
||||
function load_Model return io.Model
|
||||
is
|
||||
use ada.Strings.fixed;
|
||||
begin
|
||||
if Tail (model_Name, 4) = ".obj" then return wavefront .to_Model (model_Name);
|
||||
elsif Tail (model_Name, 4) = ".dae" then return collada .to_Model (model_Name);
|
||||
elsif Tail (model_Name, 4) = ".tab" then return lat_long_Radius.to_Model (model_Name);
|
||||
else raise unsupported_model_Format with "Model => '" & model_Name & "'";
|
||||
end if;
|
||||
end load_Model;
|
||||
|
||||
the_Model : openGL.io.Model := load_Model;
|
||||
the_Map : io_vertex_Map_of_gl_vertex_id;
|
||||
|
||||
the_Vertices : any_Vertex_array_view := new any_Vertex_array' (1 .. 100_000 => <>);
|
||||
vertex_Count : openGL.long_Index_t := 0;
|
||||
|
||||
tri_Count : Index_t := 0;
|
||||
Normals_known : Boolean := False;
|
||||
|
||||
-- TODO: Use one set of gl face vertices and 2 sets of indices (1 for tris and 1 for quads).
|
||||
|
||||
begin
|
||||
Self.Bounds := null_Bounds;
|
||||
|
||||
-- 1st pass: - Set our openGL face vertices.
|
||||
-- - Build 'io vertex' to 'openGL face vertex_Id' map.
|
||||
--
|
||||
for f in the_Model.Faces'Range
|
||||
loop
|
||||
declare
|
||||
use io_vertex_Maps_of_gl_vertex_id;
|
||||
|
||||
the_model_Face : io.Face renames the_Model.Faces (f);
|
||||
|
||||
begin
|
||||
if the_model_Face.Kind = Triangle
|
||||
or the_model_Face.Kind = Quad
|
||||
then
|
||||
declare
|
||||
the_io_Vertices : constant io.Vertices := Vertices_of (the_model_Face);
|
||||
Cursor : io_vertex_Maps_of_gl_vertex_id.Cursor;
|
||||
begin
|
||||
case the_model_Face.Kind
|
||||
is
|
||||
when Triangle => tri_Count := tri_Count + 1;
|
||||
when Quad => tri_Count := tri_Count + 2;
|
||||
when Polygon => null;
|
||||
end case;
|
||||
|
||||
for v in the_io_Vertices'Range
|
||||
loop
|
||||
Cursor := the_Map.find (the_io_Vertices (v));
|
||||
|
||||
if not has_Element (Cursor)
|
||||
then -- We do not know about this vertex yet, so add it.
|
||||
vertex_Count := vertex_Count + 1;
|
||||
|
||||
declare
|
||||
the_io_Vertex : io.Vertex renames the_io_Vertices (v);
|
||||
the_gl_Vertex : any_Vertex renames the_Vertices (vertex_Count);
|
||||
begin
|
||||
the_gl_Vertex.Site := the_Model.Sites (the_io_Vertex.site_Id);
|
||||
|
||||
Self.Bounds.Box := Self.Bounds.Box or the_gl_Vertex.Site;
|
||||
Self.Bounds.Ball := Real'Max (Self.Bounds.Ball,
|
||||
abs (the_gl_Vertex.Site));
|
||||
|
||||
if the_io_Vertex.coord_Id /= null_Id
|
||||
then the_gl_Vertex.Coords := the_Model.Coords (the_io_Vertex.coord_Id);
|
||||
else the_gl_Vertex.Coords := (0.0, 0.0);
|
||||
end if;
|
||||
|
||||
if the_io_Vertex.normal_Id /= null_Id
|
||||
then the_gl_Vertex.Normal := the_Model.Normals (the_io_Vertex.normal_Id);
|
||||
the_gl_Vertex.Shine := default_Shine;
|
||||
normals_Known := True;
|
||||
else the_gl_Vertex.Normal := [0.0, 0.0, 0.0];
|
||||
end if;
|
||||
|
||||
if the_Model.Weights /= null
|
||||
and the_io_Vertex.weights_Id /= null_Id
|
||||
then
|
||||
declare
|
||||
the_Weights : bone_Weights renames the_Model.Weights (the_io_Vertex.weights_Id).all;
|
||||
begin
|
||||
if the_Weights'Length > 0
|
||||
then
|
||||
the_gl_Vertex.Bones (1) := the_Weights (1);
|
||||
--
|
||||
-- nb: Only using the first 4 bones atm.
|
||||
|
||||
if the_Weights'Length >= 2
|
||||
then the_gl_Vertex.Bones (2) := the_Weights (2);
|
||||
else the_gl_Vertex.Bones (2) := (0, 0.0);
|
||||
end if;
|
||||
|
||||
if the_Weights'Length >= 3
|
||||
then the_gl_Vertex.Bones (3) := the_Weights (3);
|
||||
else the_gl_Vertex.Bones (3) := (0, 0.0);
|
||||
end if;
|
||||
|
||||
if the_Weights'Length >= 4
|
||||
then the_gl_Vertex.Bones (4) := the_Weights (4);
|
||||
else the_gl_Vertex.Bones (4) := (0, 0.0);
|
||||
end if;
|
||||
|
||||
else
|
||||
the_gl_Vertex.Bones := [1 => (0, 0.0),
|
||||
2 => (0, 0.0),
|
||||
3 => (0, 0.0),
|
||||
4 => (0, 0.0)];
|
||||
end if;
|
||||
end;
|
||||
|
||||
else
|
||||
the_gl_Vertex.Bones := [1 => (0, 0.0),
|
||||
2 => (0, 0.0),
|
||||
3 => (0, 0.0),
|
||||
4 => (0, 0.0)];
|
||||
end if;
|
||||
|
||||
the_Map.insert (the_io_Vertex, vertex_Count); -- 'vertex_Count' provides the index of the current vertex.
|
||||
end;
|
||||
end if;
|
||||
|
||||
end loop;
|
||||
end;
|
||||
|
||||
end if;
|
||||
end;
|
||||
end loop;
|
||||
|
||||
-- We now have our gl face vertices built and mapped to each model vertex.
|
||||
|
||||
|
||||
-- 2nd pass: - Set the triangle faceted indices.
|
||||
-- - Set the quad faceted indices.
|
||||
--
|
||||
declare
|
||||
tri_indices_Count : long_Index_t := 0;
|
||||
tri_indices_Last : constant long_Index_t := long_Index_t (tri_Count) * 3;
|
||||
tri_Indices : aliased long_Indices (1 .. tri_indices_Last);
|
||||
|
||||
procedure add_to_Tri (the_Vertex : in io.Vertex)
|
||||
is
|
||||
begin
|
||||
tri_indices_Count := tri_indices_Count + 1;
|
||||
tri_Indices (tri_indices_Count) := the_Map.Element (the_Vertex);
|
||||
end add_to_Tri;
|
||||
|
||||
begin
|
||||
for f in the_Model.Faces'Range
|
||||
loop
|
||||
declare
|
||||
the_model_Face : io.Face renames the_Model.Faces (f);
|
||||
the_io_Vertices : constant io.Vertices := Vertices_of (the_model_Face);
|
||||
begin
|
||||
case the_model_Face.Kind
|
||||
is
|
||||
when Triangle =>
|
||||
for v in the_io_Vertices'Range
|
||||
loop
|
||||
add_to_Tri (the_io_Vertices (v));
|
||||
end loop;
|
||||
|
||||
when Quad =>
|
||||
add_to_Tri (the_io_Vertices (1));
|
||||
add_to_Tri (the_io_Vertices (2));
|
||||
add_to_Tri (the_io_Vertices (3));
|
||||
|
||||
add_to_Tri (the_io_Vertices (3));
|
||||
add_to_Tri (the_io_Vertices (4));
|
||||
add_to_Tri (the_io_Vertices (1));
|
||||
|
||||
when Polygon =>
|
||||
null;
|
||||
end case;
|
||||
end;
|
||||
end loop;
|
||||
|
||||
pragma assert (tri_indices_Count = tri_indices_Last);
|
||||
|
||||
|
||||
-- Determine which geometry class is required and create the geometry.
|
||||
--
|
||||
if the_Model.Weights = null
|
||||
then
|
||||
declare
|
||||
use Geometry.lit_textured;
|
||||
|
||||
my_Vertices : aliased lit_textured.Vertex_large_array
|
||||
:= to_lit_textured_Vertices (the_Vertices (1 .. vertex_Count));
|
||||
|
||||
my_Geometry : constant Geometry.lit_textured.view
|
||||
:= lit_textured.new_Geometry;
|
||||
begin
|
||||
if not normals_Known
|
||||
then
|
||||
set_Normals:
|
||||
declare
|
||||
type Normals_view is access all Normals;
|
||||
|
||||
function get_Sites return Sites
|
||||
is
|
||||
Result : Sites := [1 .. my_Vertices'Length => <>];
|
||||
begin
|
||||
for i in Result'Range
|
||||
loop
|
||||
Result (i) := my_Vertices (long_Index_t (i)).Site;
|
||||
end loop;
|
||||
|
||||
return Result;
|
||||
end get_Sites;
|
||||
|
||||
the_Sites : constant openGL.Sites := get_Sites;
|
||||
the_Normals : Normals_view := Geometry.Normals_of (Primitive.Triangles,
|
||||
tri_Indices,
|
||||
the_Sites);
|
||||
procedure deallocate is new ada.unchecked_Deallocation (Normals, Normals_view);
|
||||
|
||||
begin
|
||||
for i in my_Vertices'Range
|
||||
loop
|
||||
my_Vertices (i).Normal := the_Normals (Index_t (i));
|
||||
my_Vertices (i).Shine := default_Shine;
|
||||
end loop;
|
||||
|
||||
deallocate (the_Normals);
|
||||
end set_Normals;
|
||||
end if;
|
||||
|
||||
my_Geometry.Vertices_are (now => my_Vertices);
|
||||
Self.Geometry := Geometry.view (my_Geometry);
|
||||
end;
|
||||
|
||||
else -- Is skinned.
|
||||
declare
|
||||
use Geometry.lit_colored_textured_skinned;
|
||||
|
||||
my_Vertices : aliased constant lit_colored_textured_skinned.Vertex_array
|
||||
:= to_lit_textured_skinned_Vertices (the_Vertices (1 .. vertex_Count));
|
||||
|
||||
my_Geometry : constant lit_textured_skinned_Geometry_view
|
||||
:= lit_colored_textured_skinned.new_Geometry;
|
||||
begin
|
||||
my_Geometry.Vertices_are (now => my_Vertices);
|
||||
Self.Geometry := Geometry.view (my_Geometry);
|
||||
end;
|
||||
end if;
|
||||
|
||||
deallocate (the_Vertices);
|
||||
destroy (the_Model);
|
||||
|
||||
-- Set the geometry texture.
|
||||
--
|
||||
if Self.Texture /= null_Asset
|
||||
then
|
||||
if Self.has_lucid_Texture
|
||||
then
|
||||
declare
|
||||
use Texture;
|
||||
the_Image : constant lucid_Image
|
||||
:= io.to_lucid_Image (Self.Texture);
|
||||
|
||||
the_Texture : constant Texture.object
|
||||
:= Forge.to_Texture (the_Image);
|
||||
|
||||
begin
|
||||
Self.Geometry.Texture_is (the_Texture);
|
||||
end;
|
||||
else
|
||||
declare
|
||||
use Texture;
|
||||
the_Image : constant Image := io.to_Image (Self.Texture);
|
||||
the_Texture : constant Texture.object := Forge.to_Texture (the_Image);
|
||||
begin
|
||||
Self.Geometry.Texture_is (the_Texture);
|
||||
end;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- Add any facia to the geometry.
|
||||
--
|
||||
if tri_Indices'Length > 0
|
||||
then
|
||||
if vertex_Count <= long_Index_t (short_Index_t'Last)
|
||||
then
|
||||
declare
|
||||
the_Primitive : constant Primitive.short_indexed.view
|
||||
:= Primitive.short_indexed.new_Primitive (Primitive.Triangles,
|
||||
tri_Indices);
|
||||
begin
|
||||
Self.Geometry.add (Primitive.view (the_Primitive));
|
||||
end;
|
||||
|
||||
elsif vertex_Count <= long_Index_t (Index_t'Last)
|
||||
then
|
||||
declare
|
||||
the_Primitive : constant Primitive.indexed.view
|
||||
:= Primitive.indexed.new_Primitive (primitive.Triangles,
|
||||
tri_Indices);
|
||||
begin
|
||||
Self.Geometry.add (Primitive.view (the_Primitive));
|
||||
end;
|
||||
|
||||
else
|
||||
if openGL.Profile /= Desk
|
||||
then
|
||||
raise Model_too_complex with "Only the 'Desk' openGL profile allows models with more than 2**16 - 1 vertices.";
|
||||
end if;
|
||||
|
||||
declare
|
||||
the_Primitive : constant Primitive.long_indexed.view
|
||||
:= Primitive.long_indexed.new_Primitive (primitive.Triangles,
|
||||
tri_Indices);
|
||||
begin
|
||||
Self.Geometry.add (Primitive.view (the_Primitive));
|
||||
end;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
|
||||
if Geometry_3d.Extent (Self.Bounds.Box, 3) = 0.0
|
||||
then
|
||||
Self.Bounds.Box.Lower (3) := Self.Bounds.Box.Lower (3) - 0.2; -- TODO: This is dubious at best.
|
||||
end if;
|
||||
|
||||
Self.Geometry.is_Transparent (now => False);
|
||||
Self.Geometry.Label_is (to_String (Self.Model) & "-" & to_String (Self.Texture));
|
||||
end;
|
||||
|
||||
end build_GL_Geometries;
|
||||
|
||||
|
||||
end openGL.Model.any;
|
||||
Reference in New Issue
Block a user