From 01c04ba62ac137b15ff512353bb72cd4efae5cac Mon Sep 17 00:00:00 2001 From: David Thompson Date: Tue, 7 Jan 2014 19:45:28 -0500 Subject: Make the current agenda a parameter. * 2d/agenda.scm (*current-agenda*, current-agenda): Rename and make parameter. (*global-agenda*, global-agenda): Rename it. --- 2d/agenda.scm | 33 +++++++++++++++------------------ 1 file changed, 15 insertions(+), 18 deletions(-) (limited to '2d') diff --git a/2d/agenda.scm b/2d/agenda.scm index c336ff1..72b672a 100644 --- a/2d/agenda.scm +++ b/2d/agenda.scm @@ -73,20 +73,6 @@ list CALLBACKS." "Create a new, empty agenda." (%make-agenda 0 '())) -;; The global agenda that will be used when schedule is called outside -;; of a with-agenda form. -(define global-agenda (make-agenda)) - -(define *current-agenda* global-agenda) - -;; emacs: (put 'with-agenda 'scheme-indent-function 1) -(define-syntax-rule (with-agenda agenda body ...) - (begin - (set! *current-agenda* agenda) - body - ... - (set! *current-agenda* global-agenda))) - (define (agenda-empty? agenda) "Return #t if AGENDA has no scheduled procedures." (null? (agenda-segments agenda))) @@ -171,17 +157,28 @@ 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 current-agenda (make-parameter *global-agenda*)) + +;; emacs: (put 'with-agenda 'scheme-indent-function 1) +(define-syntax-rule (with-agenda agenda body ...) + (parameterize ((current-agenda agenda)) + body ...)) + (define* (agenda-schedule thunk #:optional (delay 1)) "Schedule THUNK in the current agenda to run after DELAY updates (1 by default)." - (%agenda-schedule *current-agenda* thunk delay)) + (%agenda-schedule (current-agenda) thunk delay)) (define* (agenda-schedule-interval thunk #:optional (interval 1) (delay 1)) "Schedule THUNK in the current agenda to run after DELAY updates and run every INTERVAL updates thereafter. Both DELAY and INTERVAL default to 1. Simply pass THUNK and nothing else to schedule THUNK to be run upon every update." - (%agenda-schedule *current-agenda* + (%agenda-schedule (current-agenda) (lambda () (thunk) (agenda-schedule-interval thunk interval interval)) @@ -189,11 +186,11 @@ upon every update." (define (update-agenda) "Update the current agenda." - (%update-agenda *current-agenda*)) + (%update-agenda (current-agenda))) (define (clear-agenda) "Clear the current agenda." - (%clear-agenda *current-agenda*)) + (%clear-agenda (current-agenda))) (define* (wait #:optional (delay 1)) "Yield coroutine and schdule the continuation to be run after DELAY -- cgit v1.2.3