diff options
| -rw-r--r-- | Makefile.am | 1 | ||||
| -rw-r--r-- | starling/kernel.scm | 24 | ||||
| -rw-r--r-- | starling/minibuffer.scm | 133 |
3 files changed, 154 insertions, 4 deletions
diff --git a/Makefile.am b/Makefile.am index 503a280..cad01a9 100644 --- a/Makefile.am +++ b/Makefile.am @@ -45,6 +45,7 @@ SOURCES = \ starling/node.scm \ starling/scene.scm \ starling/repl.scm \ + starling/minibuffer.scm \ starling/kernel.scm \ starling/node-2d.scm \ starling/transition.scm diff --git a/starling/kernel.scm b/starling/kernel.scm index 25b6917..042e1ac 100644 --- a/starling/kernel.scm +++ b/starling/kernel.scm @@ -40,6 +40,7 @@ #:use-module (starling config) #:use-module (starling node) #:use-module (starling repl) + #:use-module (starling minibuffer) #:use-module (starling scene) #:use-module (starling system) #:use-module ((sdl2 video) #:prefix sdl2:) @@ -118,10 +119,15 @@ (define-method (on-key-press (kernel <kernel>) key scancode modifiers repeat?) ;; Hot keys when in dev mode (when developer-mode? - (match key - ('f5 (reboot-current-scene)) - ('escape (abort-game)) - (_ #t))) + (unless (& kernel minibuffer) + (match key + ('x + (when (or (memq 'left-alt modifiers) + (memq 'right-alt modifiers)) + (unless (& kernel minibuffer) + (open-minibuffer kernel)))) + ('escape (abort-game)) + (_ #t)))) (next-method)) (define-method (update-tree (kernel <kernel>) dt) @@ -304,6 +310,16 @@ kernel. A convenient procedure for developers." (display "rebooting\n") (reboot (current-scene (current-kernel)))) +(define (pause-current-scene) + (pause (current-scene (current-kernel)))) + +(define (resume-current-scene) + (resume (current-scene (current-kernel)))) + +(add-minibuffer-command "reboot" reboot-current-scene) +(add-minibuffer-command "pause" pause-current-scene) +(add-minibuffer-command "resume" resume-current-scene) + (define-meta-command ((debug-game lisparuga) repl) "debug-game Enter a debugger for the current game loop error." diff --git a/starling/minibuffer.scm b/starling/minibuffer.scm new file mode 100644 index 0000000..ed2761b --- /dev/null +++ b/starling/minibuffer.scm @@ -0,0 +1,133 @@ +;;; Starling Game Engine +;;; Copyright © 2020 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: +;; +;; Minibuffer for fast code execution. +;; +;;; Code: + +(define-module (starling minibuffer) + #: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 match) + #:use-module (oop goops) + #:use-module (srfi srfi-1) + #:use-module (starling node) + #:use-module (starling node-2d) + #:use-module (starling scene) + #:export (<minibuffer> + add-minibuffer-command + open-minibuffer)) + +(define-class <minibuffer> (<scene-2d>) + (commands #:accessor commands #:allocation #:class #:init-form '()) + (scene-mux #:getter scene-mux #:init-keyword #:scene-mux) + (overlay-scene #:getter overlay-scene #:init-keyword #:overlay-scene) + (user-text #:accessor user-text #:init-form "")) + +(define (minibuffer-commands) + (class-slot-ref <minibuffer> 'commands)) + +(define-method (add-minibuffer-command name thunk) + (class-slot-set! <minibuffer> 'commands + (cons (cons name thunk) + (minibuffer-commands)))) + +(define-method (open-minibuffer scene-mux) + (let ((minibuffer (make <minibuffer> + #:name 'minibuffer + #:scene-mux scene-mux + #:overlay-scene (current-scene scene-mux)))) + ;; We need to delay the minibuffer by one frame so that the text + ;; input event for the "x" character (part of the M-x key + ;; shortcut) is not processed by the minibuffer, thus adding an + ;; "x" to the user text entry area before the user has actually + ;; typed anything. + (run-script scene-mux + (sleep 1) + (push-scene scene-mux minibuffer)))) + +(define-method (close-minibuffer (minibuffer <minibuffer>)) + (pop-scene (scene-mux minibuffer))) + +(define-method (run-command (minibuffer <minibuffer>)) + (let ((thunk (assoc-ref (minibuffer-commands) (user-text minibuffer)))) + (when (procedure? thunk) + (close-minibuffer minibuffer) + (thunk)))) + +(define-method (modify-user-text (minibuffer <minibuffer>) new-text) + (set! (user-text minibuffer) new-text) + (set! (text (& minibuffer text-entry)) + (string-append "> " new-text))) + +(define-method (backward-delete (minibuffer <minibuffer>)) + (let ((text (user-text minibuffer))) + (modify-user-text minibuffer + (substring text 0 (max (- (string-length text) 1) 0))))) + +(define-method (tab-complete (minibuffer <minibuffer>)) + (let ((prefix (user-text minibuffer))) + ;; Auto-complete if there is a single command name that starts + ;; with the characters the user has already typed. + (match (filter-map (match-lambda + ((name . _) + (and (string-prefix? prefix name) name))) + (minibuffer-commands)) + ((name) + (modify-user-text minibuffer name)) + (_ #f)))) + +(define-method (on-boot (minibuffer <minibuffer>)) + (let* ((view-area (area (car (views minibuffer)))) + (font (default-font)) + (line-height (font-line-height font)) + (padding 8.0)) + (attach-to minibuffer + (make <filled-rect> + #:region (make-rect 0.0 0.0 + (rect-width view-area) + (+ line-height (* padding 2.0))) + #:color (make-color 0.0 0.0 0.0 1.0)) + (make <label> + #:name 'text-entry + #:rank 9 + #:font font + #:position (vec2 padding padding))) + (modify-user-text minibuffer ""))) + +(define-method (update (minibuffer <minibuffer>) dt) + (update-tree (overlay-scene minibuffer) dt) + (next-method)) + +(define-method (render (minibuffer <minibuffer>) alpha) + (render-tree (overlay-scene minibuffer) alpha) + (next-method)) + +(define-method (on-key-press (minibuffer <minibuffer>) key scancode modifiers repeat?) + (match key + ('escape (close-minibuffer minibuffer)) + ('return (run-command minibuffer)) + ('backspace (backward-delete minibuffer)) + ('tab (tab-complete minibuffer)) + (_ #f))) + +(define-method (on-text-input (minibuffer <minibuffer>) text) + (modify-user-text minibuffer (string-append (user-text minibuffer) text))) |