summaryrefslogtreecommitdiff
path: root/starling
diff options
context:
space:
mode:
authorDavid Thompson <dthompson@vistahigherlearning.com>2020-09-26 16:52:29 -0400
committerDavid Thompson <dthompson@vistahigherlearning.com>2020-09-26 16:52:29 -0400
commitc365d816698ed769683abfd814ec41e3ae3abc79 (patch)
treee323a3424eee05477df2ce4f6511e13d7d0eedf5 /starling
parent6bc296631b7cc6988112489030ad7a8c18648e88 (diff)
Migrate over changes from unfinished spring lisp game jam entry.
Diffstat (limited to 'starling')
-rw-r--r--starling/asset.scm10
-rw-r--r--starling/kernel.scm85
-rw-r--r--starling/node-2d.scm32
-rw-r--r--starling/node.scm5
-rw-r--r--starling/scene.scm20
5 files changed, 105 insertions, 47 deletions
diff --git a/starling/asset.scm b/starling/asset.scm
index a14a050..d898655 100644
--- a/starling/asset.scm
+++ b/starling/asset.scm
@@ -22,6 +22,7 @@
;;; Code:
(define-module (starling asset)
+ #:use-module (chickadee render texture)
#:use-module (ice-9 ftw)
#:use-module (ice-9 match)
#:use-module (oop goops)
@@ -38,7 +39,8 @@
reload-modified-assets
clear-asset-cache
asset-ref
- define-asset))
+ define-asset
+ load-tile-atlas))
(define-class <asset> ()
(watch? #:allocation #:class #:init-form #f)
@@ -198,3 +200,9 @@
#:file-name file-name
#:loader loader
#:loader-args (list loader-args ...))))
+
+;; Convenience procedure for loading tilesets
+(define* (load-tile-atlas file-name tile-width tile-height
+ #:key (margin 0) (spacing 0))
+ (split-texture (load-image file-name) tile-width tile-height
+ #:margin margin #:spacing spacing))
diff --git a/starling/kernel.scm b/starling/kernel.scm
index 4897eba..0a73bbd 100644
--- a/starling/kernel.scm
+++ b/starling/kernel.scm
@@ -23,10 +23,12 @@
;;; Code:
(define-module (starling kernel)
+ #:use-module (chickadee audio)
#:use-module (chickadee game-loop)
#:use-module (chickadee render)
#:use-module (chickadee render gpu)
#:use-module (chickadee render viewport)
+ #:use-module (gl)
#:use-module (ice-9 match)
#:use-module (oop goops)
#:use-module (sdl2)
@@ -34,19 +36,18 @@
#:use-module (sdl2 input game-controller)
#:use-module (sdl2 input joystick)
#:use-module (sdl2 input text)
- #:use-module (sdl2 mixer)
- #:use-module (sdl2 video)
#:use-module (starling asset)
#:use-module (starling config)
#:use-module (starling node)
#:use-module (starling repl)
#:use-module (starling scene)
+ #:use-module ((sdl2 video) #:prefix sdl2:)
#:use-module (system repl command)
#:export (<window-config>
- width
- height
- title
- fullscreen?
+ window-width
+ window-height
+ window-title
+ window-fullscreen?
<kernel>
window-config
@@ -62,15 +63,15 @@
#:re-export (abort-game))
(define-class <window-config> ()
- (width #:accessor width #:init-form 640 #:init-keyword #:width)
- (height #:accessor height #:init-form 480 #:init-keyword #:height)
- (title #:accessor title #:init-form "Made with Starling Game Engine"
+ (width #:accessor window-width #:init-form 640 #:init-keyword #:width)
+ (height #:accessor window-height #:init-form 480 #:init-keyword #:height)
+ (title #:accessor window-title #:init-form "Lisparuga"
#:init-keyword #:title)
- (fullscreen? #:accessor fullscreen? #:init-form #f
+ (fullscreen? #:accessor window-fullscreen? #:init-form #f
#:init-keyword #:fullscreen?))
(define-class <kernel> (<scene-mux>)
- (name #:accessor name #:init-form "starling-kernel"
+ (name #:accessor name #:init-form "lisparuga-kernel"
#:init-keyword #:name)
(window-config #:accessor window-config #:init-form (make <window-config>)
#:init-keyword #:window-config)
@@ -114,11 +115,20 @@
;; Start REPL server.
(attach-to kernel (make <repl> #:name 'repl))))
+(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)))
+ (next-method))
+
(define-method (update-tree (kernel <kernel>) dt)
(define (invert-y y)
;; SDL's origin is the top-left, but our origin is the bottom
;; left so we need to invert Y coordinates that SDL gives us.
- (match (window-size (window kernel))
+ (match (sdl2:window-size (window kernel))
((_ height)
(- height y))))
(define (process-event event)
@@ -204,20 +214,24 @@
(next-method))
(define-method (update (kernel <kernel>) dt)
+ (update-audio)
(when developer-mode?
(reload-modified-assets))
;; Free any GPU resources that have been GC'd.
(gpu-reap!))
+(define %clear-mask
+ (logior (attrib-mask color-buffer)
+ (attrib-mask depth-buffer)
+ (attrib-mask stencil-buffer)
+ (attrib-mask accum-buffer)))
+
(define-method (render-tree (kernel <kernel>) alpha)
(let ((start-time (elapsed-time)))
- ;; Switch to the null viewport to ensure that
- ;; the default viewport will be re-applied and
- ;; clear the screen.
- (set-gpu-viewport! (current-gpu) null-viewport)
(with-viewport (default-viewport kernel)
+ (clear-screen)
(next-method))
- (swap-gl-window (window kernel))
+ (sdl2:swap-gl-window (window kernel))
;; Compute FPS.
(set! (avg-frame-time kernel)
(+ (* (- (elapsed-time) start-time) 0.1)
@@ -225,10 +239,10 @@
(define-method (on-error (kernel <kernel>) stack key args)
(if developer-mode?
- (let ((title (window-title (window kernel))))
- (set-window-title! (window kernel) (string-append "[ERROR] " title))
+ (let ((title (sdl2:window-title (window kernel))))
+ (sdl2:set-window-title! (window kernel) (string-append "[ERROR] " title))
(on-error (& kernel repl) stack key args)
- (set-window-title! (window kernel) title))
+ (sdl2:set-window-title! (window kernel) title))
(apply throw key args)))
(define-method (on-scenes-empty (kernel <kernel>))
@@ -245,26 +259,25 @@
;; This will throw an error if any audio subsystem is unavailable,
;; but not every audio subsystem is needed so don't crash the
;; program over it.
- (false-if-exception (mixer-init))
- (open-audio)
(start-text-input)
;; Discover all game controllers that are already connected. New
;; connections/disconnections will be handled by events as they occur.
(initialize-controllers kernel)
+ (init-audio)
(let ((wc (window-config kernel)))
(set! (window kernel)
- (make-window #:opengl? #t
- #:title (title wc)
- #:size (list (width wc) (height wc))
- #:fullscreen? (fullscreen? wc)))
- (set! (gl-context kernel) (make-gl-context (window kernel)))
+ (sdl2:make-window #:opengl? #t
+ #:title (window-title wc)
+ #:size (list (window-width wc) (window-height wc))
+ #:fullscreen? (window-fullscreen? wc)))
+ (set! (gl-context kernel) (sdl2:make-gl-context (window kernel)))
(set! (default-viewport kernel)
- (make-viewport 0 0 (width wc) (height wc)))
+ (make-viewport 0 0 (window-width wc) (window-height wc)))
;; Attempt to activate vsync, if possible. Some systems do
;; not support setting the OpenGL swap interval.
(catch #t
(lambda ()
- (set-gl-swap-interval! 'vsync))
+ (sdl2:set-gl-swap-interval! 'vsync))
(lambda args
(display "warning: could not enable vsync\n"
(current-error-port))))
@@ -283,19 +296,27 @@
#:update-hz (update-hz kernel))))
(lambda ()
(deactivate kernel)
- (close-window! (window kernel))))))
+ (quit-audio)
+ (sdl2:delete-gl-context! (gl-context kernel))
+ (sdl2:close-window! (window kernel))))))
(define (reboot-current-scene)
"Reboot the currently active scene being managed by the game engine
kernel. A convenient procedure for developers."
+ (display "rebooting\n")
(reboot (current-scene (current-kernel))))
-(define-meta-command ((debug-game starling) repl)
+(define-meta-command ((debug-game lisparuga) repl)
"debug-game
Enter a debugger for the current game loop error."
(debugger (& (current-kernel) repl)))
-(define-meta-command ((resume-game starling) repl)
+(define-meta-command ((resume-game lisparuga) repl)
"resume-game
Resume the game loop without entering a debugger."
(set! (repl-debugging? (& (current-kernel) repl)) #f))
+
+(define-meta-command ((reboot lisparuga) repl)
+ "reboot
+Reboot the current scene."
+ (reboot-current-scene))
diff --git a/starling/node-2d.scm b/starling/node-2d.scm
index 39a1bc2..bf7fe3f 100644
--- a/starling/node-2d.scm
+++ b/starling/node-2d.scm
@@ -174,6 +174,7 @@
(define-syntax-rule (with-camera camera body ...)
(with-framebuffer (framebuffer camera)
+ (clear-screen)
(with-projection (if (target camera)
(view-matrix camera)
(projection-matrix camera))
@@ -191,6 +192,8 @@
(define-class <view-2d> ()
(camera #:accessor camera #:init-keyword #:camera)
(area #:getter area #:init-keyword #:area)
+ (clear-color #:getter clear-color #:init-keyword #:clear-color
+ #:init-value tango-light-sky-blue)
(viewport #:accessor viewport)
(projection-matrix #:accessor projection-matrix)
(sprite-rect #:accessor sprite-rect))
@@ -206,7 +209,8 @@
(make-viewport (inexact->exact x)
(inexact->exact y)
(inexact->exact w)
- (inexact->exact h)))
+ (inexact->exact h)
+ #:clear-color (clear-color view)))
(set! (sprite-rect view) (make-rect 0.0 0.0 w h))
(set! (projection-matrix view) (orthographic-projection 0 w h 0 0 1))))
@@ -601,7 +605,31 @@
(define-class <label> (<node-2d>)
(font #:accessor font #:init-keyword #:font #:init-thunk default-font)
- (text #:accessor text #:init-form "" #:init-keyword #:text))
+ (text #:accessor text #:init-form "" #:init-keyword #:text)
+ (align #:accessor align #:init-value 'left #:init-keyword #:align)
+ (vertical-align #:accessor vertical-align #:init-value 'bottom
+ #:init-keyword #:vertical-align))
+
+(define-method (initialize (label <label>) initargs)
+ (next-method)
+ (realign label))
+
+(define-method ((setter text) (label <label>) s)
+ (slot-set! label 'text s)
+ (realign label))
+
+(define-method (realign (label <label>))
+ (let ((font (asset-ref (font label))))
+ (set-vec2! (origin label)
+ (match (align label)
+ ('left 0.0)
+ ('right (font-line-width font (text label)))
+ ('center (/ (font-line-width font (text label)) 2.0)))
+ (match (vertical-align label)
+ ('bottom 0.0)
+ ('top (font-line-height font))
+ ('center (/ (font-line-height font) 2.0)))))
+ (dirty! label))
(define-method (render (label <label>) alpha)
(draw-text* (asset-ref (font label)) (text label) (world-matrix label)))
diff --git a/starling/node.scm b/starling/node.scm
index a0141c1..947d1cb 100644
--- a/starling/node.scm
+++ b/starling/node.scm
@@ -168,8 +168,9 @@ represented as a ratio in the range [0, 1]."
;; First time activating? We must boot!
(unless (booted? node) (boot node))
(set! (active? node) #t)
- (on-enter node)
- (for-each-child activate node))
+ (for-each-child activate node)
+ ;; Activate all children, recursively, before calling on-enter hook.
+ (on-enter node))
(define-method (deactivate (node <node>))
"Mark NODE and all of its children as inactive."
diff --git a/starling/scene.scm b/starling/scene.scm
index 5b0d840..afe3827 100644
--- a/starling/scene.scm
+++ b/starling/scene.scm
@@ -24,9 +24,9 @@
(define-module (starling scene)
#:use-module (chickadee)
+ #:use-module (chickadee audio)
#:use-module (ice-9 match)
#:use-module (oop goops)
- #:use-module (sdl2 mixer)
#:use-module (starling node)
#:export (<scene>
background-music
@@ -54,6 +54,8 @@
on-scenes-empty))
(define-class <scene> (<node>)
+ (background-music-source #:getter background-music-source
+ #:init-form (make-source #:loop? #t))
(background-music #:accessor background-music #:init-form #f
#:init-keyword #:music)
(background-music-volume #:accessor background-music-volume #:init-form 1.0
@@ -62,17 +64,15 @@
#:init-keyword #:music-loop?))
(define-method (on-enter (scene <scene>))
- (if (music? (background-music scene))
- (begin
- (set-music-volume! (inexact->exact
- (round
- (* (background-music-volume scene) 128.0))))
- (play-music! (background-music scene)
- (if (background-music-loop? scene) #f 1)))
- (stop-music!)))
+ (when (audio? (background-music scene))
+ (set-source-volume! (background-music-source scene)
+ (background-music-volume scene))
+ (set-source-audio! (background-music-source scene)
+ (background-music scene))
+ (source-play (background-music-source scene))))
(define-method (on-exit (scene <scene>))
- (stop-music!))
+ (source-stop (background-music-source scene)))
;; Input event handler methods
(define-method (on-quit (scene <scene>))