More functions from original library

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

diff --git a/src/assimp.scm b/src/assimp.scm
index 9f6bfc2a3959bdee06358a4175b0374aa866305b..fcb9492fd1750e32e59ca704e232d7b1badbac16 100644 (file)
--- a/src/assimp.scm
+++ b/src/assimp.scm
@@ -17,116 +17,370 @@
 
 (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 mesh)

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

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

-  #:use-module (system foreign))
-
-(define libassimp (dynamic-link "libassimp"))
-
-(define aiImportFile
-  (pointer->procedure '*
-                     (dynamic-func "aiImportFile" libassimp)
-                     (list '* unsigned-int)))
+  #:use-module (assimp low-level types)
+  #:use-module (assimp low-level vector)
+  #:use-module (system foreign)
+  #:export (ai-import-file
+           ai-release-import
+           ai-attach-predefined-log-stream
+           ai-transform-vec-by-matrix4
+           ai-multiply-matrix3
+           ai-multiply-matrix4
+           ai-identity-matrix3
+           ai-identity-matrix4
+           ai-transpose-matrix3
+           ai-transpose-matrix4)
+  #:re-export (ai-material-key
+              ai-process-steps
+              ai-process-convert-to-left-handed
+              ai-process-preset-target-realtime-fast
+              ai-process-preset-target-realtime-quality
+              ai-process-preset-target-realtime-max-quality
+              ai-default-log-stream
+              (aiDetachAllLogStreams . ai-detach-all-log-streams)))

 
 
 ;;; 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-size 12 #: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)
+
+
+(define-public (ai-get-material-color mat color-type)
+  (let ((pmat (unwrap-ai-material mat))
+       (pkey (string->pointer (car color-type)))
+       (type (cadr color-type))
+       (index (caddr color-type))
+       (pout (parse-aiColor4D (make-list 4 0) #:reverse #t)))
+    (let ((res (aiGetMaterialColor pmat pkey type index pout)))
+      (if (< res 0)
+         res
+         (wrap-ai-color4d pout)))))
+
+(define-public (ai-get-material-float-array mat color-type max)
+  (let ((pmat (unwrap-ai-material mat))
+       (pkey (string->pointer (car color-type)))
+       (type (cadr color-type))
+       (index (caddr color-type))
+       (pout (make-c-struct (make-list max float) '(0)))
+       (pmax (make-c-struct (list unsigned-int) (list max))))
+    (let ((res (aiGetMaterialFloatArray pmat pkey type index pout pmax)))
+      (if (< res 0)
+         res
+         (parse-c-struct pout (make-list max float))))))
+
+(define-public (ai-get-material-integer-array mat color-type max)
+  (let ((pmat (unwrap-ai-material mat))
+       (pkey (string->pointer (car color-type)))
+       (type (cadr color-type))
+       (index (caddr color-type))
+       (pout (make-c-struct (make-list max int) '(0)))
+       (pmax (make-c-struct (list unsigned-int) (list max))))
+    (let ((res (aiGetMaterialIntegerArray pmat pkey type index pout pmax)))
+      (if (< res 0)
+         res
+         (parse-c-struct pout (make-list max int))))))

 
 
 ;;; 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 (ai-import-file filename flags)
+  (wrap-ai-scene
+   (aiImportFile (string->pointer filename)
+                flags)))
+
+(define (ai-release-import scene)
+  (aiReleaseImport (unwrap-ai-scene scene)))
+
+(define* (ai-attach-predefined-log-stream type #:optional file)
+  (aiAttachLogStream
+   (aiGetPredefinedLogStream
+    type
+    (if file
+       (string->pointer file)
+       %null-pointer))))
+
+(define (ai-transform-vec-by-matrix4 vec mat)
+  (let ((cvec (parse-aiVector3D (map cdr (ai-vector3d-contents vec)) #:reverse #t))
+       (cmat (parse-aiMatrix4x4 (map cdr (ai-matrix4x4-contents mat)) #:reverse #t)))
+    (aiTransformVecByMatrix4 cvec cmat)
+    (wrap-ai-vector3d cvec)))
+
+(define (ai-multiply-matrix3 m1 m2)
+  (let ((cm1 (parse-aiMatrix3x3 (map cdr (ai-matrix3x3-contents m1)) #:reverse #t))
+       (cm2 (parse-aiMatrix3x3 (map cdr (ai-matrix3x3-contents m2)) #:reverse #t)))
+    (aiMultiplyMatrix3 cm1 cm2)
+    (wrap-ai-matrix3x3 cm1)))
+
+(define (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)))
+
+(define (ai-identity-matrix3)
+  (let ((cmat (parse-aiMatrix3x3 (make-list 9 0) #:reverse #t)))
+    (aiIdentityMatrix3 cmat)
+    (wrap-ai-matrix3x3 cmat)))
+
+(define (ai-identity-matrix4)
+  (let ((cmat (parse-aiMatrix4x4 (make-list 16 0) #:reverse #t)))
+    (aiIdentityMatrix4 cmat)
+    (wrap-ai-matrix4x4 cmat)))
+
+(define (ai-transpose-matrix3 mat)
+  (let ((cmat (parse-aiMatrix3x3 (map cdr (ai-matrix3x3-contents mat)) #:reverse #t)))
+    (aiTransposeMatrix3 cmat)
+    (wrap-ai-matrix3x3 cmat)))
+
+(define (ai-transpose-matrix4 mat)
+  (let ((cmat (parse-aiMatrix4x4 (map cdr (ai-matrix4x4-contents mat)) #:reverse #t)))
+    (aiTransposeMatrix4 cmat)
+    (wrap-ai-matrix4x4 cmat)))