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 color)
  21   #:use-module (assimp low-level material)
  22   #:use-module (assimp low-level mesh)
  23   #:use-module (assimp low-level scene)
  24   #:use-module (assimp low-level vector)
  25   #:use-module (system foreign))
  26
  27 (define libassimp (dynamic-link "libassimp"))
  28
  29 (define aiImportFile
  30   (pointer->procedure '*
  31                       (dynamic-func "aiImportFile" libassimp)
  32                       (list '* unsigned-int)))
  33
  34
  35 ;;; Scenes
  36
  37 (define-conversion-type parse-aiScene -> scene
  38   (flags (field 'mFlags))
  39   (root-node (wrap (field 'mRootNode) wrap-node))
  40   (meshes (wrap (array (field 'mNumMeshes) (field 'mMeshes)) wrap-mesh))
  41   (materials (wrap (array (field 'mNumMaterials) (field 'mMaterials)) wrap-material))
  42   (animations (array (field 'mNumAnimations) (field 'mAnimations)))
  43   (textures (array (field 'mNumTextures) (field 'mTextures)))
  44   (lights (array (field 'mNumLights) (field 'mLights)))
  45   (cameras (array (field 'mNumCameras) (field 'mCameras))))
  46
  47 (define (load-scene filename flags)
  48   (wrap-scene
  49    (aiImportFile (string->pointer filename)
  50                  flags)))
  51
  52 (export load-scene
  53         scene?
  54         scene-contents
  55         scene-flags
  56         scene-root-node
  57         scene-meshes
  58         scene-materials
  59         scene-animations
  60         scene-textures
  61         scene-lights
  62         scene-cameras)
  63
  64
  65 ;;; Nodes
  66
  67 (define-conversion-type parse-aiNode -> node
  68   (name (sized-string (field 'mName)))
  69   (transformation (field 'mTransformation))
  70   (parent (wrap (field 'mParent) wrap-node))
  71   (children (wrap (array (field 'mNumChildren) (field 'mChildren)) wrap-node))
  72   (meshes (array (field 'mNumMeshes) (field 'mMeshes))))
  73
  74 (export node?
  75         node-contents
  76         node-name
  77         node-transformation
  78         node-parent
  79         node-children
  80         node-meshes)
  81
  82
  83 ;;; Meshes
  84
  85 (define-conversion-type parse-aiMesh -> mesh
  86   (name (sized-string (field 'mName)))
  87   (primitive-types (field 'mPrimitiveTypes))
  88   (vertices (wrap
  89              (array (field 'mNumVertices) (field 'mVertices) #:element-proc get-element-address)
  90              wrap-vector3d))
  91   (faces (wrap
  92           (array (field 'mNumFaces) (field 'mFaces) #:element-size 8 #:element-proc get-element-address)
  93           wrap-face))
  94   (normals (wrap
  95             (array (field 'mNumVertices) (field 'mNormals) #:element-size 12 #:element-proc get-element-address)
  96             wrap-vector3d))
  97   (tangents (wrap
  98              (array (field 'mNumVertices) (field 'mTangents) #:element-size 12 #:element-proc get-element-address)
  99              wrap-vector3d))
 100   (bitangents (wrap
 101                (array (field 'mNumVertices) (field 'mBitangents) #:element-size 12 #:element-proc get-element-address)
 102                wrap-vector3d))
 103   (colors (map
 104            (lambda (c)
 105              (wrap
 106               (array (field 'mNumVertices) c #:element-size 16 #:element-proc get-element-address)
 107               wrap-color4d))
 108            (field 'mColors)))
 109   (texture-coords (map
 110                    (lambda (tc)
 111                      (wrap
 112                       (array (field 'mNumVertices) tc #:element-size 12 #:element-proc get-element-address)
 113                       wrap-vector3d))
 114                    (field 'mTextureCoords)))
 115   (num-uv-components (field 'mNumUVComponents))
 116   (bones (wrap (array (field 'mNumBones) (field 'mBones)) wrap-bone))
 117   (material-index (field 'mMaterialIndex)))
 118
 119 (export mesh?
 120         mesh-contents
 121         mesh-name
 122         mesh-primitive-types
 123         mesh-vertices
 124         mesh-faces
 125         mesh-normals
 126         mesh-tangents
 127         mesh-bitangents
 128         mesh-colors
 129         mesh-texture-coords
 130         mesh-num-uv-components
 131         mesh-bones
 132         mesh-material-index)
 133
 134
 135 ;;; Materials
 136
 137 (define-conversion-type parse-aiMaterial -> material
 138   (properties (array (field 'mNumProperties) (field 'mProperties)))
 139   (num-allocated (field 'mNumAllocated)))
 140
 141 (export material?
 142         material-contents
 143         material-properties
 144         material-num-allocated)
 145
 146
 147 ;;; Faces
 148
 149 (define-conversion-type parse-aiFace -> face
 150   (indices (array (field 'mNumIndices) (field 'mIndices))))
 151
 152 (export face?
 153         face-contents
 154         face-indices)
 155
 156
 157 ;;; Vectors
 158
 159 (define-conversion-type parse-aiVector2D -> vector2d
 160   (x (field 'x))
 161   (y (field 'y)))
 162
 163 (export vector2d?
 164         vector2d-contents
 165         vector2d-x
 166         vector2d-y)
 167
 168 (define-conversion-type parse-aiVector3D -> vector3d
 169   (x (field 'x))
 170   (y (field 'y))
 171   (z (field 'z)))
 172
 173 (export vector3d?
 174         vector3d-contents
 175         vector3d-x
 176         vector3d-y
 177         vector3d-z)
 178
 179
 180 ;;; Colors
 181
 182 (define-conversion-type parse-aiColor4D -> color4d
 183   (r (field 'r))
 184   (g (field 'g))
 185   (b (field 'b))
 186   (a (field 'a)))
 187
 188 (export color4d?
 189         color4d-contents
 190         color4d-r
 191         color4d-g
 192         color4d-b
 193         color4d-a)
 194
 195
 196 ;;; Bones
 197
 198 (define-conversion-type parse-aiBone -> bone
 199   (name (sized-string (field 'mName)))
 200   (weights (wrap
 201             (array (field 'mNumWeights) (field 'mWeights) #:element-size 8 #:element-proc get-element-address)
 202             wrap-vertex-weight))
 203   (offset-matrix (field 'mOffsetMatrix)))
 204
 205 (export bone?
 206         bone-contents
 207         bone-name
 208         bone-weights
 209         bone-offset-matrix)
 210
 211
 212 ;;; Weights
 213
 214 (define-conversion-type parse-aiVertexWeight -> vertex-weight
 215   (vertex-id (field 'mVertexId))
 216   (weight (field 'mWeight)))
 217
 218 (export vertex-weight?
 219         vertex-weight-contents
 220         vertex-weight-vertex-id
 221         vertex-weight-weight)