]> git.jsancho.org Git - guile-assimp.git/blob - src/assimp.scm
Sources Reorganization
[guile-assimp.git] / 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)
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)))