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