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