summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--chickadee/scripting.scm16
-rw-r--r--chickadee/scripting/agenda.scm24
-rw-r--r--doc/api.texi20
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