diff options
Diffstat (limited to '2d')
| -rw-r--r-- | 2d/game-loop.scm | 53 | ||||
| -rw-r--r-- | 2d/repl/repl.scm | 28 |
2 files changed, 57 insertions, 24 deletions
diff --git a/2d/game-loop.scm b/2d/game-loop.scm index 53e1768..fec82ef 100644 --- a/2d/game-loop.scm +++ b/2d/game-loop.scm @@ -22,12 +22,18 @@ ;;; Code: (define-module (2d game-loop) + #:use-module (ice-9 match) + #:use-module (srfi srfi-2) + #:use-module (srfi srfi-11) #:use-module ((sdl sdl) #:prefix SDL:) #:use-module (figl gl) #:use-module (2d agenda) #:use-module (2d coroutine) #:use-module (2d repl server) - #:export (on-active-hook + #:use-module (2d repl repl) + #:use-module (2d mvars) + #:export (game-mvar + on-active-hook on-resize-hook on-quit-hook on-render-hook @@ -52,10 +58,12 @@ ;;; (define *fps* 0) +(define game-mvar (new-mvar)) + ;; The REPL sets this flag when it needs to evaluate something. ;; Only the REPL server thread will mutate this variable. -(define *repl-waiting* #f) -(define game-loop-mutex (make-mutex 'unchecked-unlock)) +;;(define *repl-waiting* #f) +;;(define game-loop-mutex (make-mutex 'unchecked-unlock)) ;;; ;;; REPL Hooks @@ -63,16 +71,16 @@ ;; Lock game loop mutex before evaluating code from REPL server and ;; unlock it afterwards. -(add-hook! before-eval-hook - (lambda (exp) - (set! *repl-waiting* #t) - (lock-mutex game-loop-mutex))) +;; (add-hook! before-eval-hook +;; (lambda (exp) +;; (set! *repl-waiting* #t) +;; (lock-mutex game-loop-mutex))) -(add-hook! after-eval-hook - (lambda (exp) - (set! *repl-waiting* #f) - (when (equal? (mutex-owner game-loop-mutex) (current-thread)) - (unlock-mutex game-loop-mutex)))) +;; (add-hook! after-eval-hook +;; (lambda (exp) +;; (set! *repl-waiting* #f) +;; (when (equal? (mutex-owner game-loop-mutex) (current-thread)) +;; (unlock-mutex game-loop-mutex)))) ;;; ;;; Hooks @@ -188,15 +196,22 @@ is the unused accumulator time." (define (time-left current-time next-time) (max (floor (- next-time current-time)) 0)) +(define (run-repl-thunk thunk input output error) + (put-mvar + game-mvar + (with-input-from-port input + (lambda () + (with-output-to-port output + (lambda () + (with-error-to-port error thunk))))))) + (define (frame-sleep time) "Sleep for time milliseconds. Unlock the mutex beforehand if the REPL server is waiting to evaluate something." - (if *repl-waiting* - (begin - (unlock-mutex game-loop-mutex) - (SDL:delay time) - (lock-mutex game-loop-mutex)) - (SDL:delay time))) + (if (mvar-empty? repl-mvar) + (SDL:delay time) + (and-let* ((vals (try-take-mvar repl-mvar))) + (apply run-repl-thunk vals)))) ;;; ;;; Game Loop @@ -219,7 +234,7 @@ REPL server is waiting to evaluate something." (define (run-game-loop) "Spawns a REPL server and starts the main game loop." (spawn-server) - (lock-mutex game-loop-mutex) + ;;(lock-mutex game-loop-mutex) (agenda-schedule show-fps) (let ((time (SDL:get-ticks))) (game-loop time (+ time tick-interval) 0))) diff --git a/2d/repl/repl.scm b/2d/repl/repl.scm index 433e0e7..a5b0536 100644 --- a/2d/repl/repl.scm +++ b/2d/repl/repl.scm @@ -29,7 +29,9 @@ #:use-module (system repl common) #:use-module (system repl command) #:use-module (ice-9 control) - #:export (start-repl run-repl)) + #:use-module (2d mvars) + #:use-module (2d game-loop) + #:export (repl-mvar start-repl run-repl)) ;;; @@ -128,6 +130,8 @@ ;;; The repl ;;; +(define repl-mvar (new-mvar)) + (define* (start-repl #:optional (lang (current-language)) #:key debug) ;; ,language at the REPL will update the current-language. Make ;; sure that it does so in a new dynamic scope. @@ -188,10 +192,24 @@ (abort-on-error "parsing expression" (repl-parse repl exp)))))) (run-hook before-eval-hook exp) - (call-with-error-handling - (lambda () - (with-stack-and-prompt thunk)) - #:on-error (repl-option-ref repl 'on-error))) + ;; Insert thunk into repl-mvar. The + ;; game loop will schedule it and run + ;; it on the next tick. + (put-mvar + repl-mvar + (list + (lambda () + (call-with-error-handling + (lambda () + (with-stack-and-prompt thunk)) + #:on-error (repl-option-ref repl 'on-error))) + (current-input-port) + (current-output-port) + (current-error-port))) + ;; Read the results back from + ;; game-mvar. Will block until results + ;; are available. + (take-mvar game-mvar)) (lambda (k) (values)))) (lambda l (for-each (lambda (v) |