diff options
| -rw-r--r-- | Makefile.am | 1 | ||||
| -rw-r--r-- | starling/kernel.scm | 33 | ||||
| -rw-r--r-- | starling/repl.scm | 145 |
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))) |