A lot of functionality added

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

diff --git a/src/low-level.scm b/src/low-level.scm
index fd7af9ddea932881e7decdd718c69107d0bde48a..148b26d9b102e5e41b5824c9d095f3785921e54b 100644 (file)
--- a/src/low-level.scm
+++ b/src/low-level.scm
@@ -21,6 +21,8 @@
   #:use-module (system foreign))
 
 
+;;; Generic Functions
+
 (define (mk-string . args)
   (string-concatenate
    (map (lambda (a)
@@ -177,4 +179,52 @@
                                 (dynamic-func name-string foreign-lib)
                                 (list arg-type ...))))))))
 
-(export-syntax define-foreign-function)
+
+(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)