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 postprocess)
  26   #:use-module (assimp low-level scene)
  27   #:use-module (assimp low-level types)
  28   #:use-module (assimp low-level vector)
  29   #:use-module (system foreign)
  30   #:export (ai-import-file
  31             ai-release-import
  32             ai-attach-predefined-log-stream
  33             ai-transform-vec-by-matrix4
  34             ai-multiply-matrix3
  35             ai-multiply-matrix4
  36             ai-identity-matrix3
  37             ai-identity-matrix4
  38             ai-transpose-matrix3
  39             ai-transpose-matrix4)
  40   #:re-export (ai-material-key
  41                ai-process-steps
  42                ai-process-convert-to-left-handed
  43                ai-process-preset-target-realtime-fast
  44                ai-process-preset-target-realtime-quality
  45                ai-process-preset-target-realtime-max-quality
  46                ai-default-log-stream
  47                (aiDetachAllLogStreams . ai-detach-all-log-streams)))
  48
  49
  50 ;;; Scenes
  51
  52 (define-conversion-type parse-aiScene -> ai-scene
  53   (flags (field 'mFlags))
  54   (root-node (wrap (field 'mRootNode) wrap-ai-node))
  55   (meshes (wrap (array (field 'mNumMeshes) (field 'mMeshes)) wrap-ai-mesh))
  56   (materials (wrap (array (field 'mNumMaterials) (field 'mMaterials)) wrap-ai-material))
  57   (animations (array (field 'mNumAnimations) (field 'mAnimations)))
  58   (textures (array (field 'mNumTextures) (field 'mTextures)))
  59   (lights (array (field 'mNumLights) (field 'mLights)))
  60   (cameras (array (field 'mNumCameras) (field 'mCameras))))
  61
  62 (export ai-scene?
  63         ai-scene-contents
  64         ai-scene-flags
  65         ai-scene-root-node
  66         ai-scene-meshes
  67         ai-scene-materials
  68         ai-scene-animations
  69         ai-scene-textures
  70         ai-scene-lights
  71         ai-scene-cameras)
  72
  73
  74 ;;; Nodes
  75
  76 (define-conversion-type parse-aiNode -> ai-node
  77   (name (sized-string (field 'mName)))
  78   (transformation (wrap (parse-aiMatrix4x4 (field 'mTransformation) #:reverse #t) wrap-ai-matrix4x4))
  79   (parent (wrap (field 'mParent) wrap-ai-node))
  80   (children (wrap (array (field 'mNumChildren) (field 'mChildren)) wrap-ai-node))
  81   (meshes (array (field 'mNumMeshes) (field 'mMeshes))))
  82
  83 (export ai-node?
  84         ai-node-contents
  85         ai-node-name
  86         ai-node-transformation
  87         ai-node-parent
  88         ai-node-children
  89         ai-node-meshes)
  90
  91
  92 ;;; Meshes
  93
  94 (define-conversion-type parse-aiMesh -> ai-mesh
  95   (name (sized-string (field 'mName)))
  96   (primitive-types (field 'mPrimitiveTypes))
  97   (vertices (wrap
  98              (array (field 'mNumVertices) (field 'mVertices) #:element-size 12 #:element-proc get-element-address)
  99              wrap-ai-vector3d))
 100   (faces (wrap
 101           (array (field 'mNumFaces) (field 'mFaces) #:element-size 8 #:element-proc get-element-address)
 102           wrap-ai-face))
 103   (normals (wrap
 104             (array (field 'mNumVertices) (field 'mNormals) #:element-size 12 #:element-proc get-element-address)
 105             wrap-ai-vector3d))
 106   (tangents (wrap
 107              (array (field 'mNumVertices) (field 'mTangents) #:element-size 12 #:element-proc get-element-address)
 108              wrap-ai-vector3d))
 109   (bitangents (wrap
 110                (array (field 'mNumVertices) (field 'mBitangents) #:element-size 12 #:element-proc get-element-address)
 111                wrap-ai-vector3d))
 112   (colors (map
 113            (lambda (c)
 114              (wrap
 115               (array (field 'mNumVertices) c #:element-size 16 #:element-proc get-element-address)
 116               wrap-ai-color4d))
 117            (field 'mColors)))
 118   (texture-coords (map
 119                    (lambda (tc)
 120                      (wrap
 121                       (array (field 'mNumVertices) tc #:element-size 12 #:element-proc get-element-address)
 122                       wrap-ai-vector3d))
 123                    (field 'mTextureCoords)))
 124   (num-uv-components (field 'mNumUVComponents))
 125   (bones (wrap (array (field 'mNumBones) (field 'mBones)) wrap-ai-bone))
 126   (material-index (field 'mMaterialIndex)))
 127
 128 (export ai-mesh?
 129         ai-mesh-contents
 130         ai-mesh-name
 131         ai-mesh-primitive-types
 132         ai-mesh-vertices
 133         ai-mesh-faces
 134         ai-mesh-normals
 135         ai-mesh-tangents
 136         ai-mesh-bitangents
 137         ai-mesh-colors
 138         ai-mesh-texture-coords
 139         ai-mesh-num-uv-components
 140         ai-mesh-bones
 141         ai-mesh-material-index)
 142
 143
 144 ;;; Materials
 145
 146 (define-conversion-type parse-aiMaterial -> ai-material
 147   (properties (array (field 'mNumProperties) (field 'mProperties)))
 148   (num-allocated (field 'mNumAllocated)))
 149
 150 (export ai-material?
 151         ai-material-contents
 152         ai-material-properties
 153         ai-material-num-allocated)
 154
 155
 156 (define-public (ai-get-material-color mat color-type)
 157   (let ((pmat (unwrap-ai-material mat))
 158         (pkey (string->pointer (car color-type)))
 159         (type (cadr color-type))
 160         (index (caddr color-type))
 161         (pout (parse-aiColor4D (make-list 4 0) #:reverse #t)))
 162     (let ((res (aiGetMaterialColor pmat pkey type index pout)))
 163       (if (< res 0)
 164           res
 165           (wrap-ai-color4d pout)))))
 166
 167 (define-public (ai-get-material-float-array mat color-type max)
 168   (let ((pmat (unwrap-ai-material mat))
 169         (pkey (string->pointer (car color-type)))
 170         (type (cadr color-type))
 171         (index (caddr color-type))
 172         (pout (bytevector->pointer (list->f32vector (make-list max 0))))
 173         (pmax (bytevector->pointer (list->u32vector (list max)))))
 174     (let ((res (aiGetMaterialFloatArray pmat pkey type index pout pmax)))
 175       (if (< res 0)
 176           res
 177           (f32vector->list (pointer->bytevector pout max 0 'f32))))))
 178
 179 (define-public (ai-get-material-integer-array mat color-type max)
 180   (let ((pmat (unwrap-ai-material mat))
 181         (pkey (string->pointer (car color-type)))
 182         (type (cadr color-type))
 183         (index (caddr color-type))
 184         (pout (bytevector->pointer (list->s32vector (make-list max 0))))
 185         (pmax (bytevector->pointer (list->u32vector (list max)))))
 186     (let ((res (aiGetMaterialIntegerArray pmat pkey type index pout pmax)))
 187       (if (< res 0)
 188           res
 189           (s32vector->list (pointer->bytevector pout max 0 's32))))))
 190
 191
 192 ;;; Faces
 193
 194 (define-conversion-type parse-aiFace -> ai-face
 195   (indices (array (field 'mNumIndices) (field 'mIndices))))
 196
 197 (export ai-face?
 198         ai-face-contents
 199         ai-face-indices)
 200
 201
 202 ;;; Vectors
 203
 204 (define-conversion-type parse-aiVector2D -> ai-vector2d
 205   (x (field 'x))
 206   (y (field 'y)))
 207
 208 (export ai-vector2d?
 209         ai-vector2d-contents
 210         ai-vector2d-x
 211         ai-vector2d-y)
 212
 213 (define-conversion-type parse-aiVector3D -> ai-vector3d
 214   (x (field 'x))
 215   (y (field 'y))
 216   (z (field 'z)))
 217
 218 (export ai-vector3d?
 219         ai-vector3d-contents
 220         ai-vector3d-x
 221         ai-vector3d-y
 222         ai-vector3d-z)
 223
 224
 225 ;;; Matrixes
 226
 227 (define-conversion-type parse-aiMatrix3x3 -> ai-matrix3x3
 228   (a1 (field 'a1))
 229   (a2 (field 'a2))
 230   (a3 (field 'a3))
 231   (b1 (field 'b1))
 232   (b2 (field 'b2))
 233   (b3 (field 'b3))
 234   (c1 (field 'c1))
 235   (c2 (field 'c2))
 236   (c3 (field 'c3)))
 237
 238 (export ai-matrix3x3?
 239         ai-matrix3x3-contents
 240         ai-matrix3x3-a1
 241         ai-matrix3x3-a2
 242         ai-matrix3x3-a3
 243         ai-matrix3x3-b1
 244         ai-matrix3x3-b2
 245         ai-matrix3x3-b3
 246         ai-matrix3x3-c1
 247         ai-matrix3x3-c2
 248         ai-matrix3x3-c3)
 249
 250 (define-conversion-type parse-aiMatrix4x4 -> ai-matrix4x4
 251   (a1 (field 'a1))
 252   (a2 (field 'a2))
 253   (a3 (field 'a3))
 254   (a4 (field 'a4))
 255   (b1 (field 'b1))
 256   (b2 (field 'b2))
 257   (b3 (field 'b3))
 258   (b4 (field 'b4))
 259   (c1 (field 'c1))
 260   (c2 (field 'c2))
 261   (c3 (field 'c3))
 262   (c4 (field 'c4))
 263   (d1 (field 'd1))
 264   (d2 (field 'd2))
 265   (d3 (field 'd3))
 266   (d4 (field 'd4)))
 267
 268 (export ai-matrix4x4?
 269         ai-matrix4x4-contents
 270         ai-matrix4x4-a1
 271         ai-matrix4x4-a2
 272         ai-matrix4x4-a3
 273         ai-matrix4x4-a4
 274         ai-matrix4x4-b1
 275         ai-matrix4x4-b2
 276         ai-matrix4x4-b3
 277         ai-matrix4x4-b4
 278         ai-matrix4x4-c1
 279         ai-matrix4x4-c2
 280         ai-matrix4x4-c3
 281         ai-matrix4x4-c4
 282         ai-matrix4x4-d1
 283         ai-matrix4x4-d2
 284         ai-matrix4x4-d3
 285         ai-matrix4x4-d4)
 286
 287
 288 ;;; Colors
 289
 290 (define-conversion-type parse-aiColor4D -> ai-color4d
 291   (r (field 'r))
 292   (g (field 'g))
 293   (b (field 'b))
 294   (a (field 'a)))
 295
 296 (export ai-color4d?
 297         ai-color4d-contents
 298         ai-color4d-r
 299         ai-color4d-g
 300         ai-color4d-b
 301         ai-color4d-a)
 302
 303
 304 ;;; Bones
 305
 306 (define-conversion-type parse-aiBone -> ai-bone
 307   (name (sized-string (field 'mName)))
 308   (weights (wrap
 309             (array (field 'mNumWeights) (field 'mWeights) #:element-size 8 #:element-proc get-element-address)
 310             wrap-ai-vertex-weight))
 311   (offset-matrix (wrap (parse-aiMatrix4x4 (field 'mOffsetMatrix) #:reverse #t) wrap-ai-matrix4x4)))
 312
 313 (export ai-bone?
 314         ai-bone-contents
 315         ai-bone-name
 316         ai-bone-weights
 317         ai-bone-offset-matrix)
 318
 319
 320 ;;; Weights
 321
 322 (define-conversion-type parse-aiVertexWeight -> ai-vertex-weight
 323   (vertex-id (field 'mVertexId))
 324   (weight (field 'mWeight)))
 325
 326 (export ai-vertex-weight?
 327         ai-vertex-weight-contents
 328         ai-vertex-weight-vertex-id
 329         ai-vertex-weight-weight)
 330
 331
 332 ;;; Functions
 333
 334 (define (ai-import-file filename flags)
 335   (wrap-ai-scene
 336    (aiImportFile (string->pointer filename)
 337                  flags)))
 338
 339 (define (ai-release-import scene)
 340   (aiReleaseImport (unwrap-ai-scene scene)))
 341
 342 (define* (ai-attach-predefined-log-stream type #:optional file)
 343   (aiAttachLogStream
 344    (aiGetPredefinedLogStream
 345     type
 346     (if file
 347         (string->pointer file)
 348         %null-pointer))))
 349
 350 (define (ai-transform-vec-by-matrix4 vec mat)
 351   (let ((cvec (parse-aiVector3D (map cdr (ai-vector3d-contents vec)) #:reverse #t))
 352         (cmat (parse-aiMatrix4x4 (map cdr (ai-matrix4x4-contents mat)) #:reverse #t)))
 353     (aiTransformVecByMatrix4 cvec cmat)
 354     (wrap-ai-vector3d cvec)))
 355
 356 (define (ai-multiply-matrix3 m1 m2)
 357   (let ((cm1 (parse-aiMatrix3x3 (map cdr (ai-matrix3x3-contents m1)) #:reverse #t))
 358         (cm2 (parse-aiMatrix3x3 (map cdr (ai-matrix3x3-contents m2)) #:reverse #t)))
 359     (aiMultiplyMatrix3 cm1 cm2)
 360     (wrap-ai-matrix3x3 cm1)))
 361
 362 (define (ai-multiply-matrix4 m1 m2)
 363   (let ((cm1 (parse-aiMatrix4x4 (map cdr (ai-matrix4x4-contents m1)) #:reverse #t))
 364         (cm2 (parse-aiMatrix4x4 (map cdr (ai-matrix4x4-contents m2)) #:reverse #t)))
 365     (aiMultiplyMatrix4 cm1 cm2)
 366     (wrap-ai-matrix4x4 cm1)))
 367
 368 (define (ai-identity-matrix3)
 369   (let ((cmat (parse-aiMatrix3x3 (make-list 9 0) #:reverse #t)))
 370     (aiIdentityMatrix3 cmat)
 371     (wrap-ai-matrix3x3 cmat)))
 372
 373 (define (ai-identity-matrix4)
 374   (let ((cmat (parse-aiMatrix4x4 (make-list 16 0) #:reverse #t)))
 375     (aiIdentityMatrix4 cmat)
 376     (wrap-ai-matrix4x4 cmat)))
 377
 378 (define (ai-transpose-matrix3 mat)
 379   (let ((cmat (parse-aiMatrix3x3 (map cdr (ai-matrix3x3-contents mat)) #:reverse #t)))
 380     (aiTransposeMatrix3 cmat)
 381     (wrap-ai-matrix3x3 cmat)))
 382
 383 (define (ai-transpose-matrix4 mat)
 384   (let ((cmat (parse-aiMatrix4x4 (map cdr (ai-matrix4x4-contents mat)) #:reverse #t)))
 385     (aiTransposeMatrix4 cmat)
 386     (wrap-ai-matrix4x4 cmat)))