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

Add initial prototype.

Browse Source
This commit is contained in:
Rod Kay
2022-07-31 17:34:54 +10:00
commit 54a53b2ac0
1421 changed files with 358874 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

17
2-low/collada/alire.toml Normal file
View File

@@ -0,0 +1,17 @@
name = "lace_collada"
description = "A Collada parser."
version = "0.1.1"
authors = ["Rod Kay"]
maintainers = ["Rod Kay <rodakay5@gmail.com>"]
maintainers-logins = ["charlie5"]
licenses = "ISC"
website = "https://github.com/charlie5/lace-alire"
tags = ["model", "3d"]
project-files = ["library/collada.gpr"]
[[depends-on]]
lace_math = "~0.1"
lace_xml = "~0.1"

148
2-low/collada/applet/parse_box/box.dae Normal file
View File

@@ -0,0 +1,148 @@
<?xml version="1.0" encoding="utf-8"?>
<COLLADA xmlns="http://www.collada.org/2005/11/COLLADASchema" version="1.4.1">
<asset>
<contributor>
<author>Blender User</author>
<authoring_tool>Blender 2.55.0 r-UNKNOWN-</authoring_tool>
</contributor>
<created>2010-11-28T13:09:56</created>
<modified>2010-11-28T13:09:56</modified>
<unit name="meter" meter="1"/>
<up_axis>Z_UP</up_axis>
</asset>
<library_cameras>
<camera id="Camera-camera" name="Camera">
<optics>
<technique_common>
<perspective>
<xfov>49.13434</xfov>
<aspect_ratio>1.777778</aspect_ratio>
<znear>0.099999964237</znear>
<zfar>100</zfar>
</perspective>
</technique_common>
</optics>
</camera>
</library_cameras>
<library_lights>
<light id="Lamp-light" name="Lamp">
<technique_common>
<point>
<color>1 1 1</color>
<constant_attenuation>1</constant_attenuation>
<linear_attenuation>0</linear_attenuation>
<quadratic_attenuation>5.55556e-4</quadratic_attenuation>
</point>
</technique_common>
</light>
</library_lights>
<library_images/>
<library_effects>
<effect id="Material-effect">
<profile_COMMON>
<technique sid="common">
<lambert>
<emission>
<color>0 0 0 1</color>
</emission>
<ambient>
<color>0 0 0 1</color>
</ambient>
<diffuse>
<color>0.6400000453 0.6400000453 0.6400000453 1</color>
</diffuse>
<index_of_refraction>
<float>1</float>
</index_of_refraction>
</lambert>
<extra/>
</technique>
<extra>
<technique profile="GOOGLEEARTH">
<show_double_sided>1</show_double_sided>
</technique>
</extra>
</profile_COMMON>
<extra><technique profile="MAX3D"><double_sided>1</double_sided></technique></extra>
</effect>
</library_effects>
<library_materials>
<material id="Material" name="Material">
<instance_effect url="#Material-effect"/>
</material>
</library_materials>
<library_geometries>
<geometry id="Cube-mesh">
<mesh>
<source id="Cube-mesh-positions">
<float_array id="Cube-mesh-positions-array" count="24">1 0.999999940395 -1 1 -1 -1 -1 -0.999999821186 -1 -0.999999642372 1 -1 1 0.999999463558 1 0.999999344348 -1.000001 1 -1 -0.999999642372 1 -0.999999940395 1 1</float_array>
<technique_common>
<accessor source="#Cube-mesh-positions-array" count="8" stride="3">
<param name="X" type="float"/>
<param name="Y" type="float"/>
<param name="Z" type="float"/>
</accessor>
</technique_common>
</source>
<source id="Cube-mesh-normals">
<float_array id="Cube-mesh-normals-array" count="18">0 0 -1 0 0 1 1 -2.83122e-7 0 -2.83122e-7 -1 0 -1 2.23517e-7 -1.3411e-7 2.38419e-7 1 2.08616e-7</float_array>
<technique_common>
<accessor source="#Cube-mesh-normals-array" count="6" stride="3">
<param name="X" type="float"/>
<param name="Y" type="float"/>
<param name="Z" type="float"/>
</accessor>
</technique_common>
</source>
<vertices id="Cube-mesh-vertices">
<input semantic="POSITION" source="#Cube-mesh-positions"/>
</vertices>
<polylist material="Material" count="6">
<input semantic="VERTEX" source="#Cube-mesh-vertices" offset="0"/>
<input semantic="NORMAL" source="#Cube-mesh-normals" offset="1"/>
<vcount>4 4 4 4 4 4 </vcount>
<p>0 0 1 0 2 0 3 0 4 1 7 1 6 1 5 1 0 2 4 2 5 2 1 2 1 3 5 3 6 3 2 3 2 4 6 4 7 4 3 4 4 5 0 5 3 5 7 5</p>
</polylist>
</mesh>
</geometry>
</library_geometries>
<library_animations/>
<library_controllers/>
<library_visual_scenes>
<visual_scene id="Scene" name="Scene">
<node id="Cube" type="NODE">
<translate sid="location">0 0 0</translate>
<rotate sid="rotationZ">0 0 1 0</rotate>
<rotate sid="rotationY">0 1 0 0</rotate>
<rotate sid="rotationX">1 0 0 0</rotate>
<scale sid="scale">1 1 1</scale>
<instance_geometry url="#Cube-mesh">
<bind_material>
<technique_common>
<instance_material symbol="Material" target="#Material"/>
</technique_common>
</bind_material>
</instance_geometry>
</node>
<node id="Lamp" type="NODE">
<translate sid="location">4.076245 1.005454 5.903862</translate>
<rotate sid="rotationZ">0 0 1 106.9363</rotate>
<rotate sid="rotationY">0 1 0 3.163707</rotate>
<rotate sid="rotationX">1 0 0 37.26105</rotate>
<scale sid="scale">1 1 1</scale>
<instance_light url="#Lamp-light"/>
</node>
<node id="Camera" type="NODE">
<translate sid="location">7.481132 -6.50764 5.343665</translate>
<rotate sid="rotationZ">0 0 1 46.69194</rotate>
<rotate sid="rotationY">0 1 0 0.619767916163</rotate>
<rotate sid="rotationX">1 0 0 63.55929</rotate>
<scale sid="scale">1 1 1</scale>
<instance_camera url="#Camera-camera"/>
</node>
</visual_scene>
</library_visual_scenes>
<scene>
<instance_visual_scene url="#Scene"/>
</scene>
</COLLADA>

13
2-low/collada/applet/parse_box/launch_parse_box.adb Normal file
View File

@@ -0,0 +1,13 @@
with
collada.Document;
procedure launch_parse_Box
--
-- Loads an xml file, parses it into a collada document.
--
is
the_Asset : collada.Document.item := collada.document.to_Document ("./box.dae")
with unreferenced;
begin
null;
end launch_parse_Box;

20
2-low/collada/applet/parse_box/parse_box.gpr Normal file
View File

@@ -0,0 +1,20 @@
with
"collada",
"lace_shared";
project Parse_Box
is
for Create_Missing_Dirs use "True";
for Object_Dir use "build";
for Exec_Dir use ".";
for Source_Dirs use (".");
for Main use ("launch_parse_box.adb");
package Ide renames Lace_shared.Ide;
package Builder renames Lace_shared.Builder;
package Compiler renames Lace_shared.Compiler;
package Binder renames Lace_shared.Binder;
end Parse_Box;

23
2-low/collada/library/collada.gpr Normal file
View File

@@ -0,0 +1,23 @@
with
"xml",
"math",
"lace_shared";
--library
project Collada
is
for Create_Missing_Dirs use "True";
for Object_Dir use "build";
for Library_Dir use "lib";
for Library_Ali_Dir use "objects";
-- for Library_Name use "Collada";
for Source_Dirs use ("../source");
package Ide renames Lace_shared.Ide;
package Builder renames Lace_shared.Builder;
package Compiler renames Lace_shared.Compiler;
package Binder renames Lace_shared.Binder;
end Collada;

37
2-low/collada/source/collada-asset.ads Normal file
View File

@@ -0,0 +1,37 @@
with
ada.Calendar;
package collada.Asset
--
-- Models a collada asset.
--
is
type Contributor is
record
Author : Text;
authoring_Tool : Text;
end record;
type Unit is
record
Name : Text;
Meter : Float;
end record;
type up_Direction is (X_up, Y_up, Z_up);
type Item is
record
Contributor : asset.Contributor;
Created : ada.Calendar.Time;
Modified : ada.Calendar.Time;
Unit : asset.Unit;
up_Axis : up_Direction;
end record;
end collada.Asset;

