New struct types ai-matrix3x3 and ai-matrix4x4

[guile-assimp.git] / src / low-level.scm

diff --git a/src/low-level.scm b/src/low-level.scm
index d604789712e14939ca66c66fa64c3a1cb4baf6b3..fd7af9ddea932881e7decdd718c69107d0bde48a 100644 (file)
--- a/src/low-level.scm
+++ b/src/low-level.scm
@@ -21,6 +21,21 @@
   #:use-module (system foreign))
 
 
+(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
@@ -29,10 +44,15 @@
       ((_ name (field type) ...)
        (with-syntax (((field-name ...) (map car #'((field type) ...)))
                     ((field-type ...) (map cadr #'((field type) ...))))
-         #'(define (name pointer)
-            (map cons
-                 '(field-name ...)
-                 (parse-c-struct pointer (list 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)
 
@@ -41,17 +61,7 @@
 
 (define-syntax define-conversion-type
   (lambda (x)
-    (define (mk-string . args)
-      (string-concatenate
-       (map (lambda (a)
-             (if (string? a)
-                 a
-                 (symbol->string (syntax->datum a))))
-           args)))
-    (define (mk-symbol . args)
-      (datum->syntax x
-        (string->symbol
-        (apply mk-string args))))
+    (define mk-symbol (lambda-mk-symbol x))
     (syntax-case x (->)
       ((_ parser -> name (field-name field-proc) ...)
        (with-syntax ((type? (mk-symbol #'name "?"))