Migrate over changes from unfinished spring lisp game jam entry.

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>))