From 38d0475fe0cc816d053e37377329d25d6bda0a1b Mon Sep 17 00:00:00 2001
From: Javier Sancho <jsf@jsancho.org>
Date: Thu, 11 May 2017 17:31:25 +0200
Subject: [PATCH] Real at-rate function and init values in reactive context

---
 .../07-rate-based-animations.scm              |  2 +-
 gacela/react.scm                              | 71 +++++++++++++++----
 2 files changed, 58 insertions(+), 15 deletions(-)

diff --git a/examples/07-rate-based-animations/07-rate-based-animations.scm b/examples/07-rate-based-animations/07-rate-based-animations.scm
index 9a4a866..7de2e88 100644
--- a/examples/07-rate-based-animations/07-rate-based-animations.scm
+++ b/examples/07-rate-based-animations/07-rate-based-animations.scm
@@ -23,5 +23,5 @@
 
 (display-scene
   (window ((resolution '(640 480)))
-    (context ((x (- (at-rate 1) 1)))
+    (context ((x (- (at-rate 100) 1)))
       (move bart x 0))))
diff --git a/gacela/react.scm b/gacela/react.scm
index e9d0668..76c76f5 100644
--- a/gacela/react.scm
+++ b/gacela/react.scm
@@ -20,20 +20,63 @@
   #:export (context
             at-rate))
 
+
+;; Time Stack
+
+(define time-stack '())
+
+(define (push-init-time init-time)
+  (set! time-stack (cons init-time time-stack)))
+
+(define (pop-init-time)
+  (set! time-stack (cdr time-stack)))
+
+(define (head-init-time)
+  (car time-stack))
+
+
+;; Reactive context
+
 (define-syntax context
-  (syntax-rules ()
-    ((_ ((variable value)
-         ...)
-        scene)
-     (make-scene
-      "context"
-      (let* ((variable value)
-             ...)
-        (lambda ()
-          (begin
-            (set! variable value)
-            ...)
-          (display-scene scene)))))))
+  (lambda (x)
+    (define (transform vars)
+      (let ((datum (map (lambda (v) (syntax->datum v)) vars)))
+        (map (lambda (v) (datum->syntax x v))
+             (map (lambda (v)
+                    (cond ((and (= (length v) 4) (equal? (caddr v) '<=))
+                           (list (car v) (cadr v) (cadddr v)))
+                          ((= (length v) 2)
+                           (list (car v) (cadr v) 0))
+                          (else
+                           v)))
+                  datum))))
+    (syntax-case x (<=)
+      ((_ ((variable value <= init-value)
+           ...)
+          scene)
+       #'(make-scene
+          "context"
+          (let* ((variable init-value)
+                 ...
+                 (?init-time (get-internal-real-time)))
+            (lambda ()
+              (push-init-time ?init-time)
+              (begin
+                (set! variable value)
+                ...)
+              (display-scene scene)
+              (pop-init-time)))))
+      ((_ ((variable value value* ...)
+           ...)
+          scene)
+       (with-syntax ((((variable1 value1 init-value1) ...) (transform #'((variable value value* ...) ...))))
+         #'(context ((variable1 value1 <= init-value1)
+                     ...)
+                    scene))))))
+
+
+;; Rate based functions
 
 (define (at-rate value)
-  0)
+  (let ((delta (- (get-internal-real-time) (head-init-time))))
+    (* value (/ delta 1000.0))))
-- 
2.39.2