From d0ff41fb7a33c096a792ab57f5bbf7992b1cc399 Mon Sep 17 00:00:00 2001 From: David Thompson Date: Sun, 4 May 2014 14:03:00 -0400 Subject: Add current-agenda parameter. * 2d/agenda.scm (current-agenda): New variable. (with-agenda): New macro. (agenda-time, tick-agenda!, clear-agenda!, schedule) (schedule-interval, schedule-each, wait): Remove agenda parameter. * 2d/game.scm (game-agenda): Delete it. (update): Tick current agenda. * 2d/helpers.scm (define-guardian): Remove agenda argument. * 2d/repl.scm (start-2d-repl): Remove agenda argument to schedule-each. * 2d/signal.scm (signal-sample, signal-delay, signal-throttle): Remove agenda parameter. * 2d/sprite.scm: * examples/common.scm: * examples/coroutine.scm: * examples/font.scm: * examples/particles.scm: Remove mention of game-agenda. * README.org: Update example snippets. --- 2d/agenda.scm | 81 ++++++++++++++++++++++++++++++++++---------------- 2d/game.scm | 4 +-- 2d/helpers.scm | 13 ++++---- 2d/repl.scm | 7 ++--- 2d/signal.scm | 28 ++++++++--------- 2d/sprite.scm | 6 ++-- README.org | 19 ++++++------ examples/common.scm | 8 ++--- examples/coroutine.scm | 4 +-- examples/font.scm | 2 +- examples/particles.scm | 2 +- 11 files changed, 99 insertions(+), 75 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 (%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!) diff --git a/README.org b/README.org index d54895a..bbd26e0 100644 --- a/README.org +++ b/README.org @@ -152,7 +152,7 @@ exists a =wait= procedure to pause a coroutine and schedule it to be resumed later. - Using a coroutine and an agenda, the NPC script can be rewritten + Using a coroutine and the agenda, the NPC script can be rewritten such that it does not halt further program execution. #+BEGIN_SRC scheme @@ -163,19 +163,18 @@ (coroutine (while #t (walk 'up) - (wait game-agenda 60) + (wait 60) (walk 'down) - (wait game-agenda 60))) + (wait 60))) #+END_SRC =coroutine= is a useful macro that evaluates a block of code as a coroutine. =wait= aborts the procedure and schedules the - continuation inside of an agenda. =game-agenda= is the main - agenda that is ticked at each iteration of the game update loop. - In this example, the script is paused for 1 second after each - step. Since guile-2d enforces a fixed timestep and updates 60 - times per second by default, 60 ticks is equivalent to 1 second. + continuation inside of the agenda. In this example, the script is + paused for 1 second after each step. Since guile-2d enforces a + fixed timestep and updates 60 times per second by default, 60 + ticks is equivalent to 1 second. You can also use the agenda to schedule the evaluation of any thunk even if it isn't a coroutine. @@ -184,7 +183,7 @@ (define (hello) (display "Hello, world! Sorry I'm late!\n")) - (schedule game-agenda hello 600) + (schedule hello 600) #+END_SRC =schedule= accepts a thunk (a procedure that takes no arguments) @@ -220,7 +219,7 @@ (signal-fold v+ (vector2 320 240) (signal-map (lambda (v) (vscale v 4)) - (signal-sample game-agenda 1 key-arrows)))) + (signal-sample 1 key-arrows)))) #+END_SRC This signal describes a relationship between the arrow keys on the diff --git a/examples/common.scm b/examples/common.scm index 0acb6c2..62ddd14 100644 --- a/examples/common.scm +++ b/examples/common.scm @@ -33,9 +33,9 @@ (add-hook! window-close-hook stop-game-loop) -(schedule-interval game-agenda - (lambda () - (format #t "FPS: ~d\n" (signal-ref fps))) - 60) +(schedule-interval + (lambda () + (format #t "FPS: ~d\n" (signal-ref fps))) + 60) (start-2d-repl) diff --git a/examples/coroutine.scm b/examples/coroutine.scm index 98dec16..7b4a1e6 100644 --- a/examples/coroutine.scm +++ b/examples/coroutine.scm @@ -38,9 +38,9 @@ sprite (vector2 (random window-width) (random window-height))) - (wait game-agenda 15) + (wait 15) (set-sprite-rotation! sprite (random 360)) - (wait game-agenda 15))) + (wait 15))) (add-hook! draw-hook (lambda (dt alpha) (draw-sprite sprite))) diff --git a/examples/font.scm b/examples/font.scm index 304070f..8bcd90d 100644 --- a/examples/font.scm +++ b/examples/font.scm @@ -44,7 +44,7 @@ (signal-map (lambda (p) (let ((text (format #f "Mouse: (~d, ~d)" (vx p) (vy p)))) (make-label font text (vector2 0 20)))) - (signal-throttle game-agenda 5 mouse-position))) + (signal-throttle 5 mouse-position))) (add-hook! draw-hook (lambda (dt alpha) (draw-label label) diff --git a/examples/particles.scm b/examples/particles.scm index d811eb7..4269b99 100644 --- a/examples/particles.scm +++ b/examples/particles.scm @@ -76,7 +76,7 @@ (define (update) (for-each update-particle! particles)) -(schedule-each game-agenda update) +(schedule-each update) (add-hook! draw-hook draw) (with-window (make-window #:title "Particles" -- cgit v1.2.3