962
2-low/collada/source/collada-document.adb Normal file
View File

@@ -0,0 +1,962 @@
with
collada.Library.geometries,
collada.Library.controllers,
collada.Library.animations,
collada.Library.visual_scenes,
XML,
ada.Calendar.formatting,
ada.Strings.fixed,
ada.Characters.latin_1,
ada.Text_IO;
package body collada.Document
is
use ada.Strings.unbounded;
------------
-- Utilities
--
function "+" (From : in String) return unbounded_String
renames to_unbounded_String;
function to_Time (From : in String) return ada.Calendar.Time
is
Pad : String := From;
Index : constant Natural := ada.Strings.fixed.Index (Pad, "T");
begin
if Index /= 0 then
Pad (Index) := ' ';
end if;
return ada.Calendar.formatting.Value (Pad);
exception
when constraint_Error =>
return ada.Calendar.Clock; -- TODO: Temporary debug measure to handle unknown date formats.
end to_Time;
function to_int_Array (From : in String) return int_Array
is
use ada.Strings.fixed;
the_Array : int_Array (1 .. 500_000);
Count : math.Index := 0;
Start : Natural := 1;
Cursor : Natural := Index (From, " ");
begin
if Cursor = 0
then
return [1 => Integer'Value (From)];
end if;
loop
if From (Start .. Cursor-1) /= ""
and then From (Start .. Cursor-1) /= "" & ada.Characters.latin_1.LF
then
Count := Count + 1;
the_Array (Count) := Integer'Value (From (Start .. Cursor-1));
end if;
Start := Cursor + 1;
Cursor := Index (From, " ", Start);
exit when Cursor = 0;
end loop;
if Start <= From'Last
then
Count := Count + 1;
the_Array (Count) := Integer'Value (From (Start .. From'Last));
end if;
return the_Array (1 .. Count);
end to_int_Array;
function to_float_Array (From : in String) return float_Array
is
begin
if From = ""
then
return float_Array' (1 .. 0 => <>);
end if;
declare
use ada.Strings.fixed;
the_Array : float_Array (1 .. 500_000);
Count : math.Index := 0;
Start : Integer := 1;
Cursor : Integer := Index (From, " ");
begin
if Cursor = 0
then
return [1 => math.Real'Value (From)];
end if;
loop
if From (Start .. Cursor-1) /= ""
and then From (Start .. Cursor-1) /= "" & ada.Characters.latin_1.LF
then
Count := Count + 1;
the_Array (Count) := math.Real'Value (From (Start .. Cursor-1));
end if;
Start := Cursor + 1;
Cursor := Index (From, " ", Start);
exit when Cursor = 0;
end loop;
if From (Start .. From'Last) /= ""
then
Count := Count + 1;
the_Array (Count) := math.Real'Value (From (Start .. From'Last));
end if;
return the_Array (1 .. Count);
end;
end to_float_Array;
function to_Text_array (From : in String) return Text_array
is
begin
if From = ""
then
return Text_array' (1 .. 0 => <>);
end if;
declare
use ada.Strings.fixed;
the_Array : Text_array (1 .. 40_000);
Count : math.Index := 0;
Start : Integer := 1;
Cursor : Integer := Index (From, " ");
begin
if Cursor = 0
then
return [1 => +From];
end if;
loop
if From (Start .. Cursor-1) /= ""
and then From (Start .. Cursor-1) /= "" & ada.Characters.latin_1.LF
then
Count := Count + 1;
the_Array (Count) := +From (Start .. Cursor-1);
end if;
Start := Cursor + 1;
Cursor := Index (From, " ", Start);
exit when Cursor = 0;
end loop;
if From (Start .. From'Last) /= ""
then
Count := Count + 1;
the_Array (Count) := +From (Start .. From'Last);
end if;
return the_Array (1 .. Count);
end;
end to_Text_array;
function to_Matrix (From : in String) return Matrix_4x4
is
the_Floats : constant math.Vector_16 := math.Vector_16 (to_float_Array (From));
begin
return math.to_Matrix_4x4 (the_Floats);
end to_Matrix;
function to_Source (From : in xml.Element) return collada.Library.Source
is
the_xml_Id : constant access xml.Attribute_t := From.Attribute ("id");
the_xml_float_Array : constant access xml.Element := From.Child ("float_array");
the_xml_text_Array : constant access xml.Element := From.Child ("Name_array");
the_array_Length : Natural;
pragma Unreferenced (the_array_Length);
the_Source : Library.source;
begin
the_Source.Id := +the_xml_Id.Value;
if the_xml_float_Array /= null
then
the_Source.array_Id := +the_xml_float_Array.Attribute ("id").Value;
the_array_Length := Natural'Value (the_xml_float_Array.Attribute ("count").Value);
the_Source.Floats := new float_Array' (to_float_Array (the_xml_float_Array.Data));
elsif the_xml_text_Array /= null
then
the_Source.array_Id := +the_xml_text_Array.Attribute ("id").Value;
the_array_Length := Natural'Value (the_xml_text_Array.Attribute ("count").Value);
the_Source.Texts := new Text_array' (to_Text_array (the_xml_text_Array.Data));
end if;
return the_Source;
end to_Source;
function to_Input (From : in xml.Element) return collada.Library.Input_t
is
use collada.Library;
the_xml_Semantic : constant access xml.Attribute_t := From.Attribute ("semantic");
the_xml_Source : constant access xml.Attribute_t := From.Attribute ("source");
the_xml_Offset : constant access xml.Attribute_t := From.Attribute ("offset");
the_Input : Input_t;
begin
the_Input.Semantic := Semantic'Value (the_xml_Semantic.Value);
the_Input.Source := +the_xml_Source .Value;
if the_xml_Offset /= null
then
the_Input.Offset := Natural'Value (the_xml_Offset.Value);
end if;
return the_Input;
end to_Input;
function to_Vertices (From : in xml.Element) return collada.Library.geometries.Vertices
is
use collada.Library,
collada.Library.geometries;
the_xml_Id : constant access xml.Attribute_t := From.Attribute ("id");
the_xml_Inputs : constant xml.Elements := From.Children ("input");
the_Vertices : geometries.Vertices;
begin
the_Vertices.Id := +the_xml_Id.Value;
the_Vertices.Inputs := new Inputs (the_xml_Inputs'Range);
for i in the_xml_Inputs'Range
loop
the_Vertices.Inputs (i) := to_Input (the_xml_Inputs (i).all);
end loop;
return the_Vertices;
end to_Vertices;
function to_Polylist (From : in xml.Element) return collada.Library.geometries.Primitive
is
use collada.Library,
collada.Library.geometries;
the_xml_Count : constant access xml.Attribute_t := From.Attribute ("count");
the_xml_Material : constant access xml.Attribute_t := From.Attribute ("material");
the_xml_Inputs : constant xml.Elements := From.Children ("input");
the_xml_vCount : constant access xml.Element := From.Child ("vcount");
the_xml_P : constant access xml.Element := From.Child ("p");
the_Polylist : geometries.Primitive (polyList);
begin
the_Polylist.Count := Natural'Value (the_xml_Count.Value);
if the_xml_Material /= null
then
the_Polylist.Material := +the_xml_Material.Value;
end if;
the_Polylist.Inputs := new Inputs (the_xml_Inputs'Range);
for i in the_xml_Inputs'Range
loop
the_Polylist.Inputs (i) := to_Input (the_xml_Inputs (i).all);
end loop;
the_Polylist.vCount := new int_Array' (to_int_Array (the_xml_vCount.Data));
the_Polylist.P_List := new int_array_List' (1 => new int_Array' (to_int_Array (the_xml_P.Data)));
return the_Polylist;
end to_Polylist;
function to_Polygon (From : in xml.Element) return collada.Library.geometries.Primitive
is
use collada.Library,
collada.Library.geometries;
the_xml_Count : constant access xml.Attribute_t := From.Attribute ("count");
the_xml_Material : constant access xml.Attribute_t := From.Attribute ("material");
the_xml_Inputs : constant xml.Elements := From.Children ("input");
the_xml_Ps : constant xml.Elements := From.Children ("p");
the_Polygons : geometries.Primitive (Polygons);
begin
the_Polygons.Count := Natural'Value (the_xml_Count.Value);
if the_xml_Material /= null
then
the_Polygons.Material := +the_xml_Material.Value;
end if;
-- Do inputs.
--
the_Polygons.Inputs := new Inputs (the_xml_Inputs'Range);
for i in the_xml_Inputs'Range
loop
the_Polygons.Inputs (i) := to_Input (the_xml_Inputs (i).all);
end loop;
-- Do P list.
--
the_Polygons.P_List := new int_array_List (1 .. the_xml_Ps'Length);
for i in the_Polygons.P_List'Range
loop
the_Polygons.P_List (i) := new int_Array' (to_int_Array (the_xml_Ps (i).Data));
end loop;
return the_Polygons;
end to_Polygon;
function to_Triangles (From : in xml.Element) return collada.Library.geometries.Primitive
is
use collada.Library,
collada.Library.geometries;
the_xml_Count : constant access xml.Attribute_t := From.Attribute ("count");
the_xml_Material : constant access xml.Attribute_t := From.Attribute ("material");
the_xml_Inputs : constant xml.Elements := From.Children ("input");
the_xml_Ps : constant xml.Elements := From.Children ("p");
the_Triangles : geometries.Primitive (Triangles);
begin
the_Triangles.Count := Natural'Value (the_xml_Count.Value);
if the_xml_Material /= null
then
the_Triangles.Material := +the_xml_Material.Value;
end if;
-- Do inputs.
--
the_Triangles.Inputs := new Inputs (the_xml_Inputs'Range);
for i in the_xml_Inputs'Range
loop
the_Triangles.Inputs (i) := to_Input (the_xml_Inputs (i).all);
end loop;
-- Do P list.
--
the_Triangles.P_List := new int_array_List (1 .. the_xml_Ps'Length);
for i in the_Triangles.P_List'Range
loop
the_Triangles.P_List (i) := new int_Array' (to_int_Array (the_xml_Ps (i).Data));
end loop;
return the_Triangles;
end to_Triangles;
function to_Joints (From : in xml.Element) return collada.Library.controllers.Joints
is
use collada.Library,
collada.Library.controllers;
the_xml_Inputs : constant xml.Elements := From.Children ("input");
the_Joints : controllers.Joints;
begin
the_Joints.Inputs := new Inputs (the_xml_Inputs'Range);
for i in the_xml_Inputs'Range
loop
the_Joints.Inputs (i) := to_Input (the_xml_Inputs (i).all);
end loop;
return the_Joints;
end to_Joints;
function to_vertex_Weights (From : in xml.Element) return collada.Library.controllers.vertex_Weights
is
use collada.Library,
collada.Library.controllers;
the_xml_Count : constant access xml.Attribute_t := From.Attribute ("count");
the_xml_Inputs : constant xml.Elements := From.Children ("input");
the_xml_vCount : constant access xml.Element := From.Child ("vcount");
the_xml_V : constant access xml.Element := From.Child ("v");
the_Weights : controllers.vertex_Weights;
begin
the_Weights.Count := Natural'Value (the_xml_Count.Value);
the_Weights.Inputs := new Inputs (the_xml_Inputs'Range);
for i in the_xml_Inputs'Range
loop
the_Weights.Inputs (i) := to_Input (the_xml_Inputs (i).all);
end loop;
the_Weights.v_Count := new int_Array' (to_int_Array (the_xml_vCount.Data));
the_Weights.V := new int_array' (to_int_Array (the_xml_V.Data));
return the_Weights;
end to_vertex_Weights;
function to_Sampler (From : in xml.Element) return collada.Library.animations.Sampler
is
use collada.Library,
collada.Library.animations;
the_xml_Id : constant access xml.Attribute_t := From.Attribute ("id");
the_xml_Inputs : constant xml.Elements := From.Children ("input");
the_Sampler : animations.Sampler;
begin
the_Sampler.Id := +the_xml_Id.Value;
the_Sampler.Inputs := new Inputs (the_xml_Inputs'Range);
for i in the_xml_Inputs'Range
loop
the_Sampler.Inputs (i) := to_Input (the_xml_Inputs (i).all);
end loop;
return the_Sampler;
end to_Sampler;
function to_Channel (From : in xml.Element) return collada.Library.animations.Channel
is
use collada.Library,
collada.Library.animations;
the_xml_Source : constant access xml.Attribute_t := From.Attribute ("source");
the_xml_Target : constant access xml.Attribute_t := From.Attribute ("target");
the_Channel : animations.Channel;
begin
the_Channel.Source := +the_xml_Source.Value;
the_Channel.Target := +the_xml_Target.Value;
return the_Channel;
end to_Channel;
---------------
-- Construction
--
function to_Document (Filename : in String) return Item
is
use XML;
the_xml_Tree : constant xml.Element := xml.to_XML (Filename);
the_collada_Tree : constant access xml.Element := the_xml_Tree.Child (named => "COLLADA");
the_Document : Document.item;
begin
parse_the_asset_Element:
declare
the_Asset : constant access xml.Element := the_collada_Tree.Child (named => "asset");
the_Contributor : constant access xml.Element := the_Asset.Child (named => "contributor");
the_creation_Date : constant access xml.Element := the_Asset.Child (named => "created");
the_modification_Date : constant access xml.Element := the_Asset.Child (named => "modified");
the_Unit : constant access xml.Element := the_Asset.Child (named => "unit");
the_up_Axis : constant access xml.Element := the_Asset.Child (named => "up_axis");
begin
-- Parse the 'contributor' element.
--
if the_Contributor /= null
then
declare
the_Author : constant access xml.Element := the_Contributor .Child (named => "author");
the_authoring_Tool : constant access xml.Element := the_Contributor .Child (named => "authoring_tool");
begin
if the_Author /= null
then
the_Document.Asset.Contributor.Author := +the_Author.Data;
end if;
if the_authoring_Tool /= null
then
the_document.asset.contributor.authoring_Tool := +the_authoring_Tool.Data;
end if;
end;
end if;
-- Parse the creation and modification dates.
--
if the_creation_Date /= null
then
the_document.asset.Created := to_Time (the_creation_Date.Data);
end if;
if the_modification_Date /= null
then
the_document.asset.Modified := to_Time (the_modification_Date.Data);
end if;
-- Parse the 'unit' element.
--
if the_Unit /= null
then
the_document.asset.Unit.Name := +the_Unit.Attribute (named => "name") .Value;
the_document.asset.Unit.Meter := Float'Value (the_Unit.Attribute (named => "meter").Value);
end if;
-- Parse the 'up_axis' element.
--
if the_up_Axis /= null
then
the_document.asset.up_Axis := collada.asset.up_Direction'Value (the_up_Axis.Data);
end if;
end parse_the_asset_Element;
---------------------------------
--- Parse the 'library' elements.
--
parse_the_geometries_Library:
declare
the_Library : constant access xml.Element := the_collada_Tree.Child (named => "library_geometries");
begin
if the_Library /= null
then
declare
use collada.Library.geometries;
the_Geometries : constant xml.Elements := the_Library.Children (named => "geometry");
begin
the_Document.Libraries.Geometries.Contents := new Geometry_array (the_Geometries'Range);
for Each in the_Geometries'Range
loop
declare
the_xml_Geometry : access xml.Element renames the_Geometries (Each);
the_Geometry : Geometry renames the_Document.Libraries.Geometries.Contents (Each);
the_xml_Id : constant access xml.Attribute_t'Class := the_xml_Geometry.Attribute ("id");
the_xml_Name : constant access xml.Attribute_t'Class := the_xml_Geometry.Attribute ("name");
begin
the_Geometry.Id := +the_xml_Id.Value;
if the_xml_Name /= null
then
the_Geometry.Name := +the_xml_Name.Value;
end if;
parse_Mesh:
declare
the_xml_Mesh : access xml.Element renames the_xml_Geometry.Child ("mesh");
the_xml_Vertices : constant access xml.Element := the_xml_Mesh .Child ("vertices");
the_xml_Sources : constant xml.Elements := the_xml_Mesh.Children ("source");
begin
the_Geometry.Mesh.Sources := new library.Sources (the_xml_Sources'Range);
-- Parse sources.
--
for i in the_xml_Sources'Range
loop
the_Geometry.Mesh.Sources (i) := to_Source (the_xml_Sources (i).all);
end loop;
-- Parse vertices.
--
the_Geometry.Mesh.Vertices := to_Vertices (the_xml_Vertices.all);
-- Parse primitives.
--
declare
the_xml_Polylists : constant xml.Elements := the_xml_Mesh.Children (named => "polylist");
the_xml_Polygons : constant xml.Elements := the_xml_Mesh.Children (named => "polygons");
the_xml_Triangles : constant xml.Elements := the_xml_Mesh.Children (named => "triangles");
primitive_Count : Natural := 0;
primitive_Total : constant Natural := the_xml_Polylists'Length
+ the_xml_Polygons 'Length
+ the_xml_Triangles'Length;
begin
the_Geometry.Mesh.Primitives := new Primitives (1 .. primitive_Total);
-- polylists
--
for i in the_xml_Polylists'Range
loop
primitive_Count := primitive_Count + 1;
the_Geometry.Mesh.Primitives (primitive_Count) := to_Polylist (the_xml_Polylists (i).all);
end loop;
-- polygons
--
for i in the_xml_Polygons'Range
loop
primitive_Count := primitive_Count + 1;
the_Geometry.Mesh.Primitives (primitive_Count) := to_Polygon (the_xml_Polygons (i).all);
end loop;
-- Triangles
--
for i in the_xml_Triangles'Range
loop
primitive_Count := primitive_Count + 1;
the_Geometry.Mesh.Primitives (primitive_Count) := to_Triangles (the_xml_Triangles (i).all);
end loop;
end;
end parse_Mesh;
end;
end loop;
end;
end if;
end parse_the_geometries_Library;
-- Parse the controllers library.
--
declare
the_Library : constant access xml.Element := the_collada_Tree.Child (named => "library_controllers");
begin
if the_Library /= null
then
declare
use collada.Library.controllers;
the_Controllers : constant xml.Elements := the_Library.Children (named => "controller");
begin
the_Document.Libraries.controllers.Contents := new Controller_array (the_Controllers'Range);
for Each in the_Controllers'Range
loop
declare
the_xml_Controller : access xml.Element renames the_Controllers (Each);
the_Controller : Controller renames the_Document.Libraries.controllers.Contents (Each);
the_xml_Id : constant access xml.Attribute_t'Class := the_xml_Controller.Attribute ("id");
the_xml_Name : constant access xml.Attribute_t'Class := the_xml_Controller.Attribute ("name");
begin
the_Controller.Id := +the_xml_Id.Value;
if the_xml_Name /= null
then
the_Controller.Name := +the_xml_Name.Value;
end if;
parse_Skin:
declare
the_xml_Skin : access xml.Element renames the_xml_Controller.Child ("skin");
the_xml_Sources : constant xml.Elements := the_xml_Skin.Children ("source");
the_xml_Matrix : constant access xml.Element := the_xml_Skin.Child ("bind_shape_matrix");
the_xml_Joints : constant access xml.Element := the_xml_Skin.Child ("joints");
the_xml_Weights : constant access xml.Element := the_xml_Skin.Child ("vertex_weights");
begin
the_Controller.Skin.main_Source := +the_xml_Skin.Attribute ("source").Value;
the_Controller.Skin.bind_shape_Matrix := to_float_Array (the_xml_Matrix.Data);
-- Parse sources.
--
the_Controller.Skin.Sources := new library.Sources (the_xml_Sources'Range);
for i in the_xml_Sources'Range
loop
the_Controller.Skin.Sources (i) := to_Source (the_xml_Sources (i).all);
end loop;
the_Controller.Skin.Joints := to_Joints (the_xml_Joints.all);
the_Controller.Skin.vertex_Weights := to_vertex_Weights (the_xml_Weights.all);
end parse_Skin;
end;
end loop;
end;
end if;
end;
-- Parse the visual_Scenes library.
--
declare
the_Library : constant access xml.Element := the_collada_Tree.Child (named => "library_visual_scenes");
begin
if the_Library /= null
then
declare
use collada.Library.visual_scenes;
the_visual_Scenes : constant xml.Elements := the_Library.Children (named => "visual_scene");
begin
the_Document.Libraries.visual_Scenes.Contents := new visual_Scene_array (the_visual_Scenes'Range);
for Each in the_visual_Scenes'Range
loop
declare
the_visual_Scene : visual_Scene renames the_document.Libraries.visual_Scenes.Contents (Each);
the_xml_Scene : access xml.Element renames the_visual_Scenes (Each);
the_xml_Id : constant access xml.Attribute_t'Class := the_xml_Scene.Attribute ("id");
the_xml_Name : constant access xml.Attribute_t'Class := the_xml_Scene.Attribute ("name");
begin
the_visual_Scene.Id := +the_xml_Id.Value;
if the_xml_Name /= null
then
the_visual_Scene.Name := +the_xml_Name.Value;
end if;
parse_Nodes:
declare
the_xml_root_Node : constant access xml.Element := the_xml_Scene.Child ("node");
function to_Node (the_XML : access xml.Element;
Parent : in Library.visual_scenes.Node_view) return Library.visual_scenes.Node_view
is
the_xml_Sid : constant access xml.Attribute_t'Class := the_xml.Attribute ("sid");
the_xml_Id : constant access xml.Attribute_t'Class := the_xml.Attribute ("id");
the_xml_Name : constant access xml.Attribute_t'Class := the_xml.Attribute ("name");
the_xml_Type : access xml.Attribute_t'Class := the_xml.Attribute ("type");
the_xml_Translate : access xml.Element := the_xml.Child ("translate");
the_xml_Scale : access xml.Element := the_xml.Child ("scale");
the_xml_Rotates : xml.Elements := the_xml.Children ("rotate");
the_xml_Children : xml.Elements := the_xml.Children ("node");
the_Node : constant Library.visual_scenes.Node_view := new Library.visual_scenes.Node;
begin
if the_xml_Id /= null
then
the_Node.Id_is (+the_xml_Id.Value);
end if;
if the_xml_Sid /= null
then
the_Node.Sid_is (+the_xml_Sid.Value);
end if;
if the_xml_Name /= null
then
the_Node.Name_is (+the_xml_Name.Value);
end if;
the_Node.Parent_is (Parent);
-- Parse children.
--
declare
the_xml_Children : constant xml.Elements := the_XML.Children;
the_Child : access xml.Element;
begin
for i in the_xml_Children'Range
loop
the_Child := the_xml_Children (i);
if the_Child.Name = "translate"
then
the_Node.add (Transform' (Kind => Translate,
Sid => to_Text (the_Child.Attribute ("sid").Value),
Vector => Vector_3 (to_Float_array (the_Child.Data))));
elsif the_Child.Name = "rotate"
then
declare
use collada.Math;
the_Data : constant Vector_4 := Vector_4 (to_Float_array (the_Child.Data));
begin
the_Node.add (Transform' (Kind => Rotate,
Sid => to_Text (the_Child.Attribute ("sid").Value),
Axis => Vector_3 (the_Data (1 .. 3)),
Angle => to_Radians (math.Degrees (the_Data (4)))));
end;
elsif the_Child.Name = "scale"
then
the_Node.add (Transform' (Kind => Scale,
Sid => to_Text (the_Child.Attribute ("sid").Value),
Scale => Vector_3 (to_Float_array (the_Child.Data))));
elsif the_Child.Name = "matrix"
then
declare
the_Data : constant Matrix_4x4 := to_Matrix (the_Child.Data); -- Will be column vectors.
the_child_Sid : constant access xml.Attribute_t'Class := the_Child.Attribute ("sid");
the_sid_Text : Text;
begin
if the_child_Sid = null
then
the_sid_Text := to_Text ("");
else
the_sid_Text := to_Text (the_child_Sid.Value);
end if;
the_Node.add (Transform' (Kind => full_Transform,
Sid => the_sid_Text,
Matrix => the_Data));
end;
elsif the_Child.Name = "node"
then
the_Node.add (the_Child => to_Node (the_Child, Parent => the_Node)); -- Recurse.
elsif the_Child.Name = "instance_controller"
then
declare
the_skeleton_Child : constant access xml.Element := the_Child.Child ("skeleton");
begin
the_Document.Libraries.visual_Scenes.skeletal_Root := +the_skeleton_Child.Data (2 .. the_skeleton_Child.Data'Last);
end;
elsif the_Child.Name = "instance_geometry"
then
ada.Text_IO.put_Line ("TODO: Handle instance_geometry.");
else
ada.Text_IO.put_Line ("TODO: Unhandled collada 'visual scene element' found: " & the_Child.Name & ".");
end if;
end loop;
end;
return the_Node;
end to_Node;
begin
the_visual_Scene.root_Node := to_Node (the_xml_root_Node, Parent => null);
end parse_Nodes;
end;
end loop;
end;
end if;
end;
-- Parse the animations library.
--
declare
the_Library : constant access xml.Element := the_collada_Tree.Child (named => "library_animations");
begin
if the_Library /= null
then
declare
use collada.Library.animations;
the_Animations : constant xml.Elements := the_Library.Children (named => "animation");
begin
the_document.Libraries.animations.Contents := new Animation_array (the_Animations'Range);
for Each in the_Animations'Range
loop
declare
the_Animation : Animation renames the_document.Libraries.animations.Contents (Each);
child_Animation : constant access xml.Element := the_Animations (Each).Child ("animation");
the_xml_Animation : constant access xml.Element := (if child_Animation = null then the_Animations (Each) else child_Animation);
-- the_xml_Animation : access xml.Element renames the_Animations (Each); --.Child ("animation");
the_xml_Id : constant access xml.Attribute_t'Class := the_xml_Animation.Attribute ("id");
the_xml_Name : constant access xml.Attribute_t'Class := the_xml_Animation.Attribute ("name");
begin
the_Animation.Id := +the_xml_Id.Value;
if the_xml_Name /= null
then
the_Animation.Name := +the_xml_Name.Value;
end if;
the_Animation.Sampler := to_Sampler (the_xml_Animation.Child ("sampler").all);
the_Animation.Channel := to_Channel (the_xml_Animation.Child ("channel").all);
parse_Sources:
declare
the_xml_Sources : constant xml.Elements := the_xml_Animation.Children ("source");
begin
the_Animation.Sources := new library.Sources (the_xml_Sources'Range);
for i in the_xml_Sources'Range
loop
the_Animation.Sources (i) := to_Source (the_xml_Sources (i).all);
end loop;
end parse_Sources;
end;
end loop;
end;
end if;
end;
--- Parse the 'scene' element.
--
-- TODO
return the_Document;
end to_Document;
function Asset (Self : in Item) return collada.Asset.item
is
begin
return Self.Asset;
end Asset;
function Libraries (Self : in Item) return collada.Libraries.item
is
begin
return Self.Libraries;
end Libraries;
end collada.Document;

28
2-low/collada/source/collada-document.ads Normal file
View File

@@ -0,0 +1,28 @@
with
collada.Asset,
collada.Libraries;
package collada.Document
--
-- Models a colada document.
--
is
type Item is tagged private;
function to_Document (Filename : in String) return Item;
function Asset (Self : in Item) return collada.Asset .item;
function Libraries (Self : in Item) return collada.Libraries.item;
private
type Item is tagged
record
Asset : collada.Asset .item;
Libraries : collada.Libraries.item;
end record;
end collada.Document;

21
2-low/collada/source/collada-libraries.ads Normal file
View File

@@ -0,0 +1,21 @@
with
collada.Library.geometries,
collada.Library.controllers,
collada.Library.animations,
collada.Library.visual_scenes;
package collada.Libraries
--
-- Provides a container for the specific collada library packages.
--
is
type Item is
record
Geometries : collada.Library.geometries .item;
Controllers : collada.Library.controllers .item;
visual_Scenes : collada.Library.visual_scenes.item;
Animations : collada.Library.animations .item;
end record;
end collada.Libraries;

78
2-low/collada/source/collada-library-animations.adb Normal file
View File

@@ -0,0 +1,78 @@
package body collada.Library.animations
is
-----------
--- Utility
--
function "+" (From : in ada.Strings.unbounded.unbounded_String) return String
renames ada.Strings.unbounded.to_String;
-------------
--- Animation
--
function Source_of (Self : in Animation;
source_Name : in String) return Source
is
use ada.Strings.unbounded;
begin
for i in Self.Sources'Range
loop
if Self.Sources (i).Id = source_Name (source_Name'First+1 .. source_Name'Last)
then
return Self.Sources (i);
end if;
end loop;
declare
null_Source : Source;
begin
return null_Source;
end;
end Source_of;
function find_Inputs_of (Self : in Animation; for_Semantic : in Semantic) return access float_Array
is
the_Input : constant Input_t := find_in (Self.Sampler.Inputs.all, for_Semantic);
begin
if the_Input = null_Input
then
return null;
end if;
declare
the_Source : constant Source := Source_of (Self, +the_Input.Source);
begin
return the_Source.Floats;
end;
end find_Inputs_of;
function Inputs_of (Self : in Animation) return access float_Array
is
begin
return find_Inputs_of (Self, for_Semantic => Input);
end Inputs_of;
function Outputs_of (Self : in Animation) return access float_Array
is
begin
return find_Inputs_of (Self, for_Semantic => Output);
end Outputs_of;
function Interpolations_of (Self : in Animation) return access float_Array
is
begin
return find_Inputs_of (Self, for_Semantic => Interpolation);
end Interpolations_of;
end collada.Library.animations;

65
2-low/collada/source/collada-library-animations.ads Normal file
View File

@@ -0,0 +1,65 @@
package collada.Library.animations
--
-- Models a collada 'animations' library, which is a collection of animations.
--
is
type Inputs_view is access all Library.Inputs;
type int_Array_view is access all int_Array;
-----------
--- Sampler
--
type Sampler is
record
Id : Text;
Inputs : Inputs_view;
end record;
-----------
--- Channel
--
type Channel is
record
Source : Text;
Target : Text;
end record;
--------------
--- Animation
--
type Animation is
record
Id : Text;
Name : Text;
Sources : library.Sources_view;
Sampler : animations.Sampler;
Channel : animations.Channel;
end record;
type Animation_array is array (Positive range <>) of Animation;
type Animation_array_view is access Animation_array;
function Inputs_of (Self : in Animation) return access float_Array;
function Outputs_of (Self : in Animation) return access float_Array;
function Interpolations_of (Self : in Animation) return access float_Array;
----------------
--- Library Item
--
type Item is
record
Contents : Animation_array_view;
end record;
end collada.Library.animations;

144
2-low/collada/source/collada-library-controllers.adb Normal file
View File

@@ -0,0 +1,144 @@
package body collada.Library.controllers
is
-----------
--- Utility
--
function "+" (From : in ada.Strings.unbounded.unbounded_String) return String
renames ada.Strings.unbounded.to_String;
------------------
--- vertex weights
--
function joint_Offset_of (Self : in vertex_Weights) return math.Index
is
the_Input : constant Input_t := find_in (Self.Inputs.all, Joint);
begin
return math.Index (the_Input.Offset);
end joint_Offset_of;
function weight_Offset_of (Self : in vertex_Weights) return math.Index
is
the_Input : constant Input_t := find_in (Self.Inputs.all, Weight);
begin
return math.Index (the_Input.Offset);
end weight_Offset_of;
--------
--- Skin
--
function Source_of (Self : in Skin; source_Name : in String) return Source
is
use ada.Strings.unbounded;
begin
for i in Self.Sources'Range
loop
if Self.Sources (i).Id = source_Name (source_Name'First+1 .. source_Name'Last)
then
return Self.Sources (i);
end if;
end loop;
declare
null_Source : Source;
begin
return null_Source;
end;
end Source_of;
function Weights_of (Self : in Skin) return access float_Array
is
the_Input : constant Input_t := find_in (Self.vertex_weights.Inputs.all, Weight);
begin
if the_Input = null_Input
then
return null;
end if;
declare
the_Source : constant Source := Source_of (Self, +the_Input.Source);
begin
return the_Source.Floats;
end;
end Weights_of;
function raw_bind_Poses_of (Self : in Skin) return access float_Array
is
the_Input : constant Input_t := find_in (Self.joints.Inputs.all, inv_bind_Matrix);
begin
if the_Input = null_Input
then
return null;
end if;
declare
the_Source : constant Source := Source_of (Self, +the_Input.Source);
begin
return the_Source.Floats;
end;
end raw_bind_Poses_of;
function bind_shape_Matrix_of (Self : in Skin) return Matrix_4x4
is
Raw : constant float_Array := Self.bind_shape_Matrix;
First : constant math.Index := 1;
the_Matrix : Matrix_4x4;
begin
the_Matrix := [1 => [Raw (First), Raw (First+1), Raw (First+2), Raw (First+3)], -- These are column vectors.
2 => [Raw (First+4), Raw (First+5), Raw (First+6), Raw (First+7)],
3 => [Raw (First+8), Raw (First+9), Raw (First+10), Raw (First+11)],
4 => [Raw (First+12), Raw (First+13), Raw (First+14), Raw (First+15)]];
return the_Matrix;
end bind_shape_Matrix_of;
function bind_Poses_of (Self : in Skin) return Matrix_4x4_array
is
Raw : constant access float_Array := raw_bind_Poses_of (Self);
the_Poses : Matrix_4x4_array (1 .. Raw'Length / 16);
First : math.Index := 1;
begin
for i in the_Poses'Range
loop
the_Poses (i) := [1 => [Raw (First), Raw (First+1), Raw (First+2), Raw (First+3)], -- These are column vectors.
2 => [Raw (First+4), Raw (First+5), Raw (First+6), Raw (First+7)],
3 => [Raw (First+8), Raw (First+9), Raw (First+10), Raw (First+11)],
4 => [Raw (First+12), Raw (First+13), Raw (First+14), Raw (First+15)]];
First := First + 16;
end loop;
return the_Poses;
end bind_Poses_of;
function joint_Names_of (Self : in Skin) return Text_array
is
the_Input : constant Input_t := find_in (Self.Joints.Inputs.all, Joint);
begin
declare
the_Source : constant Source := Source_of (Self, +the_Input.Source);
begin
return the_Source.Texts.all;
end;
end joint_Names_of;
end collada.Library.controllers;

81
2-low/collada/source/collada-library-controllers.ads Normal file
View File

@@ -0,0 +1,81 @@
package collada.Library.controllers
--
-- Models a collada 'controllers' library, which is a collection of controllers.
--
is
type Inputs_view is access all Library.Inputs;
type int_Array_view is access all int_Array;
----------
--- Joints
--
type Joints is
record
Inputs : Inputs_view;
end record;
------------------
--- vertex_Weights
--
type vertex_Weights is
record
Count : Natural;
Inputs : Inputs_view;
v_Count : int_Array_view;
v : int_Array_view;
end record;
function joint_Offset_of (Self : in vertex_Weights) return math.Index;
function weight_Offset_of (Self : in vertex_Weights) return math.Index;
--------
--- Skin
--
type Skin is
record
main_Source : Text;
bind_shape_Matrix : float_Array (1 .. 16);
Sources : library.Sources_view;
Joints : controllers.Joints;
vertex_weights : controllers.vertex_Weights;
end record;
function Weights_of (Self : in Skin) return access float_Array;
function bind_shape_Matrix_of (Self : in Skin) return Matrix_4x4;
function bind_Poses_of (Self : in Skin) return Matrix_4x4_array;
function joint_Names_of (Self : in Skin) return Text_array;
--------------
--- Controller
--
type Controller is
record
Name : Text;
Id : Text;
Skin : controllers.Skin;
end record;
type Controller_array is array (Positive range <>) of Controller;
type Controller_array_view is access Controller_array;
----------------
--- Library Item
--
type Item is
record
Contents : Controller_array_view;
end record;
end collada.Library.controllers;

131
2-low/collada/source/collada-library-geometries.adb Normal file
View File

@@ -0,0 +1,131 @@
package body collada.Library.geometries
is
-----------
--- Utility
--
function "+" (From : in ada.Strings.unbounded.unbounded_String) return String
renames ada.Strings.unbounded.to_String;
-------------
--- Primitive
--
function vertex_Offset_of (Self : in Primitive) return math.Index
is
the_Input : constant Input_t := find_in (Self.Inputs.all, Vertex);
begin
return math.Index (the_Input.Offset);
end vertex_Offset_of;
function normal_Offset_of (Self : in Primitive) return math.Index
is
the_Input : constant Input_t := find_in (Self.Inputs.all, Normal);
begin
return math.Index (the_Input.Offset);
end normal_Offset_of;
function coord_Offset_of (Self : in Primitive) return math.Index
is
the_Input : constant Input_t := find_in (Self.Inputs.all, TexCoord);
begin
if the_Input = null_Input
then
raise no_coord_Offset;
end if;
return math.Index (the_Input.Offset);
end coord_Offset_of;
--------
--- Mesh
--
function Source_of (Self : in Mesh;
source_Name : in String) return Source
is
use ada.Strings.unbounded;
begin
for i in Self.Sources'Range
loop
if Self.Sources (i).Id = source_Name (source_Name'First+1 .. source_Name'Last)
then
return Self.Sources (i);
end if;
end loop;
declare
null_Source : Source;
begin
return null_Source;
end;
end Source_of;
function Positions_of (Self : in Mesh) return access float_Array
is
the_Input : constant Input_t := find_in (Self.Vertices.Inputs.all, Position);
begin
if the_Input = null_Input
then
return null;
end if;
declare
the_Source : constant Source := Source_of (Self, +the_Input.Source);
begin
return the_Source.Floats;
end;
end Positions_of;
function Normals_of (Self : in Mesh;
for_Primitive : in Primitive) return access float_Array
is
the_Primitive : Primitive renames for_Primitive;
the_Input : constant Input_t := find_in (the_Primitive.Inputs.all, Normal);
begin
if the_Input = null_Input then
return null;
end if;
declare
the_Source : constant Source := Source_of (Self, +the_Input.Source);
begin
return the_Source.Floats;
end;
end Normals_of;
function Coords_of (Self : in Mesh;
for_Primitive : in Primitive) return access float_Array
is
the_Primitive : Primitive renames for_Primitive;
the_Input : constant Input_t := find_in (the_Primitive.Inputs.all, TexCoord);
begin
if the_Input = null_Input
then
return null;
end if;
declare
the_Source : constant Source := Source_of (Self, +the_Input.Source);
begin
return the_Source.Floats;
end;
end Coords_of;
end collada.Library.geometries;

108
2-low/collada/source/collada-library-geometries.ads Normal file
View File

@@ -0,0 +1,108 @@
package collada.Library.geometries
--
-- Models a collada 'geometries' library, which is a collection of geometries.
--
is
type Inputs_view is access library.Inputs;
type Int_array_view is access Int_array;
type Int_array_List is array (Positive range <>) of Int_array_view;
type Int_array_List_view is access int_array_List;
------------
--- Vertices
--
type Vertices is
record
Id : Text;
Inputs : Inputs_view;
end record;
--------------
--- Primitives
--
type primitive_Kind is (Unknown,
Lines, line_Strips,
Polygons, polyList,
Triangles, triFans, triStrips);
type Primitive (Kind : primitive_Kind := Unknown) is
record
Count : Natural;
Material : Text;
Inputs : Inputs_view;
P_List : int_array_List_view;
case Kind is
when polyList =>
vCount : Int_array_view;
when others =>
null;
end case;
end record;
type Primitives is array (Positive range <>) of Primitive;
type Primitives_view is access Primitives;
function vertex_Offset_of (Self : in Primitive) return math.Index;
function normal_Offset_of (Self : in Primitive) return math.Index;
function coord_Offset_of (Self : in Primitive) return math.Index;
no_coord_Offset : exception;
--------
--- Mesh
--
type Mesh is
record
Sources : library.Sources_view;
Vertices : geometries.Vertices;
Primitives : geometries.Primitives_view;
end record;
function Source_of (Self : in Mesh;
source_Name : in String) return Source;
function Positions_of (Self : in Mesh) return access float_Array;
function Normals_of (Self : in Mesh;
for_Primitive : in Primitive) return access float_Array;
function Coords_of (Self : in Mesh;
for_Primitive : in Primitive) return access float_Array;
------------
--- Geometry
--
type Geometry is
record
Name : Text;
Id : Text;
Mesh : geometries.Mesh;
end record;
type Geometry_array is array (Positive range <>) of Geometry;
type Geometry_array_view is access Geometry_array;
----------------
--- Library Item
--
type Item is
record
Contents : Geometry_array_view;
end record;
end collada.Library.geometries;

494
2-low/collada/source/collada-library-visual_scenes.adb Normal file
View File

@@ -0,0 +1,494 @@
with
float_Math.Algebra.linear.D3,
ada.unchecked_Deallocation;
package body collada.Library.visual_scenes
is
-------------
--- Transform
--
function to_Matrix (Self : in Transform) return collada.Matrix_4x4
is
use Math,
math.Algebra.linear,
math.Algebra.linear.D3;
begin
case Self.Kind
is
when Translate =>
return Transpose (to_translate_Matrix (Self.Vector)); -- Transpose converts from math Row vectors to collada Col vectors.
when Rotate =>
declare
the_Rotation : constant Matrix_3x3 := Transpose (to_Rotation (Self.Axis (1), -- Transpose converts from math Row vectors to collada Col vectors.
Self.Axis (2),
Self.Axis (3),
Self.Angle));
begin
return to_rotate_Matrix (the_Rotation);
end;
when Scale =>
return to_scale_Matrix (Self.Scale);
when full_Transform =>
return Self.Matrix;
end case;
end to_Matrix;
--------
--- Node
--
function Sid (Self : in Node) return Text
is
begin
return Self.Sid;
end Sid;
function Id (Self : in Node) return Text
is
begin
return Self.Id;
end Id;
function Name (Self : in Node) return Text
is
begin
return Self.Name;
end Name;
--------------
--- Transforms
--
function Transforms (Self : in Node) return Transform_array
is
begin
return Self.Transforms.all;
end Transforms;
function fetch_Transform (Self : access Node; transform_Sid : in String) return access Transform
is
use type ada.Strings.unbounded.unbounded_String;
begin
for i in Self.Transforms'Range
loop
if Self.Transforms (i).Sid = transform_Sid
then
return Self.Transforms (i)'Access;
end if;
end loop;
return null;
end fetch_Transform;
procedure add (Self : in out Node; the_Transform : in Transform)
is
Old : Transform_array_view := Self.Transforms;
procedure deallocate is new ada.unchecked_Deallocation (Transform_array, Transform_array_view);
begin
if Old = null
then Self.Transforms := new Transform_array' (1 => the_Transform);
else Self.Transforms := new Transform_array' (Old.all & the_Transform);
deallocate (Old);
end if;
end add;
function local_Transform (Self : in Node) return Matrix_4x4
is
begin
if Self.Transforms = null
then
return Identity_4x4;
end if;
declare
use Math;
all_Transforms : Transform_array renames Self.Transforms.all;
the_Result : Matrix_4x4 := math.Identity_4x4;
begin
for i in all_Transforms'Range
loop
the_Result := the_Result * to_Matrix (all_Transforms (i));
end loop;
return the_Result;
end;
end local_Transform;
function global_Transform (Self : in Node) return Matrix_4x4
is
use Math;
begin
if Self.Parent = null
then
return Self.local_Transform;
else
return Self.Parent.global_Transform * Self.local_Transform; -- Recurse.
end if;
end global_Transform;
function find_Transform (Self : in Node; of_Kind : in transform_Kind;
Sid : in String) return Positive
is
use type Text;
begin
for i in Self.Transforms'Range
loop
if Self.Transforms (i).Kind = of_Kind
and then Self.Transforms (i).Sid = Sid
then
return i;
end if;
end loop;
raise Transform_not_found with "No " & transform_Kind'Image (of_Kind) & " transform found with sid: " & Sid & ".";
end find_Transform;
function fetch_Transform (Self : in Node; of_Kind : in transform_Kind;
Sid : in String) return Transform
is
begin
return Self.Transforms (find_Transform (Self, of_Kind, Sid));
end fetch_Transform;
function find_Transform (Self : in Node; of_Kind : in transform_Kind) return Positive
is
begin
for i in Self.Transforms'Range
loop
if Self.Transforms (i).Kind = of_Kind
then
return i;
end if;
end loop;
raise Transform_not_found with "No " & of_Kind'Image & " transform found";
end find_Transform;
function fetch_Transform (Self : in Node; of_Kind : in transform_Kind) return Transform
is
begin
return Self.Transforms (find_Transform (Self, of_Kind));
end fetch_Transform;
function full_Transform (Self : in Node) return Matrix_4x4
is
the_Transform : constant Transform := fetch_Transform (Self, full_Transform);
begin
return the_Transform.Matrix;
end full_Transform;
function Translation (Self : in Node) return Vector_3
is
the_Translation : constant Transform := fetch_Transform (Self, Translate);
begin
return the_Translation.Vector;
end Translation;
function Rotate_Z (Self : in Node) return Vector_4
is
use Math;
the_Rotation : Transform;
begin
the_Rotation := fetch_Transform (Self, Rotate, "rotationZ");
return Vector_4 (the_Rotation.Axis & the_Rotation.Angle);
exception
when Transform_not_found =>
the_Rotation := fetch_Transform (Self, Rotate, "rotateZ");
return Vector_4 (the_Rotation.Axis & the_Rotation.Angle);
end Rotate_Z;
procedure set_Location (Self : in out Node; To : in math.Vector_3)
is
Id : constant Positive := find_Transform (Self, Translate, "location");
begin
Self.Transforms (Id).Vector := To;
end set_Location;
procedure set_Location_x (Self : in out Node; To : in math.Real)
is
Id : constant Positive := find_Transform (Self, Translate, "location");
begin
Self.Transforms (Id).Vector (1) := To;
end set_Location_x;
procedure set_Location_y (Self : in out Node; To : in math.Real)
is
Id : constant Positive := find_Transform (Self, Translate, "location");
begin
Self.Transforms (Id).Vector (2) := To;
end set_Location_y;
procedure set_Location_z (Self : in out Node; To : in math.Real)
is
Id : constant Positive := find_Transform (Self, Translate, "location");
begin
Self.Transforms (Id).Vector (3) := To;
end set_Location_z;
procedure set_Transform (Self : in out Node; To : in math.Matrix_4x4)
is
Id : constant Positive := find_Transform (Self, full_Transform, "transform");
begin
Self.Transforms (Id).Matrix := To;
end set_Transform;
procedure set_x_rotation_Angle (Self : in out Node; To : in math.Real)
is
Id : Positive;
begin
Id := find_Transform (Self, Rotate, "rotationX");
Self.Transforms (Id).Angle := To;
exception
when Transform_not_found =>
Id := find_Transform (Self, Rotate, "rotateX");
Self.Transforms (Id).Angle := To;
end set_x_rotation_Angle;
procedure set_y_rotation_Angle (Self : in out Node; To : in math.Real)
is
Id : Positive;
begin
Id := find_Transform (Self, Rotate, "rotationY");
Self.Transforms (Id).Angle := To;
exception
when Transform_not_found =>
Id := find_Transform (Self, Rotate, "rotateY");
Self.Transforms (Id).Angle := To;
end set_y_rotation_Angle;
procedure set_z_rotation_Angle (Self : in out Node; To : in math.Real)
is
Id : Positive;
begin
Id := find_Transform (Self, Rotate, "rotationZ");
Self.Transforms (Id).Angle := To;
exception
when Transform_not_found =>
Id := find_Transform (Self, Rotate, "rotateZ");
Self.Transforms (Id).Angle := To;
end set_z_rotation_Angle;
function Rotate_Y (Self : in Node) return Vector_4
is
use Math;
the_Rotation : Transform;
begin
the_Rotation := fetch_Transform (Self, Rotate, "rotationY");
return Vector_4 (the_Rotation.Axis & the_Rotation.Angle);
exception
when Transform_not_found =>
the_Rotation := fetch_Transform (Self, Rotate, "rotateY");
return Vector_4 (the_Rotation.Axis & the_Rotation.Angle);
end Rotate_Y;
function Rotate_X (Self : in Node) return Vector_4
is
use Math;
the_Rotation : Transform;
begin
the_Rotation := fetch_Transform (Self, Rotate, "rotationX");
return Vector_4 (the_Rotation.Axis & the_Rotation.Angle);
exception
when Transform_not_found =>
the_Rotation := fetch_Transform (Self, Rotate, "rotateX");
return Vector_4 (the_Rotation.Axis & the_Rotation.Angle);
end Rotate_X;
function Scale (Self : in Node) return Vector_3
is
the_Translation : constant Transform := fetch_Transform (Self, Scale, "scale");
begin
return the_Translation.Scale;
end Scale;
procedure Sid_is (Self : in out Node; Now : in Text)
is
begin
Self.Sid := Now;
end Sid_is;
procedure Id_is (Self : in out Node; Now : in Text)
is
begin
Self.Id := Now;
end Id_is;
procedure Name_is (Self : in out Node; Now : in Text)
is
begin
Self.Name := Now;
end Name_is;
------------
--- Hierachy
--
function Parent (Self : in Node) return Node_view
is
begin
return Self.Parent;
end Parent;
procedure Parent_is (Self : in out Node; Now : Node_view)
is
begin
Self.Parent := Now;
end Parent_is;
function Children (Self : in Node) return Nodes
is
begin
if Self.Children = null
then
return Nodes' (1 .. 0 => <>); -- No Nodes.
end if;
return Self.Children.all;
end Children;
function Child (Self : in Node; Which : in Positive) return Node_view
is
begin
if Self.Children = null
then
raise constraint_Error with "No children found.";
end if;
return Self.Children (Which);
end Child;
function Child (Self : in Node; Named : in String) return Node_view
is
use ada.Strings.unbounded;
begin
if Self.Children = null
then
raise constraint_Error with "Child not found.";
end if;
declare
the_Children : constant Nodes_view := Self.Children;
begin
for i in the_Children'Range
loop
if the_Children (i).Name = Named
then
return the_Children (i);
else
begin
return the_Children (i).Child (named => Named);
exception
when constraint_Error => null;
end;
end if;
end loop;
end;
raise constraint_Error with "Child not found.";
end Child;
procedure add (Self : in out Node; the_Child : in Node_view)
is
begin
if Self.Children = null
then
Self.Children := new Nodes' (1 => the_Child);
else
declare
old_Children : Nodes_view := Self.Children;
procedure deallocate is new ada.Unchecked_Deallocation (Nodes, Nodes_view);
begin
Self.Children := new Nodes' (old_Children.all & the_Child);
deallocate (old_Children);
end;
end if;
end add;
end collada.Library.visual_scenes;

141
2-low/collada/source/collada-library-visual_scenes.ads Normal file
View File

@@ -0,0 +1,141 @@
package collada.Library.visual_scenes
--
-- Models a collada 'visual_scenes' library, which contains node/joint hierachy info.
--
is
------------
-- Transform
--
type transform_Kind is (Translate, Rotate, Scale, full_Transform);
type Transform (Kind : transform_Kind := transform_Kind'First) is
record
Sid : Text;
case Kind is
when Translate =>
Vector : Vector_3;
when Rotate =>
Axis : Vector_3;
Angle : math.Real;
when Scale =>
Scale : Vector_3;
when full_Transform =>
Matrix : Matrix_4x4;
end case;
end record;
type Transform_array is array (Positive range <>) of aliased Transform;
function to_Matrix (Self : in Transform) return collada.Matrix_4x4;
--------
--- Node
--
type Node is tagged private;
type Node_view is access all Node;
type Nodes is array (Positive range <>) of Node_view;
function Sid (Self : in Node) return Text;
function Id (Self : in Node) return Text;
function Name (Self : in Node) return Text;
procedure Sid_is (Self : in out Node; Now : in Text);
procedure Id_is (Self : in out Node; Now : in Text);
procedure Name_is (Self : in out Node; Now : in Text);
procedure add (Self : in out Node; the_Transform : in Transform);
function Transforms (Self : in Node) return Transform_array;
function fetch_Transform (Self : access Node; transform_Sid : in String) return access Transform;
function local_Transform (Self : in Node) return Matrix_4x4;
--
-- Returns the result of combining all 'Transforms'.
function global_Transform (Self : in Node) return Matrix_4x4;
--
-- Returns the result of combining 'local_Transform' with each ancestors 'local_Transform'.
function full_Transform (Self : in Node) return Matrix_4x4;
function Translation (Self : in Node) return Vector_3;
function Rotate_Z (Self : in Node) return Vector_4;
function Rotate_Y (Self : in Node) return Vector_4;
function Rotate_X (Self : in Node) return Vector_4;
function Scale (Self : in Node) return Vector_3;
procedure set_x_rotation_Angle (Self : in out Node; To : in math.Real);
procedure set_y_rotation_Angle (Self : in out Node; To : in math.Real);
procedure set_z_rotation_Angle (Self : in out Node; To : in math.Real);
procedure set_Location (Self : in out Node; To : in math.Vector_3);
procedure set_Location_x (Self : in out Node; To : in math.Real);
procedure set_Location_y (Self : in out Node; To : in math.Real);
procedure set_Location_z (Self : in out Node; To : in math.Real);
procedure set_Transform (Self : in out Node; To : in math.Matrix_4x4);
function Parent (Self : in Node) return Node_view;
procedure Parent_is (Self : in out Node; Now : Node_view);
function Children (Self : in Node) return Nodes;
function Child (Self : in Node; Which : in Positive) return Node_view;
function Child (Self : in Node; Named : in String ) return Node_view;
procedure add (Self : in out Node; the_Child : in Node_view);
Transform_not_found : exception;
----------------
--- visual_Scene
--
type visual_Scene is
record
Id : Text;
Name : Text;
root_Node : Node_view;
end record;
type visual_Scene_array is array (Positive range <>) of visual_Scene;
type visual_Scene_array_view is access visual_Scene_array;
----------------
--- Library Item
--
type Item is
record
Contents : visual_Scene_array_view;
skeletal_Root : Text;
end record;
private
type Transform_array_view is access all Transform_array;
type Nodes_view is access all Nodes;
type Node is tagged
record
Sid : Text;
Id : Text;
Name : Text;
Transforms : Transform_array_view;
Parent : Node_view;
Children : Nodes_view;
end record;
end collada.Library.visual_scenes;

19
2-low/collada/source/collada-library.adb Normal file
View File

@@ -0,0 +1,19 @@
package body collada.Library
is
function find_in (Self : Inputs; the_Semantic : in library.Semantic) return Input_t
is
begin
for i in Self'Range
loop
if Self (i).Semantic = the_Semantic
then
return Self (i);
end if;
end loop;
return null_Input;
end find_in;
end collada.Library;

75
2-low/collada/source/collada-library.ads Normal file
View File

@@ -0,0 +1,75 @@
package collada.Library
--
-- Provides a namespace and core types for the specific collada library child packages.
--
is
type Float_array_view is access Float_array;
type Text_array_view is access Text_array;
----------
-- Sources
--
type Source is
record
Id : Text;
array_Id : Text;
Floats : Float_array_view;
Texts : Text_array_view;
end record;
type Sources is array (Positive range <>) of Source;
type Sources_view is access Sources;
----------
--- Inputs
--
type Semantic is (Unknown,
BINORMAL, -- Geometric binormal (bitangent) vector.
COLOR, -- Color coordinate vector. Color inputs are RGB (float3_type).
CONTINUITY, -- Continuity constraint at the control vertex (CV).
IMAGE, -- Raster or MIP-level input.
INPUT, -- Sampler input.
IN_TANGENT, -- Tangent vector for preceding control point.
INTERPOLATION, -- Sampler interpolation type.
INV_BIND_MATRIX, -- Inverse of local-to-world matrix.
JOINT, -- Skin influence identifier.
LINEAR_STEPS, -- Number of piece-wise linear approximation steps to use for the spline segment that follows this CV.
MORPH_TARGET, -- Morph targets for mesh morphing.
MORPH_WEIGHT, -- Weights for mesh morphing.
NORMAL, -- Normal vector.
OUTPUT, -- Sampler output.
OUT_TANGENT, -- Tangent vector for succeeding control point.
POSITION, -- Geometric coordinate vector.
TANGENT, -- Geometric tangent vector.
TEXBINORMAL, -- Texture binormal (bitangent) vector.
TEXCOORD, -- Texture coordinate vector.
TEXTANGENT, -- Texture tangent vector.
UV, -- Generic parameter vector.
VERTEX, -- Mesh vertex.
WEIGHT); -- Skin influence weighting value.
type Input_t is
record
Semantic : library.Semantic := Unknown;
Source : Text;
Offset : Natural := 0;
end record;
type Inputs is array (Positive range <>) of Input_t;
null_Input : constant Input_t;
function find_in (Self : Inputs; the_Semantic : in library.Semantic) return Input_t;
private
null_Input : constant Input_t := (others => <>);
end collada.Library;

20
2-low/collada/source/collada.adb Normal file
View File

@@ -0,0 +1,20 @@
package body Collada
is
function get_Matrix (From : in Float_array; Which : in Positive) return Matrix_4x4
is
First : constant Positive := (Which - 1) * 16 + 1;
the_Vector : constant math.Vector_16 := math.Vector_16 (From (First .. First + 15));
begin
return math.to_Matrix_4x4 (the_Vector);
end get_Matrix;
function matrix_Count (From : in Float_array) return Natural
is
begin
return From'Length / 16;
end matrix_Count;
end Collada;

64
2-low/collada/source/collada.ads Normal file
View File

@@ -0,0 +1,64 @@
with
float_Math,
ada.Strings.unbounded;
package Collada
--
-- Provides a namespace and core types for the Collada package family.
--
is
-------
-- Text
--
subtype Text is ada.Strings.unbounded.unbounded_String;
function to_Text (From : in String) return Text
renames ada.Strings.unbounded.To_unbounded_String;
function to_String (From : in Text) return String
renames ada.Strings.unbounded.To_String;
type Text_array is array (Positive range <>) of Text;
-------
-- Math
--
-- Collada matrices use column vectors, so the translation vector is the 4th column.
package Math renames float_Math;
subtype Float_array is math.Vector;
subtype Int_array is math.Integers;
subtype Vector_3 is math.Vector_3;
subtype Vector_4 is math.Vector_4;
subtype Matrix_3x3 is math.Matrix_3x3;
subtype Matrix_4x4 is math.Matrix_4x4;
type Matrix_4x4_array is array (Positive range <>) of Matrix_4x4;
Identity_4x4 : constant math.Matrix_4x4;
function matrix_Count (From : in Float_array) return Natural;
function get_Matrix (From : in Float_array; Which : in Positive) return Matrix_4x4;
Error : exception;
private
Identity_4x4 : constant math.Matrix_4x4 := [[1.0, 0.0, 0.0, 0.0],
[0.0, 1.0, 0.0, 0.0],
[0.0, 0.0, 1.0, 0.0],
[0.0, 0.0, 0.0, 1.0]];
end Collada;