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)
+  #: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 types)
   #: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
 
-(define-conversion-type parse-aiScene -> scene
+(define-conversion-type parse-aiScene -> ai-scene
   (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))))
 
-(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
 
-(define-conversion-type parse-aiNode -> node
+(define-conversion-type parse-aiNode -> ai-node
   (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))))
 
-(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
 
-(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)
-            wrap-vector3d))
+            wrap-ai-vector3d))
   (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)
-           wrap-vector3d))
+           wrap-ai-vector3d))
   (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)
-              wrap-vector3d))
+              wrap-ai-vector3d))
   (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)
-                     wrap-vector3d))
+                     wrap-ai-vector3d))
                   (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)))
 
-(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
 
-(define-conversion-type parse-aiMaterial -> material
+(define-conversion-type parse-aiMaterial -> ai-material
   (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
 
-(define-conversion-type parse-aiFace -> face
+(define-conversion-type parse-aiFace -> ai-face
   (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 -> vector2d
+(define-conversion-type parse-aiVector2D -> ai-vector2d
   (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)))
 
-(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
 
-(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)))
 
-(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
 
-(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)
-           wrap-vertex-weight))
+           wrap-ai-vertex-weight))
   (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
 
-(define-conversion-type parse-aiVertexWeight -> vertex-weight
+(define-conversion-type parse-aiVertexWeight -> ai-vertex-weight
   (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)
+
+
+;;; 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)