From 2d67cf8ec58c87609c242a7b93a2c1470c8d6180 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson@member.fsf.org>
Date: Mon, 2 Sep 2013 16:52:53 -0400
Subject: Execute REPL thunks in the context of the main game thread.

---
 2d/game-loop.scm | 53 ++++++++++++++++++++++++++++++++++-------------------
 2d/repl/repl.scm | 28 +++++++++++++++++++++++-----
 2 files changed, 57 insertions(+), 24 deletions(-)

(limited to '2d')

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)
-- 
cgit v1.2.3