]> git.jsancho.org Git - guile-assimp.git/commitdiff
Sources Reorganization
authorJavier Sancho <jsf@jsancho.org>
Thu, 21 Aug 2014 07:50:57 +0000 (09:50 +0200)
committerJavier Sancho <jsf@jsancho.org>
Thu, 21 Aug 2014 07:50:57 +0000 (09:50 +0200)
26 files changed:
Makefile.am
assimp.scm [deleted file]
assimp/low-level.scm [deleted file]
assimp/low-level/cimport.scm [deleted file]
assimp/low-level/color.scm [deleted file]
assimp/low-level/material.scm [deleted file]
assimp/low-level/matrix.scm [deleted file]
assimp/low-level/mesh.scm [deleted file]
assimp/low-level/postprocess.scm [deleted file]
assimp/low-level/scene.scm [deleted file]
assimp/low-level/types.scm [deleted file]
assimp/low-level/vector.scm [deleted file]
configure.ac
guile.am
src/Makefile.am [new file with mode: 0644]
src/assimp.scm [new file with mode: 0644]
src/assimp/low-level.scm [new file with mode: 0644]
src/assimp/low-level/cimport.scm [new file with mode: 0644]
src/assimp/low-level/color.scm [new file with mode: 0644]
src/assimp/low-level/material.scm [new file with mode: 0644]
src/assimp/low-level/matrix.scm [new file with mode: 0644]
src/assimp/low-level/mesh.scm [new file with mode: 0644]
src/assimp/low-level/postprocess.scm [new file with mode: 0644]
src/assimp/low-level/scene.scm [new file with mode: 0644]
src/assimp/low-level/types.scm [new file with mode: 0644]
src/assimp/low-level/vector.scm [new file with mode: 0644]

index a9dc6ef8cfeae382f6f80679dd96f1a7bc97c7d9..5ec20c8ace19c75959cabbf61797fcdf3bbc10aa 100644 (file)
 ## 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
diff --git a/assimp.scm b/assimp.scm
deleted file mode 100644 (file)
index 11a3d09..0000000
+++ /dev/null
@@ -1,386 +0,0 @@
-;;; 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)))
diff --git a/assimp/low-level.scm b/assimp/low-level.scm
deleted file mode 100644 (file)
index 148b26d..0000000
+++ /dev/null
@@ -1,230 +0,0 @@
-;;; 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)
diff --git a/assimp/low-level/cimport.scm b/assimp/low-level/cimport.scm
deleted file mode 100644 (file)
index 7f0f259..0000000
+++ /dev/null
@@ -1,46 +0,0 @@
-;;; 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)
diff --git a/assimp/low-level/color.scm b/assimp/low-level/color.scm
deleted file mode 100644 (file)
index bc13274..0000000
+++ /dev/null
@@ -1,29 +0,0 @@
-;;; 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)
diff --git a/assimp/low-level/material.scm b/assimp/low-level/material.scm
deleted file mode 100644 (file)
index 2b3ade1..0000000
+++ /dev/null
@@ -1,68 +0,0 @@
-;;; 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)
diff --git a/assimp/low-level/matrix.scm b/assimp/low-level/matrix.scm
deleted file mode 100644 (file)
index 416b4d0..0000000
+++ /dev/null
@@ -1,53 +0,0 @@
-;;; 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)
diff --git a/assimp/low-level/mesh.scm b/assimp/low-level/mesh.scm
deleted file mode 100644 (file)
index 50d0bb8..0000000
+++ /dev/null
@@ -1,69 +0,0 @@
-;;; 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)
diff --git a/assimp/low-level/postprocess.scm b/assimp/low-level/postprocess.scm
deleted file mode 100644 (file)
index 20ca550..0000000
+++ /dev/null
@@ -1,92 +0,0 @@
-;;; 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)))
diff --git a/assimp/low-level/scene.scm b/assimp/low-level/scene.scm
deleted file mode 100644 (file)
index 651ea3a..0000000
+++ /dev/null
@@ -1,53 +0,0 @@
-;;; 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)
diff --git a/assimp/low-level/types.scm b/assimp/low-level/types.scm
deleted file mode 100644 (file)
index 20e2281..0000000
+++ /dev/null
@@ -1,38 +0,0 @@
-;;; 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))
diff --git a/assimp/low-level/vector.scm b/assimp/low-level/vector.scm
deleted file mode 100644 (file)
index 49b9916..0000000
+++ /dev/null
@@ -1,33 +0,0 @@
-;;; 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)
index d804de3af36b50e28a0643fcf60470a89f9b9e56..9934c258df05fb7feee4cd31965b3727f82385e8 100644 (file)
@@ -21,7 +21,7 @@ along with this program.  If not, see <http://www.gnu.org/licenses/>.
 
 ])
 
-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])
@@ -29,7 +29,10 @@ 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
index dc1e63fb481fa4776d2fd745c6e05c6d61c798fa..085ee777e4c89a8025f311c2b49e5166ff25e5b4 100644 (file)
--- a/guile.am
+++ b/guile.am
@@ -12,7 +12,6 @@ guile_install_go_files = install-nobase_goDATA
 $(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:
diff --git a/src/Makefile.am b/src/Makefile.am
new file mode 100644 (file)
index 0000000..aa0c111
--- /dev/null
@@ -0,0 +1,35 @@
+## 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
diff --git a/src/assimp.scm b/src/assimp.scm
new file mode 100644 (file)
index 0000000..11a3d09
--- /dev/null
@@ -0,0 +1,386 @@
+;;; 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)))
diff --git a/src/assimp/low-level.scm b/src/assimp/low-level.scm
new file mode 100644 (file)
index 0000000..148b26d
--- /dev/null
@@ -0,0 +1,230 @@
+;;; 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)
diff --git a/src/assimp/low-level/cimport.scm b/src/assimp/low-level/cimport.scm
new file mode 100644 (file)
index 0000000..7f0f259
--- /dev/null
@@ -0,0 +1,46 @@
+;;; 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)
diff --git a/src/assimp/low-level/color.scm b/src/assimp/low-level/color.scm
new file mode 100644 (file)
index 0000000..bc13274
--- /dev/null
@@ -0,0 +1,29 @@
+;;; 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)
diff --git a/src/assimp/low-level/material.scm b/src/assimp/low-level/material.scm
new file mode 100644 (file)
index 0000000..2b3ade1
--- /dev/null
@@ -0,0 +1,68 @@
+;;; 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)
diff --git a/src/assimp/low-level/matrix.scm b/src/assimp/low-level/matrix.scm
new file mode 100644 (file)
index 0000000..416b4d0
--- /dev/null
@@ -0,0 +1,53 @@
+;;; 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)
diff --git a/src/assimp/low-level/mesh.scm b/src/assimp/low-level/mesh.scm
new file mode 100644 (file)
index 0000000..50d0bb8
--- /dev/null
@@ -0,0 +1,69 @@
+;;; 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)
diff --git a/src/assimp/low-level/postprocess.scm b/src/assimp/low-level/postprocess.scm
new file mode 100644 (file)
index 0000000..20ca550
--- /dev/null
@@ -0,0 +1,92 @@
+;;; 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)))
diff --git a/src/assimp/low-level/scene.scm b/src/assimp/low-level/scene.scm
new file mode 100644 (file)
index 0000000..651ea3a
--- /dev/null
@@ -0,0 +1,53 @@
+;;; 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)
diff --git a/src/assimp/low-level/types.scm b/src/assimp/low-level/types.scm
new file mode 100644 (file)
index 0000000..20e2281
--- /dev/null
@@ -0,0 +1,38 @@
+;;; 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))
diff --git a/src/assimp/low-level/vector.scm b/src/assimp/low-level/vector.scm
new file mode 100644 (file)
index 0000000..49b9916
--- /dev/null
@@ -0,0 +1,33 @@
+;;; 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)