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