diff options
Diffstat (limited to '2d')
| -rw-r--r-- | 2d/agenda.scm | 108 | ||||
| -rw-r--r-- | 2d/game.scm | 4 | ||||
| -rw-r--r-- | 2d/repl/repl.scm | 5 | ||||
| -rw-r--r-- | 2d/sprite.scm | 3 | ||||
| -rw-r--r-- | 2d/time.scm | 25 |
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))) |