From d6213d7bb58fceb491b5f0ecc0eb54372815730b Mon Sep 17 00:00:00 2001 From: David Thompson Date: Tue, 6 Oct 2020 18:59:45 -0400 Subject: Add primitive in-engine REPL. --- Makefile.am | 1 + starling/kernel.scm | 33 +++++++----- starling/repl.scm | 145 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 166 insertions(+), 13 deletions(-) create mode 100644 starling/repl.scm 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 #:name 'fps) ;; REPL server (make #:name 'repl-server)) + (set! (repl kernel) + (make + #:name 'repl + #:scene-mux kernel)) (run-script kernel (forever (sleep 60) @@ -175,17 +179,22 @@ (define-method (on-key-press (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 ) 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 +;;; +;;; 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 . + +;;; 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 ( + open-repl)) + +(define-class () + (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 )) + (pop-scene (scene-mux repl))) + +(define-method (modify-user-text (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 )) + (let ((text (user-text repl))) + (modify-user-text repl + (substring text 0 (max (- (string-length text) 1) 0))))) + +(define-method (eval-user-text (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 )) + (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