diff options
Diffstat (limited to '2d')
| -rw-r--r-- | 2d/agenda.scm | 81 | ||||
| -rw-r--r-- | 2d/game.scm | 4 | ||||
| -rw-r--r-- | 2d/helpers.scm | 13 | ||||
| -rw-r--r-- | 2d/repl.scm | 7 | ||||
| -rw-r--r-- | 2d/signal.scm | 28 | ||||
| -rw-r--r-- | 2d/sprite.scm | 6 |
6 files changed, 82 insertions, 57 deletions
diff --git a/2d/agenda.scm b/2d/agenda.scm index a0a6fb3..ab36f23 100644 --- a/2d/agenda.scm +++ b/2d/agenda.scm @@ -30,6 +30,8 @@ #:export (make-agenda agenda? agenda-time + current-agenda + with-agenda tick-agenda! clear-agenda! schedule @@ -69,7 +71,7 @@ list CALLBACKS." (define-record-type <agenda> (%make-agenda time segments) agenda? - (time agenda-time set-agenda-time!) + (time %agenda-time set-agenda-time!) (segments agenda-segments set-agenda-segments!)) (define (make-agenda) @@ -109,7 +111,7 @@ and enqueue CALLBACK." (define (agenda-time-delay agenda dt) "Return the sum of the time delta, DT, and the current time of AGENDA." - (+ (agenda-time agenda) (inexact->exact (round dt)))) + (+ (%agenda-time agenda) (inexact->exact (round dt)))) (define (flush-queue! q) "Dequeue and execute every member of Q." @@ -117,26 +119,25 @@ and enqueue CALLBACK." ((deq! q)) ;; Execute scheduled procedure (flush-queue! q))) -(define (tick-agenda! agenda) +(define (%tick-agenda! agenda) "Move AGENDA forward in time and run scheduled procedures." - (set-agenda-time! agenda (1+ (agenda-time agenda))) + (set-agenda-time! agenda (1+ (%agenda-time agenda))) (let next-segment () (unless (agenda-empty? agenda) (let ((segment (first-segment agenda))) ;; Process time segment if it is scheduled before or at the ;; current agenda time. - (when (>= (agenda-time agenda) (segment-time segment)) + (when (>= (%agenda-time agenda) (segment-time segment)) (flush-queue! (segment-queue segment)) (set-agenda-segments! agenda (rest-segments agenda)) (next-segment)))))) -(define (clear-agenda! agenda) +(define (%clear-agenda! agenda) "Remove all scheduled procedures from AGENDA." (set-agenda-segments! 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." +(define (%schedule agenda thunk delay) + "Schedule THUNK to be run after DELAY ticks of AGENDA." (let ((time (agenda-time-delay agenda delay))) (define (belongs-before? segments) (or (null? segments) @@ -157,19 +158,49 @@ now. DELAY defaults to 1 if not specified." (agenda-add-segment agenda time thunk) (add-to-segments (agenda-segments 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)) - delay)) - -(define (schedule-each agenda thunk) - "Schedule THUNK within AGENDA to be applied every tick." - (schedule-interval agenda thunk 1)) - -(define (wait agenda delay) - "Yield coroutine and schedule the continuation to be run after DELAY -ticks." - (yield (cut schedule agenda <> delay))) +(define current-agenda + (make-parameter (make-agenda) + (lambda (val) + (if (agenda? val) + val + (error "Must be an agenda"))))) + +(define-syntax-rule (with-agenda agenda body ...) + (parameterize ((current-agenda agenda)) + body ...)) + +(define (agenda-time) + "Return the time of the current agenda." + (%agenda-time (current-agenda))) + +(define (tick-agenda!) + "Increment time for the current agenda and run scheduled +procedures." + (%tick-agenda! (current-agenda))) + +(define (clear-agenda!) + "Remove all scheduled procedures from the current agenda." + (%clear-agenda! (current-agenda))) + +(define* (schedule thunk #:optional (delay 1)) + "Schedule THUNK to be applied after DELAY ticks of the current +agenda, or 1 tick if DELAY is not specified." + (%schedule (current-agenda) thunk delay)) + +(define (schedule-interval thunk interval) + "Schedule THUNK to be applied every INTERVAL ticks of the current +agenda." + (coroutine + (while #t + (wait interval) + (thunk)))) + +(define (schedule-each thunk) + "Schedule THUNK to be applied upon every tick of the current +agenda." + (schedule-interval thunk 1)) + +(define (wait delay) + "Abort coroutine and schedule the continuation to be run after DELAY +ticks of the current agenda." + (yield (cut schedule <> delay))) diff --git a/2d/game.scm b/2d/game.scm index befe784..d6a0345 100644 --- a/2d/game.scm +++ b/2d/game.scm @@ -32,7 +32,6 @@ #:use-module (2d window) #:export (tick-interval max-ticks-per-frame - game-agenda draw-hook start-game-loop stop-game-loop)) @@ -49,7 +48,6 @@ ;; completely unresponsive and possibly crashing. (define max-ticks-per-frame 4) (define draw-hook (make-hook 2)) -(define game-agenda (make-agenda)) (define (draw dt alpha) "Render a frame." @@ -68,7 +66,7 @@ is the unused accumulator time." (cond ((>= ticks max-ticks-per-frame) lag) ((>= lag tick-interval) - (tick-agenda! game-agenda) + (tick-agenda!) (iter (- lag tick-interval) (1+ ticks))) (else lag))) diff --git a/2d/helpers.scm b/2d/helpers.scm index 18bf8fa..59633d6 100644 --- a/2d/helpers.scm +++ b/2d/helpers.scm @@ -45,10 +45,9 @@ within the guardian is GC'd. Reaping is ensured to happen from the same thread that is running the game loop." (begin (define name (make-guardian)) - (schedule-interval game-agenda - (lambda () - (let reap ((obj (name))) - (when obj - (reaper obj) - (reap (name))))) - 1))) + (schedule-each + (lambda () + (let reap ((obj (name))) + (when obj + (reaper obj) + (reap (name)))))))) diff --git a/2d/repl.scm b/2d/repl.scm index 02237b6..f48b6d2 100644 --- a/2d/repl.scm +++ b/2d/repl.scm @@ -25,7 +25,6 @@ #:use-module (system repl coop-server) #:use-module (system repl server) #:use-module (2d agenda) - #:use-module (2d game) #:export (start-2d-repl)) (define* (start-2d-repl #:optional (port (make-tcp-server-socket #:port 37146))) @@ -33,6 +32,6 @@ default, this port is 37146. Additionally, a process is scheduled to poll the REPL server upon every tick of the game loop." (let ((server (spawn-coop-repl-server port))) - (schedule-each game-agenda - (lambda () - (poll-coop-repl-server server))))) + (schedule-each + (lambda () + (poll-coop-repl-server server))))) diff --git a/2d/signal.scm b/2d/signal.scm index 58cb0a4..efbb103 100644 --- a/2d/signal.scm +++ b/2d/signal.scm @@ -260,33 +260,33 @@ SIGNAL. This signal is a convenient way to sneak a procedure that has a side-effect into a signal chain." (signal-map (lambda (x) (proc x) x) signal)) -(define (signal-sample agenda delay signal) +(define (signal-sample delay signal) "Create a new signal that emits the value contained within SIGNAL -every DELAY ticks of AGENDA." +every DELAY ticks of the current agenda." (let ((sampler (%make-signal (signal-ref signal) #f '()))) (define (tick) (%signal-set! sampler (signal-ref signal))) - (schedule-interval agenda tick delay) + (schedule-interval tick delay) (make-signal-box sampler))) -(define (signal-delay agenda delay signal) +(define (signal-delay delay signal) "Create a new signal that delays propagation of SIGNAL by DELAY -ticks of AGENDA." +ticks of the current agenda." (make-boxed-signal (signal-ref signal) (lambda (self value) - (schedule agenda - (lambda () - (%signal-set! self value)) - delay)) + (schedule + (lambda () + (%signal-set! self value)) + delay)) (list signal))) -(define (signal-throttle agenda delay signal) +(define (signal-throttle delay signal) "Return a new signal that propagates SIGNAL at most once every DELAY -ticks of AGENDA." +ticks of the current agenda." (make-boxed-signal (signal-ref signal) - (let ((last-time (agenda-time agenda))) + (let ((last-time (agenda-time))) (lambda (self value) - (when (>= (- (agenda-time agenda) last-time) delay) + (when (>= (- (agenda-time) last-time) delay) (%signal-set! self value) - (set! last-time (agenda-time agenda))))) + (set! last-time (agenda-time))))) (list signal))) diff --git a/2d/sprite.scm b/2d/sprite.scm index 3b74fdb..c050a39 100644 --- a/2d/sprite.scm +++ b/2d/sprite.scm @@ -32,7 +32,6 @@ #:use-module (2d animation) #:use-module (2d color) #:use-module (2d config) - #:use-module (2d game) #:use-module (2d helpers) #:use-module (2d math) #:use-module (2d shader) @@ -175,8 +174,7 @@ currently bound." 1)))) ;; A hash table for all of the animated sprites that have been drawn -;; since the last game update. It is cleared after every game-agenda -;; tick. +;; since the last game update. It is cleared after every agenda tick. (define animated-sprites (make-hash-table)) (define (register-animated-sprite-maybe sprite) @@ -191,4 +189,4 @@ currently bound." (hash-clear! animated-sprites)) ;; Update animated sprites upon every update. -(schedule-each game-agenda update-animated-sprites!) +(schedule-each update-animated-sprites!) |