diff options
author | David Thompson <dthompson@vistahigherlearning.com> | 2022-10-26 18:30:32 -0400 |
---|---|---|
committer | David Thompson <dthompson@vistahigherlearning.com> | 2022-10-26 18:30:32 -0400 |
commit | 2c2be9855320473ee7fdc23f54ae6c01c6a569c7 (patch) | |
tree | 632c29ab1ac86a9fe652b21d44f42738f12f3e6e | |
parent | 949372cf3fc361d42878e85901abb9dc8c3ec78a (diff) |
Add root module to remove use of module-ref in (catbird kernel).
-rw-r--r-- | Makefile.am | 3 | ||||
-rw-r--r-- | catbird.scm | 120 | ||||
-rw-r--r-- | catbird/kernel.scm | 131 | ||||
-rw-r--r-- | catbird/overlay.scm | 22 |
4 files changed, 157 insertions, 119 deletions
diff --git a/Makefile.am b/Makefile.am index e6f8c2f..b044bd1 100644 --- a/Makefile.am +++ b/Makefile.am @@ -56,7 +56,8 @@ SOURCES = \ catbird/line-editor.scm \ catbird/minibuffer.scm \ catbird/repl.scm \ - catbird/overlay.scm + catbird/overlay.scm \ + catbird.scm TEST_EXTENSIONS = .scm SCM_LOG_COMPILER = $(top_builddir)/test-env $(GUILE) diff --git a/catbird.scm b/catbird.scm new file mode 100644 index 0000000..ae27bb7 --- /dev/null +++ b/catbird.scm @@ -0,0 +1,120 @@ +;;; Catbird Game Engine +;;; Copyright © 2022 David Thompson <davet@gnu.org> +;;; +;;; Catbird 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. +;;; +;;; Catbird 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 Catbird. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; Catbird engine entry point. +;; +;;; Code: +(define-module (catbird) + #:use-module (catbird camera) + #:use-module (catbird config) + #:use-module (catbird input-map) + #:use-module (catbird kernel) + #:use-module (catbird minibuffer) + #:use-module (catbird mode) + #:use-module (catbird overlay) + #:use-module (catbird region) + #:use-module (catbird scene) + #:use-module (chickadee) + #:use-module (chickadee math rect) + #:use-module (oop goops) + #:export (run-catbird) + #:re-export (exit-catbird)) + +;; Add the system notification and debugging overlay. +(define (add-overlay) + (let ((region (create-full-region #:name 'overlay #:rank 9999))) + (set! (camera region) + (make <camera-2d> + #:width (rect-width (area region)) + #:height (rect-height (area region)))) + (replace-scene region (make-overlay)))) + +(define (overlay-scene) + (scene (find-region-by-name 'overlay))) + +(define-method (notify message) + (notify (overlay-scene) message)) + +(define (open-minibuffer) + (push-major-mode (overlay-scene) (make <minibuffer-mode>))) + +;;(bind-input/global (key-press 'x '(alt)) open-minibuffer) + +(define* (run-catbird thunk #:key (width 1366) (height 768) + (title "^~Catbird~^") (fullscreen? #f) + (resizable? #t) (update-hz 60)) + (let ((kernel (make <kernel>))) + (parameterize ((current-kernel kernel)) + (run-game #:window-title title + #:window-width width + #:window-height height + #:window-fullscreen? fullscreen? + #:window-resizable? resizable? + #:update-hz update-hz + #:load + (lambda () + (load* kernel) + (thunk) + (add-overlay)) + #:draw + (lambda (alpha) + (render kernel alpha)) + #:update + (lambda (dt) + (update kernel dt)) + #:key-press + (lambda (key modifiers repeat?) + (on-key-press kernel key modifiers)) + #:key-release + (lambda (key modifiers) + (on-key-release kernel key modifiers)) + #:text-input + (lambda (text) + (on-text-input kernel text)) + #:mouse-press + ;; TODO: Handle click counter? + (lambda (button clicks x y) + (on-mouse-press kernel button x y)) + #:mouse-release + (lambda (button x y) + (on-mouse-release kernel button x y)) + #:mouse-move + (lambda (x y x-rel y-rel buttons) + (on-mouse-move kernel x y x-rel y-rel buttons)) + #:mouse-wheel + (lambda (x y) + (on-mouse-wheel kernel x y)) + #:controller-add + (lambda (controller) + (on-controller-add kernel controller)) + #:controller-remove + (lambda (controller) + (on-controller-remove kernel controller)) + #:controller-press + (lambda (controller button) + (on-controller-press kernel controller button)) + #:controller-release + (lambda (controller button) + (on-controller-release kernel controller button)) + #:controller-move + (lambda (controller axis value) + (on-controller-move kernel controller axis value)))))) + +(define (exit-catbird) + "Stop the Catbird engine." + (abort-game)) diff --git a/catbird/kernel.scm b/catbird/kernel.scm index 70d3afb..90960ce 100644 --- a/catbird/kernel.scm +++ b/catbird/kernel.scm @@ -36,20 +36,24 @@ #:use-module (oop goops) #:use-module (srfi srfi-1) #:use-module (system repl coop-server) - #:export (all-regions + #:export (<kernel> + all-regions + bind-input/global create-full-region create-region + current-controller-focus + current-kernel + current-keyboard-focus + exit-catbird find-region-by-name frames-per-second kill-region - current-keyboard-focus - take-keyboard-focus - current-controller-focus + load* + on-controller-add + on-controller-remove take-controller-focus - bind-input/global - unbind-input/global - run-catbird - exit-catbird)) + take-keyboard-focus + unbind-input/global)) ;;; @@ -70,25 +74,6 @@ (when developer-mode? (set! (repl kernel) (spawn-coop-repl-server)))) -;; Add the system notification and debugging overlay. -(define-method (add-overlay (kernel <kernel>)) - (let ((region (create-full-region #:name 'overlay #:rank 9999))) - (set! (camera region) - (make <camera-2d> - #:width (rect-width (area region)) - #:height (rect-height (area region)))) - ;; Use resolve-module to avoid a circular dependency. - (replace-scene region - ((module-ref (resolve-module '(catbird overlay)) - 'make-overlay))))) - -(define-method (overlay-scene (kernel <kernel>)) - (scene (lookup-region kernel 'overlay))) - -(define-method (notify (kernel <kernel>) message) - (let ((notify (module-ref (resolve-module '(catbird overlay)) 'notify))) - (notify (overlay-scene kernel) message))) - (define-method (update (kernel <kernel>) dt) (when developer-mode? (poll-coop-repl-server (repl kernel)) @@ -107,6 +92,9 @@ (* (average-frame-time kernel) 0.9))) (set! (frame-start-time kernel) current-time))) +(define-method (frames-per-second (kernel <kernel>)) + (/ 1.0 (average-frame-time kernel))) + (define-method (lookup-region (kernel <kernel>) region-name) (find (lambda (region) (eq? (name region) region-name)) @@ -126,6 +114,8 @@ (define-method (unbind-input (kernel <kernel>) spec) (set! (input-map kernel) (remove-input (input-map kernel) spec))) +(define-generic notify) + ;;; ;;; Keyboard @@ -246,20 +236,20 @@ (define-method (on-controller-add (kernel <kernel>) controller) (let ((slot (empty-controller-slot kernel))) - (notify kernel (string-append "Controller " - (number->string - (+ (controller-slot-id slot) 1)) - " connected: " - (controller-name controller))) + (notify (string-append "Controller " + (number->string + (+ (controller-slot-id slot) 1)) + " connected: " + (controller-name controller))) (fill-controller-slot! slot controller))) (define-method (on-controller-remove (kernel <kernel>) controller) (let ((slot (find-controller-slot kernel controller))) - (notify kernel (string-append "Controller " - (number->string - (+ (controller-slot-id slot) 1)) - " disconnected: " - (controller-name controller))) + (notify (string-append "Controller " + (number->string + (+ (controller-slot-id slot) 1)) + " disconnected: " + (controller-name controller))) (clear-controller-slot! (find-controller-slot kernel controller)))) (define-method (on-controller-press (kernel <kernel>) controller button) @@ -346,70 +336,3 @@ (define (unbind-input/global spec handler) (unbind-input (current-kernel) spec handler)) - -(define (frames-per-second) - (/ 1.0 (average-frame-time (current-kernel)))) - -(define* (run-catbird thunk #:key (width 1366) (height 768) - (title "^~Catbird~^") (fullscreen? #f) - (resizable? #t) (update-hz 60)) - (let ((kernel (make <kernel>))) - (parameterize ((current-kernel kernel)) - (run-game #:window-title title - #:window-width width - #:window-height height - #:window-fullscreen? fullscreen? - #:window-resizable? resizable? - #:update-hz update-hz - #:load - (lambda () - (load* kernel) - (thunk) - (add-overlay kernel)) - #:draw - (lambda (alpha) - (render kernel alpha)) - #:update - (lambda (dt) - (update kernel dt)) - #:key-press - (lambda (key modifiers repeat?) - (on-key-press kernel key modifiers)) - #:key-release - (lambda (key modifiers) - (on-key-release kernel key modifiers)) - #:text-input - (lambda (text) - (on-text-input kernel text)) - #:mouse-press - ;; TODO: Handle click counter? - (lambda (button clicks x y) - (on-mouse-press kernel button x y)) - #:mouse-release - (lambda (button x y) - (on-mouse-release kernel button x y)) - #:mouse-move - (lambda (x y x-rel y-rel buttons) - (on-mouse-move kernel x y x-rel y-rel buttons)) - #:mouse-wheel - (lambda (x y) - (on-mouse-wheel kernel x y)) - #:controller-add - (lambda (controller) - (on-controller-add kernel controller)) - #:controller-remove - (lambda (controller) - (on-controller-remove kernel controller)) - #:controller-press - (lambda (controller button) - (on-controller-press kernel controller button)) - #:controller-release - (lambda (controller button) - (on-controller-release kernel controller button)) - #:controller-move - (lambda (controller axis value) - (on-controller-move kernel controller axis value)))))) - -(define (exit-catbird) - "Stop the Catbird engine." - (abort-game)) diff --git a/catbird/overlay.scm b/catbird/overlay.scm index a0563f1..b2a36d2 100644 --- a/catbird/overlay.scm +++ b/catbird/overlay.scm @@ -35,9 +35,7 @@ #:use-module (chickadee scripting) #:use-module (ice-9 format) #:use-module (oop goops) - #:export (make-overlay - notify - open-minibuffer)) + #:export (make-overlay)) (define %background-color (make-color 0.2 0.2 0.2 0.8)) @@ -74,10 +72,6 @@ (sleep 5.0) (detach notification)))) -(define-method (open-minibuffer) - (let ((r (find-region-by-name 'overlay))) - (push-major-mode (scene r) (make <minibuffer-mode>)))) - (define-class <fps-display> (<node-2d>)) (define-method (on-boot (fps-display <fps-display>)) @@ -111,7 +105,11 @@ (define-method (update-fps (fps-display <fps-display>)) (set! (text (& fps-display label)) - (format #f "~1,1f" (frames-per-second)))) + (format #f "~1,1f" (frames-per-second (current-kernel))))) + +(define (scene-for-region name) + (let ((r (find-region-by-name name))) + (and r (scene r)))) (define-minibuffer-command show-fps (let* ((r (find-region-by-name 'overlay)) @@ -123,15 +121,11 @@ #:position (vec2 0.0 (area-height r))))))) (define-minibuffer-command hide-fps - (let* ((r (find-region-by-name 'overlay)) - (s (and r (scene r))) + (let* ((s (scene-for-region 'overlay)) (f (and s (& s fps-display)))) (when f (detach f)))) (define-minibuffer-command repl - (let* ((r (find-region-by-name 'overlay)) - (s (and r (scene r)))) + (let ((s (scene-for-region 'overlay))) (when s (push-major-mode s (make <repl-mode>))))) - -(bind-input/global (key-press 'x '(alt)) open-minibuffer) |