Remove dynamic scoping of agendas.

* 2d/agenda.scm: (*global-agenda*, current-agenda, with-agenda): Delete.
  (agenda?, agenda-time): Export.
  (schedule-every, schedule-each): Rename schedule-every to
  schedule-each.
  (schedule-next): Delete.
* 2d/game.scm: (game-agenda): New variable.
  (update): Tick game-agenda.
* 2d/repl.scm: Use new agenda API.
* 2d/sprite.scm: Use new agenda API.
* 2d/time.scm: (time-every, time-each, time-delay): Change signature and
  use new agenda API.
* examples/coroutine.scm: Use new agenda API.
* examples/particles.scm: Use new agenda API.

5 files changed, 58 insertions, 87 deletions

diff --git a/2d/agenda.scm b/2d/agenda.scm
index 46d6c12..662aea4 100644
--- a/2d/agenda.scm
+++ b/2d/agenda.scm
@@ -28,15 +28,13 @@
   #:use-module (srfi srfi-26)
   #:use-module (2d coroutine)
   #:export (make-agenda
-            *global-agenda*
-            current-agenda
-            with-agenda
-            schedule
-            schedule-interval
-            schedule-next
-            schedule-every
+            agenda?
+            agenda-time
             tick-agenda!
             clear-agenda!
+            schedule
+            schedule-interval
+            schedule-each
             wait))
 
 ;; This code is a modified version of the agenda implementation in
@@ -113,32 +111,6 @@ and enqueue CALLBACK."
   "Return the sum of the time delta, DT, and the current time of AGENDA."
   (+ (agenda-time agenda) (inexact->exact (round dt))))
 
-(define (%agenda-schedule agenda callback dt)
-  "Schedule the procedure CALLBACK in AGENDA to be run DT updates from now."
-  (let ((time (agenda-time-delay agenda dt)))
-    (define (belongs-before? segments)
-      (or (null? segments)
-          (< time (segment-time (car segments)))))
-
-    (define (add-to-segments segments)
-      ;; Add to existing time segment if the times match
-      (if (= (segment-time (car segments)) time)
-          (segment-enq (car segments) callback)
-          ;; Continue searching
-          (if (belongs-before? (cdr segments))
-              ;; Create new time segment and insert it where it belongs
-              (insert-segment segments time callback)
-              ;; Continue searching
-              (add-to-segments (cdr segments)))))
-
-    ;; Handle the case of inserting a new time segment at the
-    ;; beginning of the segment list.
-    (if (belongs-before? (agenda-segments agenda))
-        ;; Add segment if it belongs at the beginning of the list...
-        (agenda-add-segment agenda time callback)
-        ;; ... Otherwise, search for the right place
-        (add-to-segments (agenda-segments agenda)))))
-
 (define (flush-queue! q)
   "Dequeue and execute every member of Q."
   (unless (q-empty? q)
@@ -162,43 +134,41 @@ and enqueue CALLBACK."
   "Remove all scheduled procedures from AGENDA."
   (set-agenda-segments! agenda '()))
 
-;; The global agenda that will be used when schedule is called outside
-;; of a with-agenda form.
-(define *global-agenda* (make-agenda))
+(define* (schedule agenda thunk #:optional (delay 1))
+  "Schedule the procedure THUNK in AGENDA to be run DELAY ticks from
+now.  DELAY defaults to 1 if not specified."
+  (let ((time (agenda-time-delay agenda delay)))
+    (define (belongs-before? segments)
+      (or (null? segments)
+          (< time (segment-time (car segments)))))
+
+    (define (add-to-segments segments)
+      ;; Add to existing time segment if the times match
+      (if (= (segment-time (car segments)) time)
+          (segment-enq (car segments) thunk)
+          ;; Continue searching
+          (if (belongs-before? (cdr segments))
+              ;; Create new time segment and insert it where it belongs
+              (insert-segment segments time thunk)
+              ;; Continue searching
+              (add-to-segments (cdr segments)))))
+
+    (if (belongs-before? (agenda-segments agenda))
+        (agenda-add-segment agenda time thunk)
+        (add-to-segments (agenda-segments agenda)))))
 
-(define current-agenda (make-parameter *global-agenda*))
+(define (schedule-interval agenda thunk delay)
+  "Schedule THUNK within AGENDA to be applied every DELAY ticks."
+  (schedule agenda
+            (lambda ()
+              (thunk)
+              (schedule-interval agenda thunk delay))))
 
-;; emacs: (put 'with-agenda 'scheme-indent-function 1)
-(define-syntax-rule (with-agenda agenda body ...)
-  (parameterize ((current-agenda agenda))
-    body ...))
+(define (schedule-each agenda thunk)
+  "Schedule THUNK within AGENDA to be applied every tick."
+  (schedule-interval agenda thunk 1))
 
-(define (schedule thunk delay)
-  "Schedule THUNK within the current agenda to be applied after DELAY
-ticks."
-  (%agenda-schedule (current-agenda) thunk delay))
-
-(define* (schedule-interval thunk interval #:optional (delay 1))
-  "Schedule THUNK within the current agenda to be applied after DELAY
-ticks and then to be applied every INTERVAL ticks thereafter.  DELAY
-is 1 by default."
-  (%agenda-schedule (current-agenda)
-                    (lambda ()
-                      (thunk)
-                      (schedule-interval thunk interval interval))
-                    delay))
-
-(define (schedule-next thunk)
-  "Schedule THUNK within the current agenda to be applied upon the
-next tick."
-  (schedule thunk 1))
-
-(define (schedule-every thunk)
-  "Schedule THUNK within the current agenda to be applied upon every
-tick."
-  (schedule-interval thunk 1))
-
-(define* (wait #:optional (delay 1))
+(define (wait agenda delay)
   "Yield coroutine and schedule the continuation to be run after DELAY
-ticks.  DELAY is 1 by default."
-  (yield (cut schedule <> delay)))
+ticks."
+  (yield (cut schedule agenda <> delay)))
diff --git a/2d/game.scm b/2d/game.scm
index 1594b4a..31780d0 100644
--- a/2d/game.scm
+++ b/2d/game.scm
@@ -32,6 +32,7 @@
   #:use-module (2d window)
   #:export (ticks-per-second
             tick-interval
+            game-agenda
             paused-agenda
             draw-hook
             run-game-loop
@@ -54,6 +55,7 @@
 (define tick-interval (make-parameter 0))
 (define draw-hook (make-hook 2))
 (define accumulator (make-parameter 0))
+(define game-agenda (make-agenda))
 ;; This agenda is only ticked when the game loop is in the paused
 ;; state.  Useful for things like the REPL that should be run even
 ;; though the game is paused.
@@ -86,7 +88,7 @@ many times as `tick-interval` can divide ACCUMULATOR. The return value
 is the unused accumulator time."
   (while (>= (accumulator) (tick-interval))
       (process-events)
-      (tick-agenda! *global-agenda*)
+      (tick-agenda! game-agenda)
       (accumulator (- (accumulator) (tick-interval)))))
 
 (define (alpha)
diff --git a/2d/repl/repl.scm b/2d/repl/repl.scm
index 1cc2992..87c5477 100644
--- a/2d/repl/repl.scm
+++ b/2d/repl/repl.scm
@@ -167,9 +167,8 @@ INPUT, OUTPUT, and ERROR ports."
 
 (define poll-interval 5)
 
-(schedule-interval flush-repl poll-interval)
-(with-agenda paused-agenda
-  (schedule-interval flush-repl poll-interval))
+(schedule-interval game-agenda flush-repl poll-interval)
+(schedule-interval paused-agenda flush-repl poll-interval)
 
 ;;;
 ;;; The repl
diff --git a/2d/sprite.scm b/2d/sprite.scm
index a0f13bf..2d6cca0 100644
--- a/2d/sprite.scm
+++ b/2d/sprite.scm
@@ -31,6 +31,7 @@
   #:use-module (2d agenda)
   #:use-module (2d animation)
   #:use-module (2d color)
+  #:use-module (2d game)
   #:use-module (2d helpers)
   #:use-module (2d math)
   #:use-module (2d signals)
@@ -302,7 +303,7 @@ currently bound."
   (hash-clear! animated-sprites))
 
 ;; Update animated sprites upon every update.
-(schedule-every update-animated-sprites!)
+(schedule-each game-agenda update-animated-sprites!)
 
 (export make-sprite
         sprite?
diff --git a/2d/time.scm b/2d/time.scm
index f39bc0e..e17be49 100644
--- a/2d/time.scm
+++ b/2d/time.scm
@@ -29,27 +29,26 @@
             time-each
             time-delay))
 
-(define (time-every ticks value)
-  "Create a new signal that emits VALUE every TICKS agenda updates.  VALUE may
-be a signal, in which case the stored value of the signal will be
-emitted."
+(define (time-every agenda delay value)
+  "Create a new signal that emits VALUE every DELAY ticks of AGENDA.
+VALUE may be a signal, in which case the stored value of the signal
+will be emitted."
   (let ((ticker (make-root-signal (signal-ref-maybe value))))
-    (schedule-interval
-     (lambda ()
-       (signal-set! ticker (signal-ref-maybe value)))
-     ticks)
+    (define (tick)
+      (signal-set! ticker (signal-ref-maybe value)))
+    (schedule-interval agenda tick delay)
     ticker))
 
-(define (time-each value)
+(define (time-each agenda value)
   "Create a new signal that emits VALUE every agenda update."
-  (time-every 1 value))
+  (time-every agenda 1 value))
 
-(define (time-delay ticks signal)
+(define (time-delay agenda delay signal)
   "Create a new signal that delays propagation of values received from
-SIGNAL by TICKS agenda updates."
+SIGNAL by DELAY ticks of AGENDA."
   (make-signal (signal-ref signal)
                (colambda (self from)
                  (let ((value (signal-ref from)))
-                   (wait ticks)
+                   (wait agenda delay)
                    (signal-set! self value)))
                (list signal)))