Meshes located at video module and new game loop procedure returning game elements

[gacela.git] / src / utils.scm

diff --git a/src/utils.scm b/src/utils.scm
index 28cc16346524e78c189e7ef194906a37e6c9dad0..ed09712d9a990531d9e9daecdc81e1131596aed1 100644 (file)
--- a/src/utils.scm
+++ b/src/utils.scm
@@ -18,7 +18,10 @@
 (define-module (gacela utils)
   #:export (use-cache-with
            arguments-calling
-           arguments-apply))
+           arguments-apply
+           bound?
+           names-arguments
+           make-producer))
 
 
 ;;; Cache for procedures
@@ -44,7 +47,10 @@
 (define (required-arguments args values)
   "Return an alist with required arguments and their values"
   (define (f vars values)
-    (cond ((or (null? vars) (null? values)) '())
+    (cond ((null? vars) '())
+         ((null? values) (assoc-set! (f (cdr vars) '())
+                                     (car vars)
+                                     undefined))
          (else (assoc-set! (f (cdr vars) (cdr values))
                            (car vars)
                            (car values)))))
@@ -139,3 +145,33 @@
            (optional-arguments-apply args values)
            (keyword-arguments-apply args values)
            (rest-arguments-apply args values))))
+
+(define (names-arguments args)
+  (map (lambda (x) (if (list? x) (car x) x))
+       (filter (lambda (x) (not (keyword? x)))
+              (pair-to-list args))))
+
+
+;;; Continuations and coroutines
+
+(define (make-producer body)
+  (define resume #f)
+  (lambda (real-send)
+    (define send-to real-send)
+    (define (send value-to-send)
+      (set! send-to
+           (call/cc
+            (lambda (k)
+              (set! resume k)
+              (send-to value-to-send)))))
+    (if resume
+        (resume real-send)
+        (body send))))
+
+
+;;; Miscellaneous
+
+(define (pair-to-list pair)
+  (cond ((null? pair) '())
+       ((not (pair? pair)) (list pair))
+       (else (cons (car pair) (pair-to-list (cdr pair))))))