summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Thompson <dthompson@vistahigherlearning.com>2022-10-26 18:30:32 -0400
committerDavid Thompson <dthompson@vistahigherlearning.com>2022-10-26 18:30:32 -0400
commit2c2be9855320473ee7fdc23f54ae6c01c6a569c7 (patch)
tree632c29ab1ac86a9fe652b21d44f42738f12f3e6e
parent949372cf3fc361d42878e85901abb9dc8c3ec78a (diff)
Add root module to remove use of module-ref in (catbird kernel).
-rw-r--r--Makefile.am3
-rw-r--r--catbird.scm120
-rw-r--r--catbird/kernel.scm131
-rw-r--r--catbird/overlay.scm22
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)