550 lines
20 KiB
Ada
550 lines
20 KiB
Ada
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_Details : in texture_Set.Details;
|
|
Texture_is_lucid : in Boolean) return openGL.Model.any.item
|
|
is
|
|
begin
|
|
-- return Self : openGL.Model.any. := (openGL.Model.item with
|
|
return Self : openGL.Model.any.item := (textured_Model.textured_item with
|
|
Model,
|
|
Texture,
|
|
Texture_is_lucid,
|
|
Geometry => null)
|
|
do
|
|
Self.Bounds.Ball := 1.0;
|
|
Self.texture_Details_is (texture_Details);
|
|
end return;
|
|
end to_Model;
|
|
|
|
|
|
function new_Model (Model : in asset_Name;
|
|
Texture : in asset_Name;
|
|
texture_Details : in texture_Set.Details;
|
|
Texture_is_lucid : in Boolean) return openGL.Model.any.view
|
|
is
|
|
begin
|
|
return new openGL.Model.any.item' (to_Model (Model, Texture, texture_Details, 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;
|
|
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;
|
|
|
|
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);
|
|
|
|
Self.Geometry.Model_is (Self'unchecked_Access);
|
|
|
|
|
|
-- 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;
|
|
|
|
|
|
|
|
------------
|
|
-- 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;
|