src/assimp.scm

   1 ;;; guile-assimp, foreign interface to libassimp
   2 ;;; Copyright (C) 2014 by Javier Sancho Fernandez <jsf at jsancho dot org>
   3 ;;;
   4 ;;; This program is free software: you can redistribute it and/or modify
   5 ;;; it under the terms of the GNU General Public License as published by
   6 ;;; the Free Software Foundation, either version 3 of the License, or
   7 ;;; (at your option) any later version.
   8 ;;;
   9 ;;; This program is distributed in the hope that it will be useful,
  10 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 ;;; GNU General Public License for more details.
  13 ;;;
  14 ;;; You should have received a copy of the GNU General Public License
  15 ;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  16
  17
  18 (define-module (assimp assimp)
  19   #:use-module (assimp low-level)
  20   #:use-module (assimp low-level material)
  21   #:use-module (assimp low-level mesh)
  22   #:use-module (assimp low-level scene)
  23   #:use-module (system foreign))
  24
  25 (define libassimp (dynamic-link "libassimp"))
  26
  27 (define aiImportFile
  28   (pointer->procedure '*
  29                       (dynamic-func "aiImportFile" libassimp)
  30                       (list '* unsigned-int)))
  31
  32
  33 ;;; Scenes
  34
  35 (define-conversion-type parse-aiScene -> scene
  36   (flags (field 'mFlags))
  37   (root-node (wrap (field 'mRootNode) wrap-node))
  38   (meshes (wrap (array (field 'mNumMeshes) (field 'mMeshes)) wrap-mesh))
  39   (materials (wrap (array (field 'mNumMaterials) (field 'mMaterials)) wrap-material))
  40   (animations (array (field 'mNumAnimations) (field 'mAnimations)))
  41   (textures (array (field 'mNumTextures) (field 'mTextures)))
  42   (lights (array (field 'mNumLights) (field 'mLights)))
  43   (cameras (array (field 'mNumCameras) (field 'mCameras))))
  44
  45 (define (load-scene filename flags)
  46   (wrap-scene
  47    (aiImportFile (string->pointer filename)
  48                  flags)))
  49
  50 (export load-scene
  51         scene?
  52         scene-contents
  53         scene-flags
  54         scene-root-node
  55         scene-meshes
  56         scene-materials
  57         scene-animations
  58         scene-textures
  59         scene-lights
  60         scene-cameras)
  61
  62
  63 ;;; Nodes
  64
  65 (define-conversion-type parse-aiNode -> node
  66   (name (sized-string (field 'mName)))
  67   (transformation (field 'mTransformation))
  68   (parent (wrap (field 'mParent) wrap-node))
  69   (children (wrap (array (field 'mNumChildren) (field 'mChildren)) wrap-node))
  70   (meshes (array (field 'mNumMeshes) (field 'mMeshes))))
  71
  72 (export node?
  73         node-contents
  74         node-name
  75         node-transformation
  76         node-parent
  77         node-children
  78         node-meshes)
  79
  80
  81 ;;; Meshes
  82
  83 (define-conversion-type parse-aiMesh -> mesh
  84   (name (sized-string (field 'mName)))
  85   (primitive-types (field 'mPrimitiveTypes))
  86   (vertices (array (field 'mNumVertices) (field 'mVertices) #:element-proc get-element-address))
  87   (faces (wrap (array (field 'mNumFaces) (field 'mFaces) #:element-size 8 #:element-proc get-element-address) wrap-face))
  88   (normals (array (field 'mNumVertices) (field 'mNormals) #:element-size 12 #:element-proc get-element-address))
  89   (tangents (array (field 'mNumVertices) (field 'mTangents) #:element-size 12 #:element-proc get-element-address))
  90   (bitangents (array (field 'mNumVertices) (field 'mBitangents) #:element-size 12 #:element-proc get-element-address))
  91   (colors (field 'mColors))
  92   (texture-coords (field 'mTextureCoords))
  93   (num-uv-components (field 'mNumUVComponents))
  94   (bones (array (field 'mNumBones) (field 'mBones)))
  95   (material-index (field 'mMaterialIndex)))
  96
  97 (export mesh?
  98         mesh-contents
  99         mesh-name
 100         mesh-primitive-types
 101         mesh-vertices
 102         mesh-faces
 103         mesh-normals
 104         mesh-tangents
 105         mesh-bitangents
 106         mesh-colors
 107         mesh-texture-coords
 108         mesh-num-uv-components
 109         mesh-bones
 110         mesh-material-index)
 111
 112
 113 ;;; Materials
 114
 115 (define-conversion-type parse-aiMaterial -> material
 116   (properties (array (field 'mNumProperties) (field 'mProperties)))
 117   (num-allocated (field 'mNumAllocated)))
 118
 119 (export material?
 120         material-contents
 121         material-properties
 122         material-num-allocated)
 123
 124
 125 ;;; Faces
 126
 127 (define-conversion-type parse-aiFace -> face
 128   (indices (array (field 'mNumIndices) (field 'mIndices))))
 129
 130 (export face?
 131         face-contents
 132         face-indices)