Add foreign functions and rename types

* src/assimp.scm: Rename types, from scene to ai-scene, from node to
  ai-node, etc. New functions ai-import-file and ai-multiply-matrix4.

* src/low-level.scm: New syntax define-foreign-function for simplifying
  foreign functions declaration.

* src/low-level/cimport.scm: Foreign functions aiImportFile and
  aiMultiplyMatrix4.

diff --git a/src/assimp.scm b/src/assimp.scm
index 81329da4bde097335c13c03cc079d38a3050136f..5c8ccd2b99df311616aa3d2eb292d1be4e818ad2 100644 (file)
--- a/src/assimp.scm
+++ b/src/assimp.scm
@@ -17,205 +17,208 @@
 
 (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 mesh)
   #:use-module (assimp low-level scene)
   #:use-module (assimp low-level color)
   #:use-module (assimp low-level material)
   #: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 (assimp low-level vector)
   #: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)))
   (transformation (field 'mTransformation))
   (name (sized-string (field 'mName)))
   (transformation (field 'mTransformation))

-  (parent (wrap (field 'mParent) wrap-node))
-  (children (wrap (array (field 'mNumChildren) (field 'mChildren)) wrap-node))
+  (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))
   (vertices (wrap
             (array (field 'mNumVertices) (field 'mVertices) #:element-proc get-element-address)
   (name (sized-string (field 'mName)))
   (primitive-types (field 'mPrimitiveTypes))
   (vertices (wrap
             (array (field 'mNumVertices) (field 'mVertices) #:element-proc get-element-address)

-            wrap-vector3d))
+            wrap-ai-vector3d))

   (faces (wrap
          (array (field 'mNumFaces) (field 'mFaces) #:element-size 8 #:element-proc get-element-address)
   (faces (wrap
          (array (field 'mNumFaces) (field 'mFaces) #:element-size 8 #:element-proc get-element-address)

-         wrap-face))
+         wrap-ai-face))

   (normals (wrap
            (array (field 'mNumVertices) (field 'mNormals) #:element-size 12 #:element-proc get-element-address)
   (normals (wrap
            (array (field 'mNumVertices) (field 'mNormals) #:element-size 12 #:element-proc get-element-address)

-           wrap-vector3d))
+           wrap-ai-vector3d))

   (tangents (wrap
             (array (field 'mNumVertices) (field 'mTangents) #:element-size 12 #:element-proc get-element-address)
   (tangents (wrap
             (array (field 'mNumVertices) (field 'mTangents) #:element-size 12 #:element-proc get-element-address)

-            wrap-vector3d))
+            wrap-ai-vector3d))

   (bitangents (wrap
               (array (field 'mNumVertices) (field 'mBitangents) #:element-size 12 #:element-proc get-element-address)
   (bitangents (wrap
               (array (field 'mNumVertices) (field 'mBitangents) #:element-size 12 #:element-proc get-element-address)

-              wrap-vector3d))
+              wrap-ai-vector3d))

   (colors (map
           (lambda (c)
             (wrap
              (array (field 'mNumVertices) c #:element-size 16 #:element-proc get-element-address)
   (colors (map
           (lambda (c)
             (wrap
              (array (field 'mNumVertices) c #:element-size 16 #:element-proc get-element-address)

-             wrap-color4d))
+             wrap-ai-color4d))

           (field 'mColors)))
   (texture-coords (map
                   (lambda (tc)
                     (wrap
                      (array (field 'mNumVertices) tc #:element-size 12 #:element-proc get-element-address)
           (field 'mColors)))
   (texture-coords (map
                   (lambda (tc)
                     (wrap
                      (array (field 'mNumVertices) tc #:element-size 12 #:element-proc get-element-address)

-                     wrap-vector3d))
+                     wrap-ai-vector3d))

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

-  (bones (wrap (array (field 'mNumBones) (field 'mBones)) wrap-bone))
+  (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
 
 
 
 ;;; Vectors
 

-(define-conversion-type parse-aiVector2D -> vector2d
+(define-conversion-type parse-aiVector2D -> ai-vector2d

   (x (field 'x))
   (y (field 'y)))
 
   (x (field 'x))
   (y (field 'y)))
 

-(export vector2d?
-       vector2d-contents
-       vector2d-x
-       vector2d-y)
+(export ai-vector2d?
+       ai-vector2d-contents
+       ai-vector2d-x
+       ai-vector2d-y)

 
 

-(define-conversion-type parse-aiVector3D -> vector3d
+(define-conversion-type parse-aiVector3D -> ai-vector3d

   (x (field 'x))
   (y (field 'y))
   (z (field 'z)))
 
   (x (field 'x))
   (y (field 'y))
   (z (field 'z)))
 

-(export vector3d?
-       vector3d-contents
-       vector3d-x
-       vector3d-y
-       vector3d-z)
+(export ai-vector3d?
+       ai-vector3d-contents
+       ai-vector3d-x
+       ai-vector3d-y
+       ai-vector3d-z)

 
 
 ;;; Colors
 
 
 
 ;;; Colors
 

-(define-conversion-type parse-aiColor4D -> color4d
+(define-conversion-type parse-aiColor4D -> ai-color4d

   (r (field 'r))
   (g (field 'g))
   (b (field 'b))
   (a (field 'a)))
 
   (r (field 'r))
   (g (field 'g))
   (b (field 'b))
   (a (field 'a)))
 

-(export color4d?
-       color4d-contents
-       color4d-r
-       color4d-g
-       color4d-b
-       color4d-a)
+(export ai-color4d?
+       ai-color4d-contents
+       ai-color4d-r
+       ai-color4d-g
+       ai-color4d-b
+       ai-color4d-a)

 
 
 ;;; Bones
 
 
 
 ;;; Bones
 

-(define-conversion-type parse-aiBone -> bone
+(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)
   (name (sized-string (field 'mName)))
   (weights (wrap
            (array (field 'mNumWeights) (field 'mWeights) #:element-size 8 #:element-proc get-element-address)

-           wrap-vertex-weight))
+           wrap-ai-vertex-weight))

   (offset-matrix (field 'mOffsetMatrix)))
 
   (offset-matrix (field 'mOffsetMatrix)))
 

-(export bone?
-       bone-contents
-       bone-name
-       bone-weights
-       bone-offset-matrix)
+(export ai-bone?
+       ai-bone-contents
+       ai-bone-name
+       ai-bone-weights
+       ai-bone-offset-matrix)

 
 
 ;;; Weights
 
 
 
 ;;; Weights
 

-(define-conversion-type parse-aiVertexWeight -> vertex-weight
+(define-conversion-type parse-aiVertexWeight -> ai-vertex-weight

   (vertex-id (field 'mVertexId))
   (weight (field 'mWeight)))
 
   (vertex-id (field 'mVertexId))
   (weight (field 'mWeight)))
 

-(export vertex-weight?
-       vertex-weight-contents
-       vertex-weight-vertex-id 
-       vertex-weight-weight)
+(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 (make-c-struct aiMatrix4x4-type m1))
+       (cm2 (make-c-struct aiMatrix4x4-type m2)))
+    (aiMultiplyMatrix4 cm1 cm2)
+    (parse-c-struct cm1 aiMatrix4x4-type)))

diff --git a/src/low-level.scm b/src/low-level.scm
index 53bb39eb4d83906996191061a09dc729fc9f573d..7842acad035457579ea34c328777fd38028662d7 100644 (file)
--- a/src/low-level.scm
+++ b/src/low-level.scm
@@ -153,3 +153,18 @@
        get-element-address
        sized-string
        wrap)
        get-element-address
        sized-string
        wrap)

+
+
+;;; Function Mappers
+
+(define-syntax define-foreign-function
+  (lambda (x)
+    (syntax-case x (->)
+      ((_ ((foreign-lib name) arg-type ...) -> return-type)
+       (with-syntax ((name-string (datum->syntax x (symbol->string (syntax->datum #'name)))))
+         #'(define name
+            (pointer->procedure return-type
+                                (dynamic-func name-string foreign-lib)
+                                (list arg-type ...))))))))
+
+(export-syntax define-foreign-function)

diff --git a/src/low-level/cimport.scm b/src/low-level/cimport.scm
new file mode 100644 (file)
index 0000000..9bc0c99
--- /dev/null
+++ b/src/low-level/cimport.scm
@@ -0,0 +1,32 @@
+;;; guile-assimp, foreign interface to libassimp
+;;; Copyright (C) 2014 by Javier Sancho Fernandez <jsf at jsancho dot org>
+;;;
+;;; This program is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation, either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+
+(define-module (assimp low-level cimport)
+  #:use-module (assimp low-level)
+  #:use-module (system foreign)
+  #:export (aiImportFile
+           aiMultiplyMatrix4))
+
+(define libassimp (dynamic-link "libassimp"))
+
+(define-syntax define-assimp-function
+  (syntax-rules (->)
+    ((_ (name arg-type ...) -> return-type)
+     (define-foreign-function ((libassimp name) arg-type ...) -> return-type))))
+
+(define-assimp-function (aiImportFile '* unsigned-int) -> '*)
+(define-assimp-function (aiMultiplyMatrix4 '* '*) -> void)