New struct types ai-matrix3x3 and ai-matrix4x4

[guile-assimp.git] / src / assimp.scm

diff --git a/src/assimp.scm b/src/assimp.scm
index 9f6bfc2a3959bdee06358a4175b0374aa866305b..9954e8212bcb47cab6f070bc22e4f80654e091bb 100644 (file)
--- a/src/assimp.scm
+++ b/src/assimp.scm
@@ -17,116 +17,272 @@
 
 (define-module (assimp assimp)
   #:use-module (assimp low-level)
 
 (define-module (assimp assimp)
   #:use-module (assimp low-level)

+  #:use-module (assimp low-level cimport)
+  #:use-module (assimp low-level color)

   #:use-module (assimp low-level material)
   #:use-module (assimp low-level material)

+  #:use-module (assimp low-level matrix)

   #:use-module (assimp low-level mesh)
   #:use-module (assimp low-level scene)
   #:use-module (assimp low-level mesh)
   #:use-module (assimp low-level scene)

+  #:use-module (assimp low-level types)
+  #:use-module (assimp low-level vector)

   #:use-module (system foreign))
 
   #:use-module (system foreign))
 

-(define libassimp (dynamic-link "libassimp"))
-
-(define aiImportFile
-  (pointer->procedure '*
-                     (dynamic-func "aiImportFile" libassimp)
-                     (list '* unsigned-int)))
-

 
 ;;; Scenes
 
 
 ;;; Scenes
 

-(define-conversion-type parse-aiScene -> scene
+(define-conversion-type parse-aiScene -> ai-scene

   (flags (field 'mFlags))
   (flags (field 'mFlags))

-  (root-node (wrap (field 'mRootNode) wrap-node))
-  (meshes (wrap (array (field 'mNumMeshes) (field 'mMeshes)) wrap-mesh))
-  (materials (wrap (array (field 'mNumMaterials) (field 'mMaterials)) wrap-material))
+  (root-node (wrap (field 'mRootNode) wrap-ai-node))
+  (meshes (wrap (array (field 'mNumMeshes) (field 'mMeshes)) wrap-ai-mesh))
+  (materials (wrap (array (field 'mNumMaterials) (field 'mMaterials)) wrap-ai-material))

   (animations (array (field 'mNumAnimations) (field 'mAnimations)))
   (textures (array (field 'mNumTextures) (field 'mTextures)))
   (lights (array (field 'mNumLights) (field 'mLights)))
   (cameras (array (field 'mNumCameras) (field 'mCameras))))
 
   (animations (array (field 'mNumAnimations) (field 'mAnimations)))
   (textures (array (field 'mNumTextures) (field 'mTextures)))
   (lights (array (field 'mNumLights) (field 'mLights)))
   (cameras (array (field 'mNumCameras) (field 'mCameras))))
 

-(define (load-scene filename flags)
-  (wrap-scene
-   (aiImportFile (string->pointer filename)
-                flags)))
-
-(export load-scene
-       scene?
-       scene-contents
-       scene-flags
-       scene-root-node
-       scene-meshes
-       scene-materials
-       scene-animations
-       scene-textures
-       scene-lights
-       scene-cameras)
+(export ai-scene?
+       ai-scene-contents
+       ai-scene-flags
+       ai-scene-root-node
+       ai-scene-meshes
+       ai-scene-materials
+       ai-scene-animations
+       ai-scene-textures
+       ai-scene-lights
+       ai-scene-cameras)

 
 
 ;;; Nodes
 
 
 
 ;;; Nodes
 

-(define-conversion-type parse-aiNode -> node
+(define-conversion-type parse-aiNode -> ai-node

   (name (sized-string (field 'mName)))
   (name (sized-string (field 'mName)))

-  (transformation (field 'mTransformation))
-  (parent (wrap (field 'mParent) wrap-node))
-  (children (wrap (array (field 'mNumChildren) (field 'mChildren)) wrap-node))
+  (transformation (wrap (parse-aiMatrix4x4 (field 'mTransformation) #:reverse #t) wrap-ai-matrix4x4))
+  (parent (wrap (field 'mParent) wrap-ai-node))
+  (children (wrap (array (field 'mNumChildren) (field 'mChildren)) wrap-ai-node))

   (meshes (array (field 'mNumMeshes) (field 'mMeshes))))
 
   (meshes (array (field 'mNumMeshes) (field 'mMeshes))))
 

-(export node?
-       node-contents
-       node-name
-       node-transformation
-       node-parent
-       node-children
-       node-meshes)
+(export ai-node?
+       ai-node-contents
+       ai-node-name
+       ai-node-transformation
+       ai-node-parent
+       ai-node-children
+       ai-node-meshes)

 
 
 ;;; Meshes
 
 
 
 ;;; Meshes
 

-(define-conversion-type parse-aiMesh -> mesh
+(define-conversion-type parse-aiMesh -> ai-mesh

   (name (sized-string (field 'mName)))
   (primitive-types (field 'mPrimitiveTypes))
   (name (sized-string (field 'mName)))
   (primitive-types (field 'mPrimitiveTypes))

-  (vertices (array (field 'mNumVertices) (field 'mVertices) #:element-proc get-element-address))
-  (faces (wrap (array (field 'mNumFaces) (field 'mFaces) #:element-size 8 #:element-proc get-element-address) wrap-face))
-  (normals (array (field 'mNumVertices) (field 'mNormals) #:element-size 12 #:element-proc get-element-address))
-  (tangents (array (field 'mNumVertices) (field 'mTangents) #:element-size 12 #:element-proc get-element-address))
-  (bitangents (array (field 'mNumVertices) (field 'mBitangents) #:element-size 12 #:element-proc get-element-address))
-  (colors (field 'mColors))
-  (texture-coords (field 'mTextureCoords))
+  (vertices (wrap
+            (array (field 'mNumVertices) (field 'mVertices) #:element-proc get-element-address)
+            wrap-ai-vector3d))
+  (faces (wrap
+         (array (field 'mNumFaces) (field 'mFaces) #:element-size 8 #:element-proc get-element-address)
+         wrap-ai-face))
+  (normals (wrap
+           (array (field 'mNumVertices) (field 'mNormals) #:element-size 12 #:element-proc get-element-address)
+           wrap-ai-vector3d))
+  (tangents (wrap
+            (array (field 'mNumVertices) (field 'mTangents) #:element-size 12 #:element-proc get-element-address)
+            wrap-ai-vector3d))
+  (bitangents (wrap
+              (array (field 'mNumVertices) (field 'mBitangents) #:element-size 12 #:element-proc get-element-address)
+              wrap-ai-vector3d))
+  (colors (map
+          (lambda (c)
+            (wrap
+             (array (field 'mNumVertices) c #:element-size 16 #:element-proc get-element-address)
+             wrap-ai-color4d))
+          (field 'mColors)))
+  (texture-coords (map
+                  (lambda (tc)
+                    (wrap
+                     (array (field 'mNumVertices) tc #:element-size 12 #:element-proc get-element-address)
+                     wrap-ai-vector3d))
+                  (field 'mTextureCoords)))

   (num-uv-components (field 'mNumUVComponents))
   (num-uv-components (field 'mNumUVComponents))

-  (bones (array (field 'mNumBones) (field 'mBones)))
+  (bones (wrap (array (field 'mNumBones) (field 'mBones)) wrap-ai-bone))

   (material-index (field 'mMaterialIndex)))
 
   (material-index (field 'mMaterialIndex)))
 

-(export mesh?
-       mesh-contents
-       mesh-name
-       mesh-primitive-types
-       mesh-vertices
-       mesh-faces
-       mesh-normals
-       mesh-tangents
-       mesh-bitangents
-       mesh-colors
-       mesh-texture-coords
-       mesh-num-uv-components
-       mesh-bones
-       mesh-material-index)
+(export ai-mesh?
+       ai-mesh-contents
+       ai-mesh-name
+       ai-mesh-primitive-types
+       ai-mesh-vertices
+       ai-mesh-faces
+       ai-mesh-normals
+       ai-mesh-tangents
+       ai-mesh-bitangents
+       ai-mesh-colors
+       ai-mesh-texture-coords
+       ai-mesh-num-uv-components
+       ai-mesh-bones
+       ai-mesh-material-index)

 
 
 ;;; Materials
 
 
 
 ;;; Materials
 

-(define-conversion-type parse-aiMaterial -> material
+(define-conversion-type parse-aiMaterial -> ai-material

   (properties (array (field 'mNumProperties) (field 'mProperties)))
   (num-allocated (field 'mNumAllocated)))
 
   (properties (array (field 'mNumProperties) (field 'mProperties)))
   (num-allocated (field 'mNumAllocated)))
 

-(export material?
-       material-contents
-       material-properties
-       material-num-allocated)
+(export ai-material?
+       ai-material-contents
+       ai-material-properties
+       ai-material-num-allocated)

 
 
 ;;; Faces
 
 
 
 ;;; Faces
 

-(define-conversion-type parse-aiFace -> face
+(define-conversion-type parse-aiFace -> ai-face

   (indices (array (field 'mNumIndices) (field 'mIndices))))
 
   (indices (array (field 'mNumIndices) (field 'mIndices))))
 

-(export face?
-       face-contents
-       face-indices)
+(export ai-face?
+       ai-face-contents
+       ai-face-indices)
+
+
+;;; Vectors
+
+(define-conversion-type parse-aiVector2D -> ai-vector2d
+  (x (field 'x))
+  (y (field 'y)))
+
+(export ai-vector2d?
+       ai-vector2d-contents
+       ai-vector2d-x
+       ai-vector2d-y)
+
+(define-conversion-type parse-aiVector3D -> ai-vector3d
+  (x (field 'x))
+  (y (field 'y))
+  (z (field 'z)))
+
+(export ai-vector3d?
+       ai-vector3d-contents
+       ai-vector3d-x
+       ai-vector3d-y
+       ai-vector3d-z)
+
+
+;;; Matrixes
+
+(define-conversion-type parse-aiMatrix3x3 -> ai-matrix3x3
+  (a1 (field 'a1))
+  (a2 (field 'a2))
+  (a3 (field 'a3))
+  (b1 (field 'b1))
+  (b2 (field 'b2))
+  (b3 (field 'b3))
+  (c1 (field 'c1))
+  (c2 (field 'c2))
+  (c3 (field 'c3)))
+
+(export ai-matrix3x3?
+       ai-matrix3x3-contents
+       ai-matrix3x3-a1
+       ai-matrix3x3-a2
+       ai-matrix3x3-a3
+       ai-matrix3x3-b1
+       ai-matrix3x3-b2
+       ai-matrix3x3-b3
+       ai-matrix3x3-c1
+       ai-matrix3x3-c2
+       ai-matrix3x3-c3)
+
+(define-conversion-type parse-aiMatrix4x4 -> ai-matrix4x4
+  (a1 (field 'a1))
+  (a2 (field 'a2))
+  (a3 (field 'a3))
+  (a4 (field 'a4))
+  (b1 (field 'b1))
+  (b2 (field 'b2))
+  (b3 (field 'b3))
+  (b4 (field 'b4))
+  (c1 (field 'c1))
+  (c2 (field 'c2))
+  (c3 (field 'c3))
+  (c4 (field 'c4))
+  (d1 (field 'd1))
+  (d2 (field 'd2))
+  (d3 (field 'd3))
+  (d4 (field 'd4)))
+
+(export ai-matrix4x4?
+       ai-matrix4x4-contents
+       ai-matrix4x4-a1
+       ai-matrix4x4-a2
+       ai-matrix4x4-a3
+       ai-matrix4x4-a4
+       ai-matrix4x4-b1
+       ai-matrix4x4-b2
+       ai-matrix4x4-b3
+       ai-matrix4x4-b4
+       ai-matrix4x4-c1
+       ai-matrix4x4-c2
+       ai-matrix4x4-c3
+       ai-matrix4x4-c4
+       ai-matrix4x4-d1
+       ai-matrix4x4-d2
+       ai-matrix4x4-d3
+       ai-matrix4x4-d4)
+
+
+;;; Colors
+
+(define-conversion-type parse-aiColor4D -> ai-color4d
+  (r (field 'r))
+  (g (field 'g))
+  (b (field 'b))
+  (a (field 'a)))
+
+(export ai-color4d?
+       ai-color4d-contents
+       ai-color4d-r
+       ai-color4d-g
+       ai-color4d-b
+       ai-color4d-a)
+
+
+;;; Bones
+
+(define-conversion-type parse-aiBone -> ai-bone
+  (name (sized-string (field 'mName)))
+  (weights (wrap
+           (array (field 'mNumWeights) (field 'mWeights) #:element-size 8 #:element-proc get-element-address)
+           wrap-ai-vertex-weight))
+  (offset-matrix (wrap (parse-aiMatrix4x4 (field 'mOffsetMatrix) #:reverse #t) wrap-ai-matrix4x4)))
+
+(export ai-bone?
+       ai-bone-contents
+       ai-bone-name
+       ai-bone-weights
+       ai-bone-offset-matrix)
+
+
+;;; Weights
+
+(define-conversion-type parse-aiVertexWeight -> ai-vertex-weight
+  (vertex-id (field 'mVertexId))
+  (weight (field 'mWeight)))
+
+(export ai-vertex-weight?
+       ai-vertex-weight-contents
+       ai-vertex-weight-vertex-id
+       ai-vertex-weight-weight)
+
+
+;;; Functions
+
+(define-public (ai-import-file filename flags)
+  (wrap-ai-scene
+   (aiImportFile (string->pointer filename)
+                flags)))
+
+(define-public (ai-multiply-matrix4 m1 m2)
+  (let ((cm1 (parse-aiMatrix4x4 (map cdr (ai-matrix4x4-contents m1)) #:reverse #t))
+       (cm2 (parse-aiMatrix4x4 (map cdr (ai-matrix4x4-contents m2)) #:reverse #t)))
+    (aiMultiplyMatrix4 cm1 cm2)
+    (wrap-ai-matrix4x4 cm1)))