Add primitive in-engine REPL.

3 files changed, 166 insertions, 13 deletions

diff --git a/Makefile.am b/Makefile.am
index e77308b..aa89d2c 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -46,6 +46,7 @@ SOURCES = 					\
   starling/node.scm				\
   starling/scene.scm				\
   starling/repl-server.scm			\
+  starling/repl.scm				\
   starling/minibuffer.scm			\
   starling/kernel.scm				\
   starling/node-2d.scm				\
diff --git a/starling/kernel.scm b/starling/kernel.scm
index 5a04178..e6658ca 100644
--- a/starling/kernel.scm
+++ b/starling/kernel.scm
@@ -46,7 +46,7 @@
   #:use-module (starling config)
   #:use-module (starling node)
   #:use-module (starling node-2d)
-  ;;#:use-module (starling repl)
+  #:use-module (starling repl)
   #:use-module (starling repl-server)
   #:use-module (starling minibuffer)
   #:use-module (starling scene)
@@ -168,6 +168,10 @@
                (make <fps-display> #:name 'fps)
                ;; REPL server
                (make <repl-server> #:name 'repl-server))
+    (set! (repl kernel)
+      (make <repl>
+        #:name 'repl
+        #:scene-mux kernel))
     (run-script kernel
       (forever
        (sleep 60)
@@ -175,17 +179,22 @@
 
 (define-method (on-key-press (kernel <kernel>) key modifiers repeat?)
   ;; Hot keys when in dev mode
-  (when developer-mode?
-    (unless (& kernel minibuffer)
+  (if (and developer-mode?
+           (not (or (eq? (current-scene kernel) (& kernel minibuffer))
+                    (eq? (current-scene kernel) (repl kernel)))))
       (match key
+        ('backquote
+         (run-script kernel
+           (sleep 1)
+           (open-repl (repl kernel))))
         ('x
-         (when (or (memq 'left-alt modifiers)
-                   (memq 'right-alt modifiers))
-           (unless (& kernel minibuffer)
-             (open-minibuffer kernel))))
+         (if (or (memq 'left-alt modifiers)
+                 (memq 'right-alt modifiers))
+             (open-minibuffer kernel)
+             (next-method)))
         ('escape (abort-game))
-        (_ #t))))
-  (next-method))
+        (_ (next-method)))
+      (next-method)))
 
 (define-method (update-tree (kernel <kernel>) dt)
   (define (invert-y y)
@@ -201,13 +210,11 @@
      ((keyboard-down-event? event)
       (on-key-press kernel
                     (keyboard-event-key event)
-                    (keyboard-event-scancode event)
                     (keyboard-event-modifiers event)
                     (keyboard-event-repeat? event)))
      ((keyboard-up-event? event)
       (on-key-release kernel
                       (keyboard-event-key event)
-                      (keyboard-event-scancode event)
                       (keyboard-event-modifiers event)))
      ((text-input-event? event)
       (on-text-input kernel
@@ -388,12 +395,12 @@ kernel.  A convenient procedure for developers."
 (define-meta-command ((debug-game starling) repl)
   "debug-game
 Enter a debugger for the current game loop error."
-  (debugger (& (current-kernel) repl)))
+  (debugger (& (current-kernel) repl-server)))
 
 (define-meta-command ((resume-game starling) repl)
   "resume-game
 Resume the game loop without entering a debugger."
-  (set! (repl-debugging? (& (current-kernel) repl)) #f))
+  (set! (repl-debugging? (& (current-kernel) repl-server)) #f))
 
 (define-meta-command ((reboot starling) repl)
   "reboot
diff --git a/starling/repl.scm b/starling/repl.scm
new file mode 100644
index 0000000..47947c0
--- /dev/null
+++ b/starling/repl.scm
@@ -0,0 +1,145 @@
+;;; Starling Game Engine
+;;; Copyright © 2018 David Thompson <davet@gnu.org>
+;;;
+;;; This program is free software: you can redistribute it and/or
+;;; modify it under the terms of the GNU General Public License as
+;;; published by the Free Software Foundation, either version 3 of the
+;;; License, or (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Starling.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; REPL node for in-engine live hacking.
+;;
+;;; Code:
+
+(define-module (starling repl)
+  #:use-module (chickadee array-list)
+  #:use-module (chickadee graphics color)
+  #:use-module (chickadee graphics font)
+  #:use-module (chickadee math rect)
+  #:use-module (chickadee math vector)
+  #:use-module (chickadee scripting)
+  #:use-module (ice-9 eval-string)
+  #:use-module (ice-9 format)
+  #:use-module (ice-9 match)
+  #:use-module (oop goops)
+  #:use-module (starling ring-buffer)
+  #:use-module (starling node)
+  #:use-module (starling node-2d)
+  #:use-module (starling scene)
+  #:export (<repl>
+            open-repl))
+
+(define-class <repl> (<scene-2d>)
+  (scene-mux #:getter scene-mux #:init-keyword #:scene-mux)
+  (overlay-scene #:accessor overlay-scene #:init-keyword #:overlay-scene)
+  (lines #:accessor lines #:init-form '())
+  (log #:accessor log)
+  (user-text #:accessor user-text #:init-form "")
+  (module #:accessor module #:init-form (resolve-module '(guile-user))))
+
+(define-method (open-repl repl)
+  (set! (overlay-scene repl) (current-scene (scene-mux repl)))
+  (push-scene (scene-mux repl) repl))
+
+(define-method (close-repl (repl <repl>))
+  (pop-scene (scene-mux repl)))
+
+(define-method (modify-user-text (repl <repl>) new-text)
+  (set! (user-text repl) new-text)
+  (set! (text (& repl prompt))
+    (format #f "~s> ~a" (module-name (module repl)) new-text)))
+
+(define-method (backward-delete (repl <repl>))
+  (let ((text (user-text repl)))
+    (modify-user-text repl
+                      (substring text 0 (max (- (string-length text) 1) 0)))))
+
+(define-method (eval-user-text (repl <repl>))
+  (let* ((result #f)
+         (output (with-output-to-string
+                   (lambda ()
+                     (set! result (eval-string (user-text repl)
+                                               #:module (module repl))))))
+         (log (log repl)))
+    (for-each (lambda (line)
+                (ring-buffer-put! log line))
+              (let ((result-text (if (unspecified? result)
+                                     ""
+                                     (with-output-to-string
+                                       (lambda ()
+                                         (display "=> ")
+                                         (write result))))))
+                (match (string-split (string-append (text (& repl prompt))
+                                                    "\n" output result-text)
+                                     #\newline)
+                  ;; Drop trailing newlines
+                  ((lines ... "") lines)
+                  (lines lines))))
+    (let loop ((i 0)
+               (labels (lines repl)))
+      (when (< i (ring-buffer-length log))
+        (match labels
+          ((label . rest)
+           (set! (text label) (ring-buffer-ref log i))
+           (loop (+ i 1) rest)))))
+    (modify-user-text repl "")))
+
+(define-method (on-boot (repl <repl>))
+  (let* ((res (resolution (car (cameras repl))))
+         (font (default-font))
+         (line-height (font-line-height font))
+         (left-margin 6.0)
+         (bottom-margin 6.0)
+         (nlines (- (inexact->exact
+                     (floor
+                      (/ (vec2-y res) line-height)))
+                    1))
+         (line-nodes
+          (map (lambda (i)
+                 (make <label>
+                   #:rank 9
+                   #:font font
+                   #:position (vec2 left-margin
+                                    (- (vec2-y res)
+                                       (* i line-height)))
+                   #:vertical-align 'top))
+               (iota nlines))))
+    (attach-to repl
+               (make <filled-rect>
+                 #:region (make-rect 0.0 0.0 (vec2-x res) (vec2-y res))
+                 #:color (make-color 0.0 0.0 0.0 0.7))
+               (make <label>
+                 #:rank 9
+                 #:name 'prompt
+                 #:position (vec2 left-margin bottom-margin)))
+    (apply attach-to repl line-nodes)
+    (set! (lines repl) line-nodes)
+    (set! (log repl) (make-ring-buffer nlines))
+    (modify-user-text repl "")))
+
+(define-method (update (repl <repl>) dt)
+  (update-tree (overlay-scene repl) dt)
+  (next-method))
+
+(define-method (render (repl <repl>) alpha)
+  (render-tree (overlay-scene repl) alpha)
+  (next-method))
+
+(define-method (on-key-press (repl <repl>) key modifiers repeat?)
+  (match key
+    ('escape (close-repl repl))
+    ('backspace (backward-delete repl))
+    ('return (eval-user-text repl))
+    (_ #f)))
+
+(define-method (on-text-input (repl <repl>) text)
+  (modify-user-text repl (string-append (user-text repl) text)))