From c365d816698ed769683abfd814ec41e3ae3abc79 Mon Sep 17 00:00:00 2001 From: David Thompson Date: Sat, 26 Sep 2020 16:52:29 -0400 Subject: Migrate over changes from unfinished spring lisp game jam entry. --- starling/asset.scm | 10 ++++++- starling/kernel.scm | 85 ++++++++++++++++++++++++++++++++-------------------- starling/node-2d.scm | 32 ++++++++++++++++++-- starling/node.scm | 5 ++-- 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 () (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 ( - width - height - title - fullscreen? + window-width + window-height + window-title + window-fullscreen? window-config @@ -62,15 +63,15 @@ #:re-export (abort-game)) (define-class () - (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 () - (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 ) #:init-keyword #:window-config) @@ -114,11 +115,20 @@ ;; Start REPL server. (attach-to kernel (make #:name 'repl)))) +(define-method (on-key-press (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 ) 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 ) 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 ) 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 ) 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 )) @@ -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 () (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