summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--2d/game-loop.scm53
-rw-r--r--2d/repl/repl.scm28
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)