summaryrefslogtreecommitdiff
path: root/catbird.scm
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 /catbird.scm
parent949372cf3fc361d42878e85901abb9dc8c3ec78a (diff)
Add root module to remove use of module-ref in (catbird kernel).
Diffstat (limited to 'catbird.scm')
-rw-r--r--catbird.scm120
1 files changed, 120 insertions, 0 deletions
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))