summaryrefslogtreecommitdiff
path: root/2d
diff options
context:
space:
mode:
Diffstat (limited to '2d')
-rw-r--r--2d/agenda.scm108
-rw-r--r--2d/game.scm4
-rw-r--r--2d/repl/repl.scm5
-rw-r--r--2d/sprite.scm3
-rw-r--r--2d/time.scm25
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)))