## You should have received a copy of the GNU General Public License
## along with this program. If not, see <http://www.gnu.org/licenses/>.
-include guile.am
+SUBDIRS = src
-moddir=$(prefix)/share/guile/site/$(GUILE_EFFECTIVE_VERSION)
-godir=$(libdir)/guile/$(GUILE_EFFECTIVE_VERSION)/ccache
-
-SOURCES = \
- assimp.scm \
- assimp/low-level.scm \
- assimp/low-level/cimport.scm \
- assimp/low-level/color.scm \
- assimp/low-level/material.scm \
- assimp/low-level/matrix.scm \
- assimp/low-level/mesh.scm \
- assimp/low-level/postprocess.scm \
- assimp/low-level/scene.scm \
- assimp/low-level/types.scm \
- assimp/low-level/vector.scm
-
-EXTRA_DIST += env.in COPYING examples README
+EXTRA_DIST = COPYING env.in examples README
TESTS_ENVIRONMENT = $(top_builddir)/env $(GUILE) --no-auto-compile
+++ /dev/null
-;;; guile-assimp, foreign interface to libassimp
-;;; Copyright (C) 2014 by Javier Sancho Fernandez <jsf at jsancho dot org>
-;;;
-;;; This program is free software: you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation, either version 3 of the License, or
-;;; (at your option) any later version.
-;;;
-;;; This program is distributed in the hope that it will be useful,
-;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-
-(define-module (assimp)
- #:use-module (assimp low-level)
- #:use-module (assimp low-level cimport)
- #:use-module (assimp low-level color)
- #:use-module (assimp low-level material)
- #:use-module (assimp low-level matrix)
- #:use-module (assimp low-level mesh)
- #:use-module (assimp low-level postprocess)
- #:use-module (assimp low-level scene)
- #:use-module (assimp low-level types)
- #:use-module (assimp low-level vector)
- #:use-module (system foreign)
- #:export (ai-import-file
- ai-release-import
- ai-attach-predefined-log-stream
- ai-transform-vec-by-matrix4
- ai-multiply-matrix3
- ai-multiply-matrix4
- ai-identity-matrix3
- ai-identity-matrix4
- ai-transpose-matrix3
- ai-transpose-matrix4)
- #:re-export (ai-material-key
- ai-process-steps
- ai-process-convert-to-left-handed
- ai-process-preset-target-realtime-fast
- ai-process-preset-target-realtime-quality
- ai-process-preset-target-realtime-max-quality
- ai-default-log-stream
- (aiDetachAllLogStreams . ai-detach-all-log-streams)))
-
-
-;;; Scenes
-
-(define-conversion-type parse-aiScene -> ai-scene
- (flags (field 'mFlags))
- (root-node (wrap (field 'mRootNode) wrap-ai-node))
- (meshes (wrap (array (field 'mNumMeshes) (field 'mMeshes)) wrap-ai-mesh))
- (materials (wrap (array (field 'mNumMaterials) (field 'mMaterials)) wrap-ai-material))
- (animations (array (field 'mNumAnimations) (field 'mAnimations)))
- (textures (array (field 'mNumTextures) (field 'mTextures)))
- (lights (array (field 'mNumLights) (field 'mLights)))
- (cameras (array (field 'mNumCameras) (field 'mCameras))))
-
-(export ai-scene?
- ai-scene-contents
- ai-scene-flags
- ai-scene-root-node
- ai-scene-meshes
- ai-scene-materials
- ai-scene-animations
- ai-scene-textures
- ai-scene-lights
- ai-scene-cameras)
-
-
-;;; Nodes
-
-(define-conversion-type parse-aiNode -> ai-node
- (name (sized-string (field 'mName)))
- (transformation (wrap (parse-aiMatrix4x4 (field 'mTransformation) #:reverse #t) wrap-ai-matrix4x4))
- (parent (wrap (field 'mParent) wrap-ai-node))
- (children (wrap (array (field 'mNumChildren) (field 'mChildren)) wrap-ai-node))
- (meshes (array (field 'mNumMeshes) (field 'mMeshes))))
-
-(export ai-node?
- ai-node-contents
- ai-node-name
- ai-node-transformation
- ai-node-parent
- ai-node-children
- ai-node-meshes)
-
-
-;;; Meshes
-
-(define-conversion-type parse-aiMesh -> ai-mesh
- (name (sized-string (field 'mName)))
- (primitive-types (field 'mPrimitiveTypes))
- (vertices (wrap
- (array (field 'mNumVertices) (field 'mVertices) #:element-size 12 #:element-proc get-element-address)
- wrap-ai-vector3d))
- (faces (wrap
- (array (field 'mNumFaces) (field 'mFaces) #:element-size 8 #:element-proc get-element-address)
- wrap-ai-face))
- (normals (wrap
- (array (field 'mNumVertices) (field 'mNormals) #:element-size 12 #:element-proc get-element-address)
- wrap-ai-vector3d))
- (tangents (wrap
- (array (field 'mNumVertices) (field 'mTangents) #:element-size 12 #:element-proc get-element-address)
- wrap-ai-vector3d))
- (bitangents (wrap
- (array (field 'mNumVertices) (field 'mBitangents) #:element-size 12 #:element-proc get-element-address)
- wrap-ai-vector3d))
- (colors (map
- (lambda (c)
- (wrap
- (array (field 'mNumVertices) c #:element-size 16 #:element-proc get-element-address)
- wrap-ai-color4d))
- (field 'mColors)))
- (texture-coords (map
- (lambda (tc)
- (wrap
- (array (field 'mNumVertices) tc #:element-size 12 #:element-proc get-element-address)
- wrap-ai-vector3d))
- (field 'mTextureCoords)))
- (num-uv-components (field 'mNumUVComponents))
- (bones (wrap (array (field 'mNumBones) (field 'mBones)) wrap-ai-bone))
- (material-index (field 'mMaterialIndex)))
-
-(export ai-mesh?
- ai-mesh-contents
- ai-mesh-name
- ai-mesh-primitive-types
- ai-mesh-vertices
- ai-mesh-faces
- ai-mesh-normals
- ai-mesh-tangents
- ai-mesh-bitangents
- ai-mesh-colors
- ai-mesh-texture-coords
- ai-mesh-num-uv-components
- ai-mesh-bones
- ai-mesh-material-index)
-
-
-;;; Materials
-
-(define-conversion-type parse-aiMaterial -> ai-material
- (properties (array (field 'mNumProperties) (field 'mProperties)))
- (num-allocated (field 'mNumAllocated)))
-
-(export ai-material?
- ai-material-contents
- ai-material-properties
- ai-material-num-allocated)
-
-
-(define-public (ai-get-material-color mat color-type)
- (let ((pmat (unwrap-ai-material mat))
- (pkey (string->pointer (car color-type)))
- (type (cadr color-type))
- (index (caddr color-type))
- (pout (parse-aiColor4D (make-list 4 0) #:reverse #t)))
- (let ((res (aiGetMaterialColor pmat pkey type index pout)))
- (if (< res 0)
- res
- (wrap-ai-color4d pout)))))
-
-(define-public (ai-get-material-float-array mat color-type max)
- (let ((pmat (unwrap-ai-material mat))
- (pkey (string->pointer (car color-type)))
- (type (cadr color-type))
- (index (caddr color-type))
- (pout (bytevector->pointer (list->f32vector (make-list max 0))))
- (pmax (bytevector->pointer (list->u32vector (list max)))))
- (let ((res (aiGetMaterialFloatArray pmat pkey type index pout pmax)))
- (if (< res 0)
- res
- (f32vector->list (pointer->bytevector pout max 0 'f32))))))
-
-(define-public (ai-get-material-integer-array mat color-type max)
- (let ((pmat (unwrap-ai-material mat))
- (pkey (string->pointer (car color-type)))
- (type (cadr color-type))
- (index (caddr color-type))
- (pout (bytevector->pointer (list->s32vector (make-list max 0))))
- (pmax (bytevector->pointer (list->u32vector (list max)))))
- (let ((res (aiGetMaterialIntegerArray pmat pkey type index pout pmax)))
- (if (< res 0)
- res
- (s32vector->list (pointer->bytevector pout max 0 's32))))))
-
-
-;;; Faces
-
-(define-conversion-type parse-aiFace -> ai-face
- (indices (array (field 'mNumIndices) (field 'mIndices))))
-
-(export ai-face?
- ai-face-contents
- ai-face-indices)
-
-
-;;; Vectors
-
-(define-conversion-type parse-aiVector2D -> ai-vector2d
- (x (field 'x))
- (y (field 'y)))
-
-(export ai-vector2d?
- ai-vector2d-contents
- ai-vector2d-x
- ai-vector2d-y)
-
-(define-conversion-type parse-aiVector3D -> ai-vector3d
- (x (field 'x))
- (y (field 'y))
- (z (field 'z)))
-
-(export ai-vector3d?
- ai-vector3d-contents
- ai-vector3d-x
- ai-vector3d-y
- ai-vector3d-z)
-
-
-;;; Matrixes
-
-(define-conversion-type parse-aiMatrix3x3 -> ai-matrix3x3
- (a1 (field 'a1))
- (a2 (field 'a2))
- (a3 (field 'a3))
- (b1 (field 'b1))
- (b2 (field 'b2))
- (b3 (field 'b3))
- (c1 (field 'c1))
- (c2 (field 'c2))
- (c3 (field 'c3)))
-
-(export ai-matrix3x3?
- ai-matrix3x3-contents
- ai-matrix3x3-a1
- ai-matrix3x3-a2
- ai-matrix3x3-a3
- ai-matrix3x3-b1
- ai-matrix3x3-b2
- ai-matrix3x3-b3
- ai-matrix3x3-c1
- ai-matrix3x3-c2
- ai-matrix3x3-c3)
-
-(define-conversion-type parse-aiMatrix4x4 -> ai-matrix4x4
- (a1 (field 'a1))
- (a2 (field 'a2))
- (a3 (field 'a3))
- (a4 (field 'a4))
- (b1 (field 'b1))
- (b2 (field 'b2))
- (b3 (field 'b3))
- (b4 (field 'b4))
- (c1 (field 'c1))
- (c2 (field 'c2))
- (c3 (field 'c3))
- (c4 (field 'c4))
- (d1 (field 'd1))
- (d2 (field 'd2))
- (d3 (field 'd3))
- (d4 (field 'd4)))
-
-(export ai-matrix4x4?
- ai-matrix4x4-contents
- ai-matrix4x4-a1
- ai-matrix4x4-a2
- ai-matrix4x4-a3
- ai-matrix4x4-a4
- ai-matrix4x4-b1
- ai-matrix4x4-b2
- ai-matrix4x4-b3
- ai-matrix4x4-b4
- ai-matrix4x4-c1
- ai-matrix4x4-c2
- ai-matrix4x4-c3
- ai-matrix4x4-c4
- ai-matrix4x4-d1
- ai-matrix4x4-d2
- ai-matrix4x4-d3
- ai-matrix4x4-d4)
-
-
-;;; Colors
-
-(define-conversion-type parse-aiColor4D -> ai-color4d
- (r (field 'r))
- (g (field 'g))
- (b (field 'b))
- (a (field 'a)))
-
-(export ai-color4d?
- ai-color4d-contents
- ai-color4d-r
- ai-color4d-g
- ai-color4d-b
- ai-color4d-a)
-
-
-;;; Bones
-
-(define-conversion-type parse-aiBone -> ai-bone
- (name (sized-string (field 'mName)))
- (weights (wrap
- (array (field 'mNumWeights) (field 'mWeights) #:element-size 8 #:element-proc get-element-address)
- wrap-ai-vertex-weight))
- (offset-matrix (wrap (parse-aiMatrix4x4 (field 'mOffsetMatrix) #:reverse #t) wrap-ai-matrix4x4)))
-
-(export ai-bone?
- ai-bone-contents
- ai-bone-name
- ai-bone-weights
- ai-bone-offset-matrix)
-
-
-;;; Weights
-
-(define-conversion-type parse-aiVertexWeight -> ai-vertex-weight
- (vertex-id (field 'mVertexId))
- (weight (field 'mWeight)))
-
-(export ai-vertex-weight?
- ai-vertex-weight-contents
- ai-vertex-weight-vertex-id
- ai-vertex-weight-weight)
-
-
-;;; Functions
-
-(define (ai-import-file filename flags)
- (wrap-ai-scene
- (aiImportFile (string->pointer filename)
- flags)))
-
-(define (ai-release-import scene)
- (aiReleaseImport (unwrap-ai-scene scene)))
-
-(define* (ai-attach-predefined-log-stream type #:optional file)
- (aiAttachLogStream
- (aiGetPredefinedLogStream
- type
- (if file
- (string->pointer file)
- %null-pointer))))
-
-(define (ai-transform-vec-by-matrix4 vec mat)
- (let ((cvec (parse-aiVector3D (map cdr (ai-vector3d-contents vec)) #:reverse #t))
- (cmat (parse-aiMatrix4x4 (map cdr (ai-matrix4x4-contents mat)) #:reverse #t)))
- (aiTransformVecByMatrix4 cvec cmat)
- (wrap-ai-vector3d cvec)))
-
-(define (ai-multiply-matrix3 m1 m2)
- (let ((cm1 (parse-aiMatrix3x3 (map cdr (ai-matrix3x3-contents m1)) #:reverse #t))
- (cm2 (parse-aiMatrix3x3 (map cdr (ai-matrix3x3-contents m2)) #:reverse #t)))
- (aiMultiplyMatrix3 cm1 cm2)
- (wrap-ai-matrix3x3 cm1)))
-
-(define (ai-multiply-matrix4 m1 m2)
- (let ((cm1 (parse-aiMatrix4x4 (map cdr (ai-matrix4x4-contents m1)) #:reverse #t))
- (cm2 (parse-aiMatrix4x4 (map cdr (ai-matrix4x4-contents m2)) #:reverse #t)))
- (aiMultiplyMatrix4 cm1 cm2)
- (wrap-ai-matrix4x4 cm1)))
-
-(define (ai-identity-matrix3)
- (let ((cmat (parse-aiMatrix3x3 (make-list 9 0) #:reverse #t)))
- (aiIdentityMatrix3 cmat)
- (wrap-ai-matrix3x3 cmat)))
-
-(define (ai-identity-matrix4)
- (let ((cmat (parse-aiMatrix4x4 (make-list 16 0) #:reverse #t)))
- (aiIdentityMatrix4 cmat)
- (wrap-ai-matrix4x4 cmat)))
-
-(define (ai-transpose-matrix3 mat)
- (let ((cmat (parse-aiMatrix3x3 (map cdr (ai-matrix3x3-contents mat)) #:reverse #t)))
- (aiTransposeMatrix3 cmat)
- (wrap-ai-matrix3x3 cmat)))
-
-(define (ai-transpose-matrix4 mat)
- (let ((cmat (parse-aiMatrix4x4 (map cdr (ai-matrix4x4-contents mat)) #:reverse #t)))
- (aiTransposeMatrix4 cmat)
- (wrap-ai-matrix4x4 cmat)))
+++ /dev/null
-;;; guile-assimp, foreign interface to libassimp
-;;; Copyright (C) 2014 by Javier Sancho Fernandez <jsf at jsancho dot org>
-;;;
-;;; This program is free software: you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation, either version 3 of the License, or
-;;; (at your option) any later version.
-;;;
-;;; This program is distributed in the hope that it will be useful,
-;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-
-(define-module (assimp low-level)
- #:use-module (ice-9 iconv)
- #:use-module (rnrs bytevectors)
- #:use-module (system foreign))
-
-
-;;; Generic Functions
-
-(define (mk-string . args)
- (string-concatenate
- (map (lambda (a)
- (if (string? a)
- a
- (symbol->string (syntax->datum a))))
- args)))
-
-(define (lambda-mk-symbol x)
- (lambda args
- (datum->syntax x
- (string->symbol
- (apply mk-string args)))))
-
-
-;;; Parsers Definition
-
-(define-syntax define-struct-parser
- (lambda (x)
- (syntax-case x ()
- ((_ name (field type) ...)
- (with-syntax (((field-name ...) (map car #'((field type) ...)))
- ((field-type ...) (map cadr #'((field type) ...))))
- #'(define* (name pointer-or-data #:key (reverse #f))
- (cond (reverse
- (make-c-struct
- (list field-type ...)
- pointer-or-data))
- (else
- (map cons
- '(field-name ...)
- (parse-c-struct pointer-or-data (list field-type ...)))))))))))
-
-(export-syntax define-struct-parser)
-
-
-;;; Type Generation
-
-(define-syntax define-conversion-type
- (lambda (x)
- (define mk-symbol (lambda-mk-symbol x))
- (syntax-case x (->)
- ((_ parser -> name (field-name field-proc) ...)
- (with-syntax ((type? (mk-symbol #'name "?"))
- (wrap-type (mk-symbol "wrap-" #'name))
- (unwrap-type (mk-symbol "unwrap-" #'name))
- (output-string (mk-string "#<" #'name " ~x>"))
- (type-contents (mk-symbol #'name "-contents"))
- (type-parse (mk-symbol #'name "-parse"))
- ((field-reader ...) (map (lambda (f) (mk-symbol #'name "-" (car f))) #'((field-name field-proc) ...))))
- #'(begin
- (define-wrapped-pointer-type name
- type?
- wrap-type unwrap-type
- (lambda (x p)
- (format p output-string
- (pointer-address (unwrap-type x)))))
- (define (type-parse wrapped)
- (let ((unwrapped (unwrap-type wrapped)))
- (cond ((= (pointer-address unwrapped) 0)
- '())
- (else
- (parser unwrapped)))))
- (define-type-contents type-contents type-parse (field-name field-proc) ...)
- (define-field-reader field-reader type-parse field-proc)
- ...
- ))))))
-
-(define-macro (define-type-contents type-contents type-parse . fields)
- `(define (,type-contents wrapped)
- (let ((alist (,type-parse wrapped)))
- (list ,@(map (lambda (f)
- `(cons ',(car f) ,(cadr f)))
- fields)))))
-
-(define-macro (define-field-reader field-reader type-parse body)
- `(define (,field-reader wrapped)
- (let ((alist (,type-parse wrapped)))
- ,body)))
-
-(define-macro (field name)
- `(assoc-ref alist ,name))
-
-(export-syntax define-conversion-type
- field)
-
-
-;;; Support functions for type generation
-
-(define (bv-uint-ref pointer index)
- (bytevector-uint-ref
- (pointer->bytevector pointer 4 index)
- 0
- (native-endianness)
- 4))
-
-(define* (array size root #:key (element-size 4) (element-proc bv-uint-ref))
- (cond ((= (pointer-address root) 0)
- '())
- (else
- (reverse
- (let loop ((i 0) (res '()))
- (cond ((= i size)
- res)
- (else
- (loop (+ i 1) (cons (element-proc root (* element-size i)) res)))))))))
-
-(define (get-element-address root-pointer offset)
- (make-pointer (+ (pointer-address root-pointer) offset)))
-
-(define (sized-string s)
- (cond (s
- (bytevector->string
- (u8-list->bytevector (list-head (cadr s) (car s)))
- (fluid-ref %default-port-encoding)))
- (else
- #f)))
-
-(define (wrap pointers wrap-proc)
- (define (make-wrap element)
- (let ((pointer
- (cond ((pointer? element)
- (if (= (pointer-address element) 0)
- #f
- element))
- ((= element 0)
- #f)
- (else
- (make-pointer element)))))
- (cond (pointer
- (wrap-proc pointer))
- (else
- #f))))
- (cond ((list? pointers)
- (map make-wrap pointers))
- (else
- (make-wrap pointers))))
-
-(export array
- get-element-address
- sized-string
- wrap)
-
-
-;;; Function Mappers
-
-(define-syntax define-foreign-function
- (lambda (x)
- (syntax-case x (->)
- ((_ ((foreign-lib name) arg-type ...) -> return-type)
- (with-syntax ((name-string (datum->syntax x (symbol->string (syntax->datum #'name)))))
- #'(define name
- (pointer->procedure return-type
- (dynamic-func name-string foreign-lib)
- (list arg-type ...))))))))
-
-
-(define libassimp (dynamic-link "libassimp"))
-
-(define-syntax define-assimp-function
- (syntax-rules (->)
- ((_ (name arg-type ...) -> return-type)
- (define-foreign-function ((libassimp name) arg-type ...) -> return-type))))
-
-
-(export-syntax define-foreign-function
- define-assimp-function)
-
-
-;;; Enumerators and bitfields (copìed from figl code, thanks to Andy Wingo
-
-(define-syntax-rule (define-enumeration enumerator (name value) ...)
- (define-syntax enumerator
- (lambda (x)
- (syntax-case x ()
- ((_)
- #''(name ...))
- ((_ enum) (number? (syntax->datum #'enum))
- #'enum)
- ((_ enum)
- #'(or (assq-ref `((name . ,(syntax->datum value)) ...)
- (syntax->datum #'enum))
- (syntax-violation 'enumerator "invalid enumerated value"
- #'enum)))))))
-
-(define-syntax-rule (define-bitfield bitfield (name value) ...)
- (define-syntax bitfield
- (lambda (x)
- (syntax-case x ()
- ((_)
- #''(name ...))
- ((_ bit (... ...))
- #`(logior
- #,@(map
- (lambda (bit)
- (let ((datum (syntax->datum bit)))
- (if (number? datum)
- datum
- (or (assq-ref '((name . value) ...) datum)
- (syntax-violation 'bitfield "invalid bitfield value"
- bit)))))
- #'(bit (... ...)))))))))
-
-(export-syntax define-enumeration
- define-bitfield)
+++ /dev/null
-;;; guile-assimp, foreign interface to libassimp
-;;; Copyright (C) 2014 by Javier Sancho Fernandez <jsf at jsancho dot org>
-;;;
-;;; This program is free software: you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation, either version 3 of the License, or
-;;; (at your option) any later version.
-;;;
-;;; This program is distributed in the hope that it will be useful,
-;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-
-(define-module (assimp low-level cimport)
- #:use-module (assimp low-level)
- #:use-module (system foreign)
- #:export (aiImportFile
- aiReleaseImport
- aiGetPredefinedLogStream
- aiAttachLogStream
- aiDetachAllLogStreams
- aiTransformVecByMatrix4
- aiMultiplyMatrix3
- aiMultiplyMatrix4
- aiIdentityMatrix3
- aiIdentityMatrix4
- aiTransposeMatrix3
- aiTransposeMatrix4))
-
-(define-assimp-function (aiImportFile '* unsigned-int) -> '*)
-(define-assimp-function (aiReleaseImport '*) -> void)
-(define-assimp-function (aiGetPredefinedLogStream unsigned-int '*) -> (list '* '* '*))
-(define-assimp-function (aiAttachLogStream '*) -> void)
-(define-assimp-function (aiDetachAllLogStreams) -> void)
-
-(define-assimp-function (aiTransformVecByMatrix4 '* '*) -> void)
-(define-assimp-function (aiMultiplyMatrix3 '* '*) -> void)
-(define-assimp-function (aiMultiplyMatrix4 '* '*) -> void)
-(define-assimp-function (aiIdentityMatrix3 '*) -> void)
-(define-assimp-function (aiIdentityMatrix4 '*) -> void)
-(define-assimp-function (aiTransposeMatrix3 '*) -> void)
-(define-assimp-function (aiTransposeMatrix4 '*) -> void)
+++ /dev/null
-;;; guile-assimp, foreign interface to libassimp
-;;; Copyright (C) 2014 by Javier Sancho Fernandez <jsf at jsancho dot org>
-;;;
-;;; This program is free software: you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation, either version 3 of the License, or
-;;; (at your option) any later version.
-;;;
-;;; This program is distributed in the hope that it will be useful,
-;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-
-(define-module (assimp low-level color)
- #:use-module (assimp low-level)
- #:use-module (system foreign))
-
-
-(define-struct-parser parse-aiColor4D
- (r float)
- (g float)
- (b float)
- (a float))
-
-(export parse-aiColor4D)
+++ /dev/null
-;;; guile-assimp, foreign interface to libassimp
-;;; Copyright (C) 2014 by Javier Sancho Fernandez <jsf at jsancho dot org>
-;;;
-;;; This program is free software: you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation, either version 3 of the License, or
-;;; (at your option) any later version.
-;;;
-;;; This program is distributed in the hope that it will be useful,
-;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-
-(define-module (assimp low-level material)
- #:use-module (assimp low-level)
- #:use-module (assimp low-level types)
- #:use-module (system foreign)
- #:export (parse-aiMaterial
- parse-aiMaterialProperty
- ai-material-key
- aiGetMaterialColor
- aiGetMaterialFloatArray
- aiGetMaterialIntegerArray))
-
-
-(define-struct-parser parse-aiMaterialProperty
- (mKey aiString-type)
- (mSemantic unsigned-int)
- (mIndex unsigned-int)
- (mDataLength unsigned-int)
- (mType unsigned-int)
- (mData '*))
-
-(define-struct-parser parse-aiMaterial
- (mProperties '*)
- (mNumProperties unsigned-int)
- (mNumAllocated unsigned-int))
-
-
-(define-enumeration
- ai-material-key
- (name '("?mat.name" 0 0))
- (twosided '("$mat.twosided" 0 0))
- (shading-model '("$mat.shadingm" 0 0))
- (enable-wireframe '("$mat.wireframe" 0 0))
- (blend-func '("$mat.blend" 0 0))
- (opacity '("$mat.opacity" 0 0))
- (bumpscaling '("$mat.bumpscaling" 0 0))
- (shininess '("$mat.shininess" 0 0))
- (reflectivity '("$mat.reflectivity" 0 0))
- (shininess-strength '("$mat.shinpercent" 0 0))
- (refracti '("$mat.refracti" 0 0))
- (color-diffuse '("$clr.diffuse" 0 0))
- (color-ambient '("$clr.ambient" 0 0))
- (color-specular '("$clr.specular" 0 0))
- (color-emissive '("$clr.emissive" 0 0))
- (color-transparent '("$clr.transparent" 0 0))
- (color-reflective '("$clr.reflective" 0 0))
- (global-background-image '("?bg.global" 0 0)))
-
-
-(define-assimp-function (aiGetMaterialColor '* '* unsigned-int unsigned-int '*) -> int)
-(define-assimp-function (aiGetMaterialFloatArray '* '* unsigned-int unsigned-int '* '*) -> int)
-(define-assimp-function (aiGetMaterialIntegerArray '* '* unsigned-int unsigned-int '* '*) -> int)
+++ /dev/null
-;;; guile-assimp, foreign interface to libassimp
-;;; Copyright (C) 2014 by Javier Sancho Fernandez <jsf at jsancho dot org>
-;;;
-;;; This program is free software: you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation, either version 3 of the License, or
-;;; (at your option) any later version.
-;;;
-;;; This program is distributed in the hope that it will be useful,
-;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-
-(define-module (assimp low-level matrix)
- #:use-module (assimp low-level)
- #:use-module (system foreign))
-
-
-(define-struct-parser parse-aiMatrix3x3
- (a1 float)
- (a2 float)
- (a3 float)
- (b1 float)
- (b2 float)
- (b3 float)
- (c1 float)
- (c2 float)
- (c3 float))
-
-(define-struct-parser parse-aiMatrix4x4
- (a1 float)
- (a2 float)
- (a3 float)
- (a4 float)
- (b1 float)
- (b2 float)
- (b3 float)
- (b4 float)
- (c1 float)
- (c2 float)
- (c3 float)
- (c4 float)
- (d1 float)
- (d2 float)
- (d3 float)
- (d4 float))
-
-(export parse-aiMatrix3x3
- parse-aiMatrix4x4)
+++ /dev/null
-;;; guile-assimp, foreign interface to libassimp
-;;; Copyright (C) 2014 by Javier Sancho Fernandez <jsf at jsancho dot org>
-;;;
-;;; This program is free software: you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation, either version 3 of the License, or
-;;; (at your option) any later version.
-;;;
-;;; This program is distributed in the hope that it will be useful,
-;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-
-(define-module (assimp low-level mesh)
- #:use-module (assimp low-level)
- #:use-module (assimp low-level types)
- #:use-module (system foreign))
-
-
-(define-struct-parser parse-aiFace
- (mNumIndices unsigned-int)
- (mIndices '*))
-
-(export parse-aiFace)
-
-
-(define-struct-parser parser-aiVertexWeight
- (mVertexId unsigned-int)
- (mWeight float))
-
-(export parse-aiVertexWeight)
-
-
-(define-struct-parser parse-aiBone
- (mName aiString-type)
- (mNumWeights unsigned-int)
- (mWeights '*)
- (mOffsetMatrix aiMatrix4x4-type))
-
-(export parse-aiBone)
-
-
-(define AI_MAX_NUMBER_OF_COLOR_SETS #x8)
-(define AI_MAX_NUMBER_OF_TEXTURECOORDS #x8)
-
-(define-struct-parser parse-aiMesh
- (mPrimitiveTypes unsigned-int)
- (mNumVertices unsigned-int)
- (mNumFaces unsigned-int)
- (mVertices '*)
- (mNormals '*)
- (mTangents '*)
- (mBitangents '*)
- (mColors (make-list AI_MAX_NUMBER_OF_COLOR_SETS '*))
- (mTextureCoords (make-list AI_MAX_NUMBER_OF_TEXTURECOORDS '*))
- (mNumUVComponents (make-list AI_MAX_NUMBER_OF_TEXTURECOORDS unsigned-int))
- (mFaces '*)
- (mNumBones unsigned-int)
- (mBones '*)
- (mMaterialIndex unsigned-int)
- (mName aiString-type)
- (mNumAnimMeshes unsigned-int)
- (mAnimMeshes '*))
-
-(export parse-aiMesh)
+++ /dev/null
-;;; guile-assimp, foreign interface to libassimp
-;;; Copyright (C) 2014 by Javier Sancho Fernandez <jsf at jsancho dot org>
-;;;
-;;; This program is free software: you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation, either version 3 of the License, or
-;;; (at your option) any later version.
-;;;
-;;; This program is distributed in the hope that it will be useful,
-;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-
-(define-module (assimp low-level postprocess)
- #:use-module (assimp low-level)
- #:export (ai-process-steps
- ai-process-convert-to-left-handed
- ai-process-preset-target-realtime-fast
- ai-process-preset-target-realtime-quality
- ai-process-preset-target-realtime-max-quality))
-
-
-(define-bitfield
- ai-process-steps
- (calc-tangent-space #x1)
- (join-identical-vertices #x2)
- (make-left-handed #x4)
- (triangulate #x8)
- (remove-component #x10)
- (gen-normals #x20)
- (gen-smooth-normals #x40)
- (split-large-meshes #x80)
- (pretransform-vertices #x100)
- (limit-bone-weights #x200)
- (validate-data-structure #x400)
- (improve-cache-locality #x800)
- (remove-redundant-materials #x1000)
- (fix-infacing-normals #x2000)
- (sort-by-ptype #x8000)
- (find-degenerates #x10000)
- (find-invalid-data #x20000)
- (gen-UV-coords #x40000)
- (transform-UV-coords #x80000)
- (find-instances #x100000)
- (optimize-meshes #x200000)
- (optimize-graph #x400000)
- (flip-UVs #x800000)
- (flip-winding-order #x1000000)
- (split-by-bone-count #x2000000)
- (debone #x4000000))
-
-(define ai-process-convert-to-left-handed
- (ai-process-steps
- make-left-handed
- flip-UVs
- flip-winding-order))
-
-(define ai-process-preset-target-realtime-fast
- (ai-process-steps
- calc-tangent-space
- gen-normals
- join-identical-vertices
- triangulate
- gen-UV-coords
- sort-by-ptype))
-
-(define ai-process-preset-target-realtime-quality
- (ai-process-steps
- calc-tangent-space
- gen-smooth-normals
- join-identical-vertices
- improve-cache-locality
- limit-bone-weights
- remove-redundant-materials
- split-large-meshes
- triangulate
- gen-UV-coords
- sort-by-ptype
- find-degenerates
- find-invalid-data))
-
-(define ai-process-preset-target-realtime-max-quality
- (+ ai-process-preset-target-realtime-quality
- (ai-process-steps
- find-instances
- validate-data-structure
- optimize-meshes
- debone)))
+++ /dev/null
-;;; guile-assimp, foreign interface to libassimp
-;;; Copyright (C) 2014 by Javier Sancho Fernandez <jsf at jsancho dot org>
-;;;
-;;; This program is free software: you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation, either version 3 of the License, or
-;;; (at your option) any later version.
-;;;
-;;; This program is distributed in the hope that it will be useful,
-;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-
-(define-module (assimp low-level scene)
- #:use-module (assimp low-level)
- #:use-module (assimp low-level types)
- #:use-module (system foreign))
-
-
-(define-struct-parser parse-aiNode
- (mName aiString-type)
- (mTransformation aiMatrix4x4-type)
- (mParent '*)
- (mNumChildren unsigned-int)
- (mChildren '*)
- (mNumMeshes unsigned-int)
- (mMeshes '*))
-
-(export parse-aiNode)
-
-
-(define-struct-parser parse-aiScene
- (mFlags unsigned-int)
- (mRootNode '*)
- (mNumMeshes unsigned-int)
- (mMeshes '*)
- (mNumMaterials unsigned-int)
- (mMaterials '*)
- (mNumAnimations unsigned-int)
- (mAnimations '*)
- (mNumTextures unsigned-int)
- (mTextures '*)
- (mNumLights unsigned-int)
- (mLights '*)
- (mNumCameras unsigned-int)
- (mCameras '*)
- (mPrivate '*))
-
-(export parse-aiScene)
+++ /dev/null
-;;; guile-assimp, foreign interface to libassimp
-;;; Copyright (C) 2014 by Javier Sancho Fernandez <jsf at jsancho dot org>
-;;;
-;;; This program is free software: you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation, either version 3 of the License, or
-;;; (at your option) any later version.
-;;;
-;;; This program is distributed in the hope that it will be useful,
-;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-
-(define-module (assimp low-level types)
- #:use-module (assimp low-level)
- #:use-module (system foreign)
- #:export (aiString-type
- aiMatrix4x4-type
- ai-default-log-stream))
-
-
-(define aiString-type
- (list size_t (make-list 1024 int8)))
-
-(define aiMatrix4x4-type
- (make-list 16 float))
-
-(define-enumeration
- ai-default-log-stream
- (file #x1)
- (stdout #x2)
- (stderr #x4)
- (debugger #x8)
- (ai-dls-enforce-enum-size #x7fffffff))
+++ /dev/null
-;;; guile-assimp, foreign interface to libassimp
-;;; Copyright (C) 2014 by Javier Sancho Fernandez <jsf at jsancho dot org>
-;;;
-;;; This program is free software: you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation, either version 3 of the License, or
-;;; (at your option) any later version.
-;;;
-;;; This program is distributed in the hope that it will be useful,
-;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-
-(define-module (assimp low-level vector)
- #:use-module (assimp low-level)
- #:use-module (system foreign))
-
-
-(define-struct-parser parse-aiVector2D
- (x float)
- (y float))
-
-(define-struct-parser parse-aiVector3D
- (x float)
- (y float)
- (z float))
-
-(export parse-aiVector2D
- parse-aiVector3D)
])
-AC_CONFIG_SRCDIR(assimp.scm)
+AC_CONFIG_SRCDIR(src/assimp.scm)
AC_CONFIG_AUX_DIR([build-aux])
AM_INIT_AUTOMAKE([-Wall -Wno-portability foreign])
AM_SILENT_RULES([yes])
GUILE_PKG([2.2 2.0])
GUILE_PROGS
-AC_CONFIG_FILES([Makefile])
+AC_CHECK_LIB([assimp], [aiImportFile], [],
+ [AC_MSG_FAILURE([assimp not found (required)])])
+
+AC_CONFIG_FILES([Makefile src/Makefile])
AC_CONFIG_FILES([env], [chmod +x env])
AC_OUTPUT
$(guile_install_go_files): install-nobase_modDATA
CLEANFILES = $(GOBJECTS)
-EXTRA_DIST = $(SOURCES) $(NOCOMP_SOURCES)
GUILE_WARNINGS = -Wunbound-variable -Warity-mismatch -Wformat
SUFFIXES = .scm .go
.scm.go:
--- /dev/null
+## Process this file with automake to produce Makefile.in.
+##
+## guile-assimp, foreign interface to libassimp
+## Copyright (C) 2014 by Javier Sancho Fernandez <jsf at jsancho dot org>
+##
+## This program is free software: you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation, either version 3 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+include ../guile.am
+
+moddir=$(prefix)/share/guile/site/$(GUILE_EFFECTIVE_VERSION)
+godir=$(libdir)/guile/$(GUILE_EFFECTIVE_VERSION)/ccache
+
+SOURCES = \
+ assimp.scm \
+ assimp/low-level.scm \
+ assimp/low-level/cimport.scm \
+ assimp/low-level/color.scm \
+ assimp/low-level/material.scm \
+ assimp/low-level/matrix.scm \
+ assimp/low-level/mesh.scm \
+ assimp/low-level/postprocess.scm \
+ assimp/low-level/scene.scm \
+ assimp/low-level/types.scm \
+ assimp/low-level/vector.scm
--- /dev/null
+;;; guile-assimp, foreign interface to libassimp
+;;; Copyright (C) 2014 by Javier Sancho Fernandez <jsf at jsancho dot org>
+;;;
+;;; This program is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation, either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+
+(define-module (assimp)
+ #:use-module (assimp low-level)
+ #:use-module (assimp low-level cimport)
+ #:use-module (assimp low-level color)
+ #:use-module (assimp low-level material)
+ #:use-module (assimp low-level matrix)
+ #:use-module (assimp low-level mesh)
+ #:use-module (assimp low-level postprocess)
+ #:use-module (assimp low-level scene)
+ #:use-module (assimp low-level types)
+ #:use-module (assimp low-level vector)
+ #:use-module (system foreign)
+ #:export (ai-import-file
+ ai-release-import
+ ai-attach-predefined-log-stream
+ ai-transform-vec-by-matrix4
+ ai-multiply-matrix3
+ ai-multiply-matrix4
+ ai-identity-matrix3
+ ai-identity-matrix4
+ ai-transpose-matrix3
+ ai-transpose-matrix4)
+ #:re-export (ai-material-key
+ ai-process-steps
+ ai-process-convert-to-left-handed
+ ai-process-preset-target-realtime-fast
+ ai-process-preset-target-realtime-quality
+ ai-process-preset-target-realtime-max-quality
+ ai-default-log-stream
+ (aiDetachAllLogStreams . ai-detach-all-log-streams)))
+
+
+;;; Scenes
+
+(define-conversion-type parse-aiScene -> ai-scene
+ (flags (field 'mFlags))
+ (root-node (wrap (field 'mRootNode) wrap-ai-node))
+ (meshes (wrap (array (field 'mNumMeshes) (field 'mMeshes)) wrap-ai-mesh))
+ (materials (wrap (array (field 'mNumMaterials) (field 'mMaterials)) wrap-ai-material))
+ (animations (array (field 'mNumAnimations) (field 'mAnimations)))
+ (textures (array (field 'mNumTextures) (field 'mTextures)))
+ (lights (array (field 'mNumLights) (field 'mLights)))
+ (cameras (array (field 'mNumCameras) (field 'mCameras))))
+
+(export ai-scene?
+ ai-scene-contents
+ ai-scene-flags
+ ai-scene-root-node
+ ai-scene-meshes
+ ai-scene-materials
+ ai-scene-animations
+ ai-scene-textures
+ ai-scene-lights
+ ai-scene-cameras)
+
+
+;;; Nodes
+
+(define-conversion-type parse-aiNode -> ai-node
+ (name (sized-string (field 'mName)))
+ (transformation (wrap (parse-aiMatrix4x4 (field 'mTransformation) #:reverse #t) wrap-ai-matrix4x4))
+ (parent (wrap (field 'mParent) wrap-ai-node))
+ (children (wrap (array (field 'mNumChildren) (field 'mChildren)) wrap-ai-node))
+ (meshes (array (field 'mNumMeshes) (field 'mMeshes))))
+
+(export ai-node?
+ ai-node-contents
+ ai-node-name
+ ai-node-transformation
+ ai-node-parent
+ ai-node-children
+ ai-node-meshes)
+
+
+;;; Meshes
+
+(define-conversion-type parse-aiMesh -> ai-mesh
+ (name (sized-string (field 'mName)))
+ (primitive-types (field 'mPrimitiveTypes))
+ (vertices (wrap
+ (array (field 'mNumVertices) (field 'mVertices) #:element-size 12 #:element-proc get-element-address)
+ wrap-ai-vector3d))
+ (faces (wrap
+ (array (field 'mNumFaces) (field 'mFaces) #:element-size 8 #:element-proc get-element-address)
+ wrap-ai-face))
+ (normals (wrap
+ (array (field 'mNumVertices) (field 'mNormals) #:element-size 12 #:element-proc get-element-address)
+ wrap-ai-vector3d))
+ (tangents (wrap
+ (array (field 'mNumVertices) (field 'mTangents) #:element-size 12 #:element-proc get-element-address)
+ wrap-ai-vector3d))
+ (bitangents (wrap
+ (array (field 'mNumVertices) (field 'mBitangents) #:element-size 12 #:element-proc get-element-address)
+ wrap-ai-vector3d))
+ (colors (map
+ (lambda (c)
+ (wrap
+ (array (field 'mNumVertices) c #:element-size 16 #:element-proc get-element-address)
+ wrap-ai-color4d))
+ (field 'mColors)))
+ (texture-coords (map
+ (lambda (tc)
+ (wrap
+ (array (field 'mNumVertices) tc #:element-size 12 #:element-proc get-element-address)
+ wrap-ai-vector3d))
+ (field 'mTextureCoords)))
+ (num-uv-components (field 'mNumUVComponents))
+ (bones (wrap (array (field 'mNumBones) (field 'mBones)) wrap-ai-bone))
+ (material-index (field 'mMaterialIndex)))
+
+(export ai-mesh?
+ ai-mesh-contents
+ ai-mesh-name
+ ai-mesh-primitive-types
+ ai-mesh-vertices
+ ai-mesh-faces
+ ai-mesh-normals
+ ai-mesh-tangents
+ ai-mesh-bitangents
+ ai-mesh-colors
+ ai-mesh-texture-coords
+ ai-mesh-num-uv-components
+ ai-mesh-bones
+ ai-mesh-material-index)
+
+
+;;; Materials
+
+(define-conversion-type parse-aiMaterial -> ai-material
+ (properties (array (field 'mNumProperties) (field 'mProperties)))
+ (num-allocated (field 'mNumAllocated)))
+
+(export ai-material?
+ ai-material-contents
+ ai-material-properties
+ ai-material-num-allocated)
+
+
+(define-public (ai-get-material-color mat color-type)
+ (let ((pmat (unwrap-ai-material mat))
+ (pkey (string->pointer (car color-type)))
+ (type (cadr color-type))
+ (index (caddr color-type))
+ (pout (parse-aiColor4D (make-list 4 0) #:reverse #t)))
+ (let ((res (aiGetMaterialColor pmat pkey type index pout)))
+ (if (< res 0)
+ res
+ (wrap-ai-color4d pout)))))
+
+(define-public (ai-get-material-float-array mat color-type max)
+ (let ((pmat (unwrap-ai-material mat))
+ (pkey (string->pointer (car color-type)))
+ (type (cadr color-type))
+ (index (caddr color-type))
+ (pout (bytevector->pointer (list->f32vector (make-list max 0))))
+ (pmax (bytevector->pointer (list->u32vector (list max)))))
+ (let ((res (aiGetMaterialFloatArray pmat pkey type index pout pmax)))
+ (if (< res 0)
+ res
+ (f32vector->list (pointer->bytevector pout max 0 'f32))))))
+
+(define-public (ai-get-material-integer-array mat color-type max)
+ (let ((pmat (unwrap-ai-material mat))
+ (pkey (string->pointer (car color-type)))
+ (type (cadr color-type))
+ (index (caddr color-type))
+ (pout (bytevector->pointer (list->s32vector (make-list max 0))))
+ (pmax (bytevector->pointer (list->u32vector (list max)))))
+ (let ((res (aiGetMaterialIntegerArray pmat pkey type index pout pmax)))
+ (if (< res 0)
+ res
+ (s32vector->list (pointer->bytevector pout max 0 's32))))))
+
+
+;;; Faces
+
+(define-conversion-type parse-aiFace -> ai-face
+ (indices (array (field 'mNumIndices) (field 'mIndices))))
+
+(export ai-face?
+ ai-face-contents
+ ai-face-indices)
+
+
+;;; Vectors
+
+(define-conversion-type parse-aiVector2D -> ai-vector2d
+ (x (field 'x))
+ (y (field 'y)))
+
+(export ai-vector2d?
+ ai-vector2d-contents
+ ai-vector2d-x
+ ai-vector2d-y)
+
+(define-conversion-type parse-aiVector3D -> ai-vector3d
+ (x (field 'x))
+ (y (field 'y))
+ (z (field 'z)))
+
+(export ai-vector3d?
+ ai-vector3d-contents
+ ai-vector3d-x
+ ai-vector3d-y
+ ai-vector3d-z)
+
+
+;;; Matrixes
+
+(define-conversion-type parse-aiMatrix3x3 -> ai-matrix3x3
+ (a1 (field 'a1))
+ (a2 (field 'a2))
+ (a3 (field 'a3))
+ (b1 (field 'b1))
+ (b2 (field 'b2))
+ (b3 (field 'b3))
+ (c1 (field 'c1))
+ (c2 (field 'c2))
+ (c3 (field 'c3)))
+
+(export ai-matrix3x3?
+ ai-matrix3x3-contents
+ ai-matrix3x3-a1
+ ai-matrix3x3-a2
+ ai-matrix3x3-a3
+ ai-matrix3x3-b1
+ ai-matrix3x3-b2
+ ai-matrix3x3-b3
+ ai-matrix3x3-c1
+ ai-matrix3x3-c2
+ ai-matrix3x3-c3)
+
+(define-conversion-type parse-aiMatrix4x4 -> ai-matrix4x4
+ (a1 (field 'a1))
+ (a2 (field 'a2))
+ (a3 (field 'a3))
+ (a4 (field 'a4))
+ (b1 (field 'b1))
+ (b2 (field 'b2))
+ (b3 (field 'b3))
+ (b4 (field 'b4))
+ (c1 (field 'c1))
+ (c2 (field 'c2))
+ (c3 (field 'c3))
+ (c4 (field 'c4))
+ (d1 (field 'd1))
+ (d2 (field 'd2))
+ (d3 (field 'd3))
+ (d4 (field 'd4)))
+
+(export ai-matrix4x4?
+ ai-matrix4x4-contents
+ ai-matrix4x4-a1
+ ai-matrix4x4-a2
+ ai-matrix4x4-a3
+ ai-matrix4x4-a4
+ ai-matrix4x4-b1
+ ai-matrix4x4-b2
+ ai-matrix4x4-b3
+ ai-matrix4x4-b4
+ ai-matrix4x4-c1
+ ai-matrix4x4-c2
+ ai-matrix4x4-c3
+ ai-matrix4x4-c4
+ ai-matrix4x4-d1
+ ai-matrix4x4-d2
+ ai-matrix4x4-d3
+ ai-matrix4x4-d4)
+
+
+;;; Colors
+
+(define-conversion-type parse-aiColor4D -> ai-color4d
+ (r (field 'r))
+ (g (field 'g))
+ (b (field 'b))
+ (a (field 'a)))
+
+(export ai-color4d?
+ ai-color4d-contents
+ ai-color4d-r
+ ai-color4d-g
+ ai-color4d-b
+ ai-color4d-a)
+
+
+;;; Bones
+
+(define-conversion-type parse-aiBone -> ai-bone
+ (name (sized-string (field 'mName)))
+ (weights (wrap
+ (array (field 'mNumWeights) (field 'mWeights) #:element-size 8 #:element-proc get-element-address)
+ wrap-ai-vertex-weight))
+ (offset-matrix (wrap (parse-aiMatrix4x4 (field 'mOffsetMatrix) #:reverse #t) wrap-ai-matrix4x4)))
+
+(export ai-bone?
+ ai-bone-contents
+ ai-bone-name
+ ai-bone-weights
+ ai-bone-offset-matrix)
+
+
+;;; Weights
+
+(define-conversion-type parse-aiVertexWeight -> ai-vertex-weight
+ (vertex-id (field 'mVertexId))
+ (weight (field 'mWeight)))
+
+(export ai-vertex-weight?
+ ai-vertex-weight-contents
+ ai-vertex-weight-vertex-id
+ ai-vertex-weight-weight)
+
+
+;;; Functions
+
+(define (ai-import-file filename flags)
+ (wrap-ai-scene
+ (aiImportFile (string->pointer filename)
+ flags)))
+
+(define (ai-release-import scene)
+ (aiReleaseImport (unwrap-ai-scene scene)))
+
+(define* (ai-attach-predefined-log-stream type #:optional file)
+ (aiAttachLogStream
+ (aiGetPredefinedLogStream
+ type
+ (if file
+ (string->pointer file)
+ %null-pointer))))
+
+(define (ai-transform-vec-by-matrix4 vec mat)
+ (let ((cvec (parse-aiVector3D (map cdr (ai-vector3d-contents vec)) #:reverse #t))
+ (cmat (parse-aiMatrix4x4 (map cdr (ai-matrix4x4-contents mat)) #:reverse #t)))
+ (aiTransformVecByMatrix4 cvec cmat)
+ (wrap-ai-vector3d cvec)))
+
+(define (ai-multiply-matrix3 m1 m2)
+ (let ((cm1 (parse-aiMatrix3x3 (map cdr (ai-matrix3x3-contents m1)) #:reverse #t))
+ (cm2 (parse-aiMatrix3x3 (map cdr (ai-matrix3x3-contents m2)) #:reverse #t)))
+ (aiMultiplyMatrix3 cm1 cm2)
+ (wrap-ai-matrix3x3 cm1)))
+
+(define (ai-multiply-matrix4 m1 m2)
+ (let ((cm1 (parse-aiMatrix4x4 (map cdr (ai-matrix4x4-contents m1)) #:reverse #t))
+ (cm2 (parse-aiMatrix4x4 (map cdr (ai-matrix4x4-contents m2)) #:reverse #t)))
+ (aiMultiplyMatrix4 cm1 cm2)
+ (wrap-ai-matrix4x4 cm1)))
+
+(define (ai-identity-matrix3)
+ (let ((cmat (parse-aiMatrix3x3 (make-list 9 0) #:reverse #t)))
+ (aiIdentityMatrix3 cmat)
+ (wrap-ai-matrix3x3 cmat)))
+
+(define (ai-identity-matrix4)
+ (let ((cmat (parse-aiMatrix4x4 (make-list 16 0) #:reverse #t)))
+ (aiIdentityMatrix4 cmat)
+ (wrap-ai-matrix4x4 cmat)))
+
+(define (ai-transpose-matrix3 mat)
+ (let ((cmat (parse-aiMatrix3x3 (map cdr (ai-matrix3x3-contents mat)) #:reverse #t)))
+ (aiTransposeMatrix3 cmat)
+ (wrap-ai-matrix3x3 cmat)))
+
+(define (ai-transpose-matrix4 mat)
+ (let ((cmat (parse-aiMatrix4x4 (map cdr (ai-matrix4x4-contents mat)) #:reverse #t)))
+ (aiTransposeMatrix4 cmat)
+ (wrap-ai-matrix4x4 cmat)))
--- /dev/null
+;;; guile-assimp, foreign interface to libassimp
+;;; Copyright (C) 2014 by Javier Sancho Fernandez <jsf at jsancho dot org>
+;;;
+;;; This program is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation, either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+
+(define-module (assimp low-level)
+ #:use-module (ice-9 iconv)
+ #:use-module (rnrs bytevectors)
+ #:use-module (system foreign))
+
+
+;;; Generic Functions
+
+(define (mk-string . args)
+ (string-concatenate
+ (map (lambda (a)
+ (if (string? a)
+ a
+ (symbol->string (syntax->datum a))))
+ args)))
+
+(define (lambda-mk-symbol x)
+ (lambda args
+ (datum->syntax x
+ (string->symbol
+ (apply mk-string args)))))
+
+
+;;; Parsers Definition
+
+(define-syntax define-struct-parser
+ (lambda (x)
+ (syntax-case x ()
+ ((_ name (field type) ...)
+ (with-syntax (((field-name ...) (map car #'((field type) ...)))
+ ((field-type ...) (map cadr #'((field type) ...))))
+ #'(define* (name pointer-or-data #:key (reverse #f))
+ (cond (reverse
+ (make-c-struct
+ (list field-type ...)
+ pointer-or-data))
+ (else
+ (map cons
+ '(field-name ...)
+ (parse-c-struct pointer-or-data (list field-type ...)))))))))))
+
+(export-syntax define-struct-parser)
+
+
+;;; Type Generation
+
+(define-syntax define-conversion-type
+ (lambda (x)
+ (define mk-symbol (lambda-mk-symbol x))
+ (syntax-case x (->)
+ ((_ parser -> name (field-name field-proc) ...)
+ (with-syntax ((type? (mk-symbol #'name "?"))
+ (wrap-type (mk-symbol "wrap-" #'name))
+ (unwrap-type (mk-symbol "unwrap-" #'name))
+ (output-string (mk-string "#<" #'name " ~x>"))
+ (type-contents (mk-symbol #'name "-contents"))
+ (type-parse (mk-symbol #'name "-parse"))
+ ((field-reader ...) (map (lambda (f) (mk-symbol #'name "-" (car f))) #'((field-name field-proc) ...))))
+ #'(begin
+ (define-wrapped-pointer-type name
+ type?
+ wrap-type unwrap-type
+ (lambda (x p)
+ (format p output-string
+ (pointer-address (unwrap-type x)))))
+ (define (type-parse wrapped)
+ (let ((unwrapped (unwrap-type wrapped)))
+ (cond ((= (pointer-address unwrapped) 0)
+ '())
+ (else
+ (parser unwrapped)))))
+ (define-type-contents type-contents type-parse (field-name field-proc) ...)
+ (define-field-reader field-reader type-parse field-proc)
+ ...
+ ))))))
+
+(define-macro (define-type-contents type-contents type-parse . fields)
+ `(define (,type-contents wrapped)
+ (let ((alist (,type-parse wrapped)))
+ (list ,@(map (lambda (f)
+ `(cons ',(car f) ,(cadr f)))
+ fields)))))
+
+(define-macro (define-field-reader field-reader type-parse body)
+ `(define (,field-reader wrapped)
+ (let ((alist (,type-parse wrapped)))
+ ,body)))
+
+(define-macro (field name)
+ `(assoc-ref alist ,name))
+
+(export-syntax define-conversion-type
+ field)
+
+
+;;; Support functions for type generation
+
+(define (bv-uint-ref pointer index)
+ (bytevector-uint-ref
+ (pointer->bytevector pointer 4 index)
+ 0
+ (native-endianness)
+ 4))
+
+(define* (array size root #:key (element-size 4) (element-proc bv-uint-ref))
+ (cond ((= (pointer-address root) 0)
+ '())
+ (else
+ (reverse
+ (let loop ((i 0) (res '()))
+ (cond ((= i size)
+ res)
+ (else
+ (loop (+ i 1) (cons (element-proc root (* element-size i)) res)))))))))
+
+(define (get-element-address root-pointer offset)
+ (make-pointer (+ (pointer-address root-pointer) offset)))
+
+(define (sized-string s)
+ (cond (s
+ (bytevector->string
+ (u8-list->bytevector (list-head (cadr s) (car s)))
+ (fluid-ref %default-port-encoding)))
+ (else
+ #f)))
+
+(define (wrap pointers wrap-proc)
+ (define (make-wrap element)
+ (let ((pointer
+ (cond ((pointer? element)
+ (if (= (pointer-address element) 0)
+ #f
+ element))
+ ((= element 0)
+ #f)
+ (else
+ (make-pointer element)))))
+ (cond (pointer
+ (wrap-proc pointer))
+ (else
+ #f))))
+ (cond ((list? pointers)
+ (map make-wrap pointers))
+ (else
+ (make-wrap pointers))))
+
+(export array
+ get-element-address
+ sized-string
+ wrap)
+
+
+;;; Function Mappers
+
+(define-syntax define-foreign-function
+ (lambda (x)
+ (syntax-case x (->)
+ ((_ ((foreign-lib name) arg-type ...) -> return-type)
+ (with-syntax ((name-string (datum->syntax x (symbol->string (syntax->datum #'name)))))
+ #'(define name
+ (pointer->procedure return-type
+ (dynamic-func name-string foreign-lib)
+ (list arg-type ...))))))))
+
+
+(define libassimp (dynamic-link "libassimp"))
+
+(define-syntax define-assimp-function
+ (syntax-rules (->)
+ ((_ (name arg-type ...) -> return-type)
+ (define-foreign-function ((libassimp name) arg-type ...) -> return-type))))
+
+
+(export-syntax define-foreign-function
+ define-assimp-function)
+
+
+;;; Enumerators and bitfields (copìed from figl code, thanks to Andy Wingo
+
+(define-syntax-rule (define-enumeration enumerator (name value) ...)
+ (define-syntax enumerator
+ (lambda (x)
+ (syntax-case x ()
+ ((_)
+ #''(name ...))
+ ((_ enum) (number? (syntax->datum #'enum))
+ #'enum)
+ ((_ enum)
+ #'(or (assq-ref `((name . ,(syntax->datum value)) ...)
+ (syntax->datum #'enum))
+ (syntax-violation 'enumerator "invalid enumerated value"
+ #'enum)))))))
+
+(define-syntax-rule (define-bitfield bitfield (name value) ...)
+ (define-syntax bitfield
+ (lambda (x)
+ (syntax-case x ()
+ ((_)
+ #''(name ...))
+ ((_ bit (... ...))
+ #`(logior
+ #,@(map
+ (lambda (bit)
+ (let ((datum (syntax->datum bit)))
+ (if (number? datum)
+ datum
+ (or (assq-ref '((name . value) ...) datum)
+ (syntax-violation 'bitfield "invalid bitfield value"
+ bit)))))
+ #'(bit (... ...)))))))))
+
+(export-syntax define-enumeration
+ define-bitfield)
--- /dev/null
+;;; guile-assimp, foreign interface to libassimp
+;;; Copyright (C) 2014 by Javier Sancho Fernandez <jsf at jsancho dot org>
+;;;
+;;; This program is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation, either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+
+(define-module (assimp low-level cimport)
+ #:use-module (assimp low-level)
+ #:use-module (system foreign)
+ #:export (aiImportFile
+ aiReleaseImport
+ aiGetPredefinedLogStream
+ aiAttachLogStream
+ aiDetachAllLogStreams
+ aiTransformVecByMatrix4
+ aiMultiplyMatrix3
+ aiMultiplyMatrix4
+ aiIdentityMatrix3
+ aiIdentityMatrix4
+ aiTransposeMatrix3
+ aiTransposeMatrix4))
+
+(define-assimp-function (aiImportFile '* unsigned-int) -> '*)
+(define-assimp-function (aiReleaseImport '*) -> void)
+(define-assimp-function (aiGetPredefinedLogStream unsigned-int '*) -> (list '* '* '*))
+(define-assimp-function (aiAttachLogStream '*) -> void)
+(define-assimp-function (aiDetachAllLogStreams) -> void)
+
+(define-assimp-function (aiTransformVecByMatrix4 '* '*) -> void)
+(define-assimp-function (aiMultiplyMatrix3 '* '*) -> void)
+(define-assimp-function (aiMultiplyMatrix4 '* '*) -> void)
+(define-assimp-function (aiIdentityMatrix3 '*) -> void)
+(define-assimp-function (aiIdentityMatrix4 '*) -> void)
+(define-assimp-function (aiTransposeMatrix3 '*) -> void)
+(define-assimp-function (aiTransposeMatrix4 '*) -> void)
--- /dev/null
+;;; guile-assimp, foreign interface to libassimp
+;;; Copyright (C) 2014 by Javier Sancho Fernandez <jsf at jsancho dot org>
+;;;
+;;; This program is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation, either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+
+(define-module (assimp low-level color)
+ #:use-module (assimp low-level)
+ #:use-module (system foreign))
+
+
+(define-struct-parser parse-aiColor4D
+ (r float)
+ (g float)
+ (b float)
+ (a float))
+
+(export parse-aiColor4D)
--- /dev/null
+;;; guile-assimp, foreign interface to libassimp
+;;; Copyright (C) 2014 by Javier Sancho Fernandez <jsf at jsancho dot org>
+;;;
+;;; This program is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation, either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+
+(define-module (assimp low-level material)
+ #:use-module (assimp low-level)
+ #:use-module (assimp low-level types)
+ #:use-module (system foreign)
+ #:export (parse-aiMaterial
+ parse-aiMaterialProperty
+ ai-material-key
+ aiGetMaterialColor
+ aiGetMaterialFloatArray
+ aiGetMaterialIntegerArray))
+
+
+(define-struct-parser parse-aiMaterialProperty
+ (mKey aiString-type)
+ (mSemantic unsigned-int)
+ (mIndex unsigned-int)
+ (mDataLength unsigned-int)
+ (mType unsigned-int)
+ (mData '*))
+
+(define-struct-parser parse-aiMaterial
+ (mProperties '*)
+ (mNumProperties unsigned-int)
+ (mNumAllocated unsigned-int))
+
+
+(define-enumeration
+ ai-material-key
+ (name '("?mat.name" 0 0))
+ (twosided '("$mat.twosided" 0 0))
+ (shading-model '("$mat.shadingm" 0 0))
+ (enable-wireframe '("$mat.wireframe" 0 0))
+ (blend-func '("$mat.blend" 0 0))
+ (opacity '("$mat.opacity" 0 0))
+ (bumpscaling '("$mat.bumpscaling" 0 0))
+ (shininess '("$mat.shininess" 0 0))
+ (reflectivity '("$mat.reflectivity" 0 0))
+ (shininess-strength '("$mat.shinpercent" 0 0))
+ (refracti '("$mat.refracti" 0 0))
+ (color-diffuse '("$clr.diffuse" 0 0))
+ (color-ambient '("$clr.ambient" 0 0))
+ (color-specular '("$clr.specular" 0 0))
+ (color-emissive '("$clr.emissive" 0 0))
+ (color-transparent '("$clr.transparent" 0 0))
+ (color-reflective '("$clr.reflective" 0 0))
+ (global-background-image '("?bg.global" 0 0)))
+
+
+(define-assimp-function (aiGetMaterialColor '* '* unsigned-int unsigned-int '*) -> int)
+(define-assimp-function (aiGetMaterialFloatArray '* '* unsigned-int unsigned-int '* '*) -> int)
+(define-assimp-function (aiGetMaterialIntegerArray '* '* unsigned-int unsigned-int '* '*) -> int)
--- /dev/null
+;;; guile-assimp, foreign interface to libassimp
+;;; Copyright (C) 2014 by Javier Sancho Fernandez <jsf at jsancho dot org>
+;;;
+;;; This program is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation, either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+
+(define-module (assimp low-level matrix)
+ #:use-module (assimp low-level)
+ #:use-module (system foreign))
+
+
+(define-struct-parser parse-aiMatrix3x3
+ (a1 float)
+ (a2 float)
+ (a3 float)
+ (b1 float)
+ (b2 float)
+ (b3 float)
+ (c1 float)
+ (c2 float)
+ (c3 float))
+
+(define-struct-parser parse-aiMatrix4x4
+ (a1 float)
+ (a2 float)
+ (a3 float)
+ (a4 float)
+ (b1 float)
+ (b2 float)
+ (b3 float)
+ (b4 float)
+ (c1 float)
+ (c2 float)
+ (c3 float)
+ (c4 float)
+ (d1 float)
+ (d2 float)
+ (d3 float)
+ (d4 float))
+
+(export parse-aiMatrix3x3
+ parse-aiMatrix4x4)
--- /dev/null
+;;; guile-assimp, foreign interface to libassimp
+;;; Copyright (C) 2014 by Javier Sancho Fernandez <jsf at jsancho dot org>
+;;;
+;;; This program is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation, either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+
+(define-module (assimp low-level mesh)
+ #:use-module (assimp low-level)
+ #:use-module (assimp low-level types)
+ #:use-module (system foreign))
+
+
+(define-struct-parser parse-aiFace
+ (mNumIndices unsigned-int)
+ (mIndices '*))
+
+(export parse-aiFace)
+
+
+(define-struct-parser parser-aiVertexWeight
+ (mVertexId unsigned-int)
+ (mWeight float))
+
+(export parse-aiVertexWeight)
+
+
+(define-struct-parser parse-aiBone
+ (mName aiString-type)
+ (mNumWeights unsigned-int)
+ (mWeights '*)
+ (mOffsetMatrix aiMatrix4x4-type))
+
+(export parse-aiBone)
+
+
+(define AI_MAX_NUMBER_OF_COLOR_SETS #x8)
+(define AI_MAX_NUMBER_OF_TEXTURECOORDS #x8)
+
+(define-struct-parser parse-aiMesh
+ (mPrimitiveTypes unsigned-int)
+ (mNumVertices unsigned-int)
+ (mNumFaces unsigned-int)
+ (mVertices '*)
+ (mNormals '*)
+ (mTangents '*)
+ (mBitangents '*)
+ (mColors (make-list AI_MAX_NUMBER_OF_COLOR_SETS '*))
+ (mTextureCoords (make-list AI_MAX_NUMBER_OF_TEXTURECOORDS '*))
+ (mNumUVComponents (make-list AI_MAX_NUMBER_OF_TEXTURECOORDS unsigned-int))
+ (mFaces '*)
+ (mNumBones unsigned-int)
+ (mBones '*)
+ (mMaterialIndex unsigned-int)
+ (mName aiString-type)
+ (mNumAnimMeshes unsigned-int)
+ (mAnimMeshes '*))
+
+(export parse-aiMesh)
--- /dev/null
+;;; guile-assimp, foreign interface to libassimp
+;;; Copyright (C) 2014 by Javier Sancho Fernandez <jsf at jsancho dot org>
+;;;
+;;; This program is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation, either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+
+(define-module (assimp low-level postprocess)
+ #:use-module (assimp low-level)
+ #:export (ai-process-steps
+ ai-process-convert-to-left-handed
+ ai-process-preset-target-realtime-fast
+ ai-process-preset-target-realtime-quality
+ ai-process-preset-target-realtime-max-quality))
+
+
+(define-bitfield
+ ai-process-steps
+ (calc-tangent-space #x1)
+ (join-identical-vertices #x2)
+ (make-left-handed #x4)
+ (triangulate #x8)
+ (remove-component #x10)
+ (gen-normals #x20)
+ (gen-smooth-normals #x40)
+ (split-large-meshes #x80)
+ (pretransform-vertices #x100)
+ (limit-bone-weights #x200)
+ (validate-data-structure #x400)
+ (improve-cache-locality #x800)
+ (remove-redundant-materials #x1000)
+ (fix-infacing-normals #x2000)
+ (sort-by-ptype #x8000)
+ (find-degenerates #x10000)
+ (find-invalid-data #x20000)
+ (gen-UV-coords #x40000)
+ (transform-UV-coords #x80000)
+ (find-instances #x100000)
+ (optimize-meshes #x200000)
+ (optimize-graph #x400000)
+ (flip-UVs #x800000)
+ (flip-winding-order #x1000000)
+ (split-by-bone-count #x2000000)
+ (debone #x4000000))
+
+(define ai-process-convert-to-left-handed
+ (ai-process-steps
+ make-left-handed
+ flip-UVs
+ flip-winding-order))
+
+(define ai-process-preset-target-realtime-fast
+ (ai-process-steps
+ calc-tangent-space
+ gen-normals
+ join-identical-vertices
+ triangulate
+ gen-UV-coords
+ sort-by-ptype))
+
+(define ai-process-preset-target-realtime-quality
+ (ai-process-steps
+ calc-tangent-space
+ gen-smooth-normals
+ join-identical-vertices
+ improve-cache-locality
+ limit-bone-weights
+ remove-redundant-materials
+ split-large-meshes
+ triangulate
+ gen-UV-coords
+ sort-by-ptype
+ find-degenerates
+ find-invalid-data))
+
+(define ai-process-preset-target-realtime-max-quality
+ (+ ai-process-preset-target-realtime-quality
+ (ai-process-steps
+ find-instances
+ validate-data-structure
+ optimize-meshes
+ debone)))
--- /dev/null
+;;; guile-assimp, foreign interface to libassimp
+;;; Copyright (C) 2014 by Javier Sancho Fernandez <jsf at jsancho dot org>
+;;;
+;;; This program is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation, either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+
+(define-module (assimp low-level scene)
+ #:use-module (assimp low-level)
+ #:use-module (assimp low-level types)
+ #:use-module (system foreign))
+
+
+(define-struct-parser parse-aiNode
+ (mName aiString-type)
+ (mTransformation aiMatrix4x4-type)
+ (mParent '*)
+ (mNumChildren unsigned-int)
+ (mChildren '*)
+ (mNumMeshes unsigned-int)
+ (mMeshes '*))
+
+(export parse-aiNode)
+
+
+(define-struct-parser parse-aiScene
+ (mFlags unsigned-int)
+ (mRootNode '*)
+ (mNumMeshes unsigned-int)
+ (mMeshes '*)
+ (mNumMaterials unsigned-int)
+ (mMaterials '*)
+ (mNumAnimations unsigned-int)
+ (mAnimations '*)
+ (mNumTextures unsigned-int)
+ (mTextures '*)
+ (mNumLights unsigned-int)
+ (mLights '*)
+ (mNumCameras unsigned-int)
+ (mCameras '*)
+ (mPrivate '*))
+
+(export parse-aiScene)
--- /dev/null
+;;; guile-assimp, foreign interface to libassimp
+;;; Copyright (C) 2014 by Javier Sancho Fernandez <jsf at jsancho dot org>
+;;;
+;;; This program is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation, either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+
+(define-module (assimp low-level types)
+ #:use-module (assimp low-level)
+ #:use-module (system foreign)
+ #:export (aiString-type
+ aiMatrix4x4-type
+ ai-default-log-stream))
+
+
+(define aiString-type
+ (list size_t (make-list 1024 int8)))
+
+(define aiMatrix4x4-type
+ (make-list 16 float))
+
+(define-enumeration
+ ai-default-log-stream
+ (file #x1)
+ (stdout #x2)
+ (stderr #x4)
+ (debugger #x8)
+ (ai-dls-enforce-enum-size #x7fffffff))
--- /dev/null
+;;; guile-assimp, foreign interface to libassimp
+;;; Copyright (C) 2014 by Javier Sancho Fernandez <jsf at jsancho dot org>
+;;;
+;;; This program is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation, either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+
+(define-module (assimp low-level vector)
+ #:use-module (assimp low-level)
+ #:use-module (system foreign))
+
+
+(define-struct-parser parse-aiVector2D
+ (x float)
+ (y float))
+
+(define-struct-parser parse-aiVector3D
+ (x float)
+ (y float)
+ (z float))
+
+(export parse-aiVector2D
+ parse-aiVector3D)