diff options
| -rw-r--r-- | starling/asset.scm | 10 | ||||
| -rw-r--r-- | starling/kernel.scm | 85 | ||||
| -rw-r--r-- | starling/node-2d.scm | 32 | ||||
| -rw-r--r-- | starling/node.scm | 5 | ||||
| -rw-r--r-- | starling/scene.scm | 20 |
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>)) |