diff options
| -rw-r--r-- | chickadee/scripting.scm | 16 | ||||
| -rw-r--r-- | chickadee/scripting/agenda.scm | 24 | ||||
| -rw-r--r-- | doc/api.texi | 20 |
3 files changed, 53 insertions, 7 deletions
diff --git a/chickadee/scripting.scm b/chickadee/scripting.scm index ff65e86..f8c859d 100644 --- a/chickadee/scripting.scm +++ b/chickadee/scripting.scm @@ -1,5 +1,5 @@ ;;; Chickadee Game Toolkit -;;; Copyright © 2017 David Thompson <davet@gnu.org> +;;; Copyright © 2017, 2020 David Thompson <davet@gnu.org> ;;; ;;; Chickadee is free software: you can redistribute it and/or modify ;;; it under the terms of the GNU General Public License as published @@ -24,6 +24,7 @@ #:export (forever repeat sleep + wait-until tween) #:replace (sleep)) @@ -57,7 +58,18 @@ (yield (lambda (cont) (with-agenda agenda - (schedule-after duration cont)))))) + (schedule-after duration cont)))))) + +(define-syntax-rule (wait-until condition) + "Pause current script until CONDITION has been met." + ;; Don't pause if the condition is already met. + (unless condition + (let ((agenda (current-agenda))) + (yield + (lambda (cont) + (with-agenda agenda + (call-when (lambda () condition) + cont))))))) (define* (tween duration start end proc #:key (step 1) diff --git a/chickadee/scripting/agenda.scm b/chickadee/scripting/agenda.scm index 83cb4b7..a5097dc 100644 --- a/chickadee/scripting/agenda.scm +++ b/chickadee/scripting/agenda.scm @@ -1,5 +1,5 @@ ;;; Chickadee Game Toolkit -;;; Copyright © 2017 David Thompson <davet@gnu.org> +;;; Copyright © 2017, 2020 David Thompson <davet@gnu.org> ;;; ;;; Chickadee is free software: you can redistribute it and/or modify ;;; it under the terms of the GNU General Public License as published @@ -30,28 +30,33 @@ schedule-at schedule-after schedule-every + call-when at after every)) (define-record-type <agenda> - (%make-agenda time queue) + (%make-agenda time queue poll-set) agenda? (time %agenda-time set-agenda-time!) - (queue agenda-queue)) + (queue agenda-queue) + (poll-set agenda-poll-set)) (define (task< a b) (< (car a) (car b))) (define (make-agenda) "Return a new task scheduler." - (%make-agenda 0 (make-heap task<))) + (%make-agenda 0 (make-heap task<) (make-hash-table))) (define (schedule agenda time thunk) (when (<= time (%agenda-time agenda)) (error "cannot schedule in the past" time)) (heap-insert! (agenda-queue agenda) (cons time thunk))) +(define (poll agenda pred thunk) + (hashq-set! (agenda-poll-set agenda) pred thunk)) + (define (%agenda-clear! agenda) (heap-clear! (agenda-queue agenda)) (set-agenda-time! agenda 0) @@ -59,6 +64,7 @@ (define (%update-agenda agenda dt) (let ((queue (agenda-queue agenda)) + (poll-set (agenda-poll-set agenda)) (time (+ (%agenda-time agenda) dt))) (set-agenda-time! agenda time) (let loop () @@ -68,7 +74,12 @@ (when (<= task-time time) (heap-remove! queue) (thunk) - (loop)))))))) + (loop)))))) + (hash-for-each (lambda (pred thunk) + (when (pred) + (hashq-remove! poll-set pred) + (thunk))) + poll-set))) (define current-agenda (make-parameter (make-agenda))) @@ -115,6 +126,9 @@ times, or indefinitely if not specified." (thunk) (schedule-every interval thunk (- n 1))))))) +(define (call-when pred thunk) + (poll (current-agenda) pred thunk)) + (define-syntax-rule (at time body ...) (schedule-at time (lambda () body ...))) diff --git a/doc/api.texi b/doc/api.texi index 9cfa26a..446460e 100644 --- a/doc/api.texi +++ b/doc/api.texi @@ -3985,6 +3985,15 @@ Schedule @var{body} to be evaluated every @var{interval} amount of time. Repeat this @var{n} times, or indefinitely if not specified. @end deffn +It is also possible to schedule things that are not dependent on how +much time passes. The agenda will periodically poll to see if any +registered conditions are met. + +@deffn {Procedure} call-when pred thunk +Call @var{thunk} sometime in the future when @var{pred} is satisfied +(returns a value other than @code{#f}.) +@end deffn + @node Scripts @subsection Scripts @@ -4070,6 +4079,17 @@ procedure @var{handler}. Wait @var{duration} before resuming the current script. @end deffn +@deffn {Syntax} wait-until condition +Wait until @var{condition} is met before resuming the current script. + +@example +(script + (wait-until (key-pressed? 'z)) + (display "you pressed the Z key!\n")) +@end example + +@end deffn + @deffn {Syntax} forever body @dots{} Evaluate @var{body} in an endless loop. @end deffn |