From 3232da94d35e82b13b04e703fe68c5f1f3232838 Mon Sep 17 00:00:00 2001 From: Javier Sancho Date: Tue, 15 Jul 2014 14:34:50 +0200 Subject: [PATCH] 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. --- src/assimp.scm | 201 +++++++++++++++++++------------------- src/low-level.scm | 15 +++ src/low-level/cimport.scm | 32 ++++++ 3 files changed, 149 insertions(+), 99 deletions(-) create mode 100644 src/low-level/cimport.scm diff --git a/src/assimp.scm b/src/assimp.scm index 81329da..5c8ccd2 100644 --- 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 53bb39e..7842aca 100644 --- 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 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 +;;; +;;; 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 . + + +(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) -- 2.39.2