Factor out sound and rendering procedures.

5 files changed, 263 insertions, 174 deletions

diff --git a/Makefile.am b/Makefile.am
index ef006ae..efc0a1e 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -38,12 +38,14 @@ godir=$(libdir)/guile/$(GUILE_EFFECTIVE_VERSION)/ccache
 
 SOURCES = 					\
   lisparuga/utils.scm				\
+  lisparuga/audio.scm				\
   lisparuga/bullets.scm				\
   lisparuga/enemies.scm				\
   lisparuga/explosions.scm			\
   lisparuga/player.scm				\
   lisparuga/stats.scm				\
   lisparuga/world.scm				\
+  lisparuga/view.scm				\
   game.scm
 
 imagesdir = $(pkgdatadir)/images
diff --git a/game.scm b/game.scm
index d4df021..e08b110 100644
--- a/game.scm
+++ b/game.scm
@@ -20,21 +20,18 @@
              (sly actor)
              (sly audio)
              (sly fps)
-             (sly live-reload)
-             ((sly math vector) #:select (magnitude) #:prefix v:)
-             (sly records)
              (sly render framebuffer)
              (sly render sprite-batch)
              (sly render tileset)
              (srfi srfi-1)
-             (srfi srfi-9)
-             (srfi srfi-11)
+             (lisparuga audio)
              (lisparuga bullets)
              (lisparuga enemies)
              (lisparuga explosions)
              (lisparuga player)
              (lisparuga stats)
              (lisparuga utils)
+             (lisparuga view)
              (lisparuga world))
 
 
@@ -63,16 +60,6 @@
                 (signal-let ((restart? (key-down? 'return)))
                   `(restart ,restart?)))))
 
-(define (key-toggle key)
-  "Create a signal that is initially #f and toggles between #t and #f
-each time KEY is pressed."
-  (signal-fold (lambda (down? previous)
-                 (and down? (not previous)))
-               #f
-               (signal-filter identity #f
-                              ;; Ignore repeated key down signals.
-                              (signal-drop-repeats (key-down? key)))))
-
 (define-signal display-fps? (key-toggle 'f))
 
 
@@ -80,11 +67,6 @@ each time KEY is pressed."
 ;;; Music and Sound
 ;;;
 
-(define load-music*
-  (memoize
-   (lambda (file)
-     (load-music (string-append "assets/music/" file)))))
-
 (define-signal music
   (signal-drop-repeats
    (signal-let ((world world))
@@ -94,39 +76,6 @@ each time KEY is pressed."
                    ((game-won? world) "title-screen.ogg")
                    (else "level-2.ogg"))))))
 
-(define (loop-music music)
-  (play-music music #:loop? #t))
-
-(define (load-sample* file)
-  (load-sample (string-append "assets/sounds/" file)))
-
-(define (enemy-hit-sound world time)
-  (and (any (lambda (enemy)
-              (let ((hit-time (enemy-last-hit-time (actor-ref enemy))))
-                (and hit-time (= time hit-time))))
-            (world-enemies world))
-       'enemy-hit))
-
-(define (player-shoot-sound world time)
-  (and (zero? (modulo time 5))
-       (player-shooting? (actor-ref (world-player world)))
-       'player-shoot))
-
-(define (player-death-sound world time)
-  (and (let ((death-time (player-last-death-time
-                          (actor-ref (world-player world)))))
-         (and death-time (= time death-time)))
-       'player-death))
-
-(define (explosion-sound world time)
-  (and (any (lambda (explosion)
-              (let ((explode-time (explosion-time explosion)))
-                (= time explode-time)))
-            (world-explosions world))
-       'explosion))
-
-(define (play-sound-effects sounds)
-  (for-each play-sample sounds))
 
 (define-signal sounds
   (on-start
@@ -152,17 +101,6 @@ each time KEY is pressed."
 ;;; View
 ;;;
 
-(define resolution-scale 4)
-(define scaled-resolution (v* resolution resolution-scale))
-
-(define camera
-  (2d-camera #:area (make-rect 0 0 (vx resolution) (vy resolution))))
-
-(define scaled-camera
-  (2d-camera #:area (make-rect 0 0
-                               (vx scaled-resolution)
-                               (vy scaled-resolution))))
-
 (define-signal framebuffer
   (on-start
    (make-framebuffer (vx scaled-resolution) (vy scaled-resolution))))
@@ -181,8 +119,6 @@ each time KEY is pressed."
   (on-start
    (load-font "assets/fonts/kenpixel_mini.ttf" 16)))
 
-(define font-color (rgb #xdeeed6))
-
 (define-signal fps-text
   (signal-let ((fps fps)
                (font font))
@@ -233,12 +169,6 @@ each time KEY is pressed."
                            #:anchor 'top-left)))
         render-nothing)))
 
-(define render-status-text
-  (memoize
-   (lambda (font text)
-     (render-sprite
-      (make-label font text #:blended? #f #:anchor 'center)))))
-
 (define-signal status-text
   (signal-let ((big-font big-font)
                (font font)
@@ -277,9 +207,6 @@ each time KEY is pressed."
      (else
       render-nothing))))
 
-(define load-sprite/live (with-live-reload load-sprite))
-(define load-tileset/live (with-live-reload load-tileset))
-
 (define-signal background
   (load-sprite/live "assets/images/background.png"
                     #:anchor 'bottom-left))
@@ -303,16 +230,6 @@ each time KEY is pressed."
 (define-signal chain-tileset
   (load-tileset/live "assets/images/chain.png" 24 16))
 
-(define make-chain-sprite
-  (memoize
-   (lambda (tileset stats)
-     (make-sprite (tileset-ref tileset
-                               (- (match (stats-chain-type stats)
-                                    ('light 2)
-                                    ('dark  5))
-                                  (1- (stats-chain-progress stats))))
-                  #:anchor 'top-left))))
-
 (define-signal chain-sprite
   (signal-map-maybe (lambda (world tileset)
                       (let ((stats (world-stats world)))
@@ -341,25 +258,6 @@ each time KEY is pressed."
                     world
                     player-tileset))
 
-(define (make-scrolling-background background time speed)
-  (signal-let ((background background)
-               (time timer))
-    (if background
-        (let* ((height (vy resolution))
-               (y (- (* (modulo time (round (/ height speed))) speed)))
-               (render (render-sprite background)))
-          (render-begin
-           (move (vector2 0 y) render)
-           (move (vector2 0 (+ y height)) render)))
-        render-nothing)))
-
-(define (render-sprite-maybe sprite)
-  (signal-map (lambda (sprite)
-                (if sprite
-                    (render-sprite sprite)
-                    render-nothing))
-              sprite))
-
 (define-signal scrolling-background
   (signal-map render-begin
               ;;(make-scrolling-background background timer 0.2)
@@ -369,74 +267,6 @@ each time KEY is pressed."
 (define-signal batch
   (on-start (make-sprite-batch 1000)))
 
-(define bullet-rect (make-rect -8 -8 16 16))
-(define enemy-rect (make-rect -8 -8 16 16))
-(define explosion-rect (make-rect -8 -8 16 16))
-
-(define (render-bullets bullets tileset batch)
-  (lambda (context)
-    (with-sprite-batch batch context
-      (for-each (lambda (actor)
-                  (let* ((bullet (actor-ref actor))
-                         (rect (rect-move bullet-rect
-                                          (bullet-position bullet)))
-                         (tex (tileset-ref tileset
-                                           (match (bullet-type bullet)
-                                             ('player-light 12)
-                                             ('player-dark 13)
-                                             ('large-light 9)
-                                             ('large-dark 8)
-                                             ('small-light 11)
-                                             ('small-dark 10)))))
-                    (sprite-batch-add! batch context tex rect)))
-                bullets))))
-
-(define (render-enemies enemies tileset batch time)
-  (lambda (context)
-    (with-sprite-batch batch context
-      (for-each (lambda (actor)
-                  (let* ((enemy (actor-ref actor))
-                         (hit-time (enemy-last-hit-time enemy))
-                         (hit? (and hit-time (zero? (- time hit-time))))
-                         (rect (rect-move enemy-rect (enemy-position enemy)))
-                         (tex (tileset-ref tileset
-                                           (+ (match (enemy-type enemy)
-                                                ('popcorn-dark 0)
-                                                ('popcorn-light 4)
-                                                ('pincer-dark 8)
-                                                ('pincer-light 12))
-                                              (if hit?
-                                                  ;; Use the hit
-                                                  ;; indicator frame.
-                                                  2
-                                                  ;; Swap between the
-                                                  ;; 2 normal
-                                                  ;; animation frames.
-                                                  (modulo (round (/ time 5))
-                                                          2))))))
-                    (sprite-batch-add! batch context tex rect)))
-                enemies))))
-
-(define (render-player player sprite time)
-  (if (and (player-invincible? player time)
-           (odd? (round (/ time 3))))
-      render-nothing
-      (move (player-position player)
-            (render-sprite sprite))))
-
-(define (render-explosions explosions tileset batch time)
-  (lambda (context)
-    (with-sprite-batch batch context
-      (for-each (lambda (explosion)
-                  (let* ((start-time (explosion-time explosion))
-                         (rect (rect-move explosion-rect
-                                          (explosion-position explosion)))
-                         ;; 3 frames of animation.
-                         (frame (min 2 (floor (/ (- time start-time) 5))))
-                         (tex (tileset-ref tileset frame)))
-                    (sprite-batch-add! batch context tex rect)))
-                explosions))))
-
 (define-signal scene
   (signal-let ((fps-text fps-text)
                (score-text score-text)
@@ -514,5 +344,5 @@ each time KEY is pressed."
   (run-game-loop scene))
 
 ;;; Local Variables:
-;;; compile-command: "../pre-inst-env guile simple.scm"
+;;; compile-command: "../pre-inst-env guile game.scm"
 ;;; End:
diff --git a/lisparuga/audio.scm b/lisparuga/audio.scm
new file mode 100644
index 0000000..3ec04e6
--- /dev/null
+++ b/lisparuga/audio.scm
@@ -0,0 +1,72 @@
+;;; Lisparuga
+;;; Copyright © 2016 David Thompson <davet@gnu.org>
+;;;
+;;; Lisparuga 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.
+;;;
+;;; Lisparuga 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 Lisparuga.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (lisparuga audio)
+  #:use-module (srfi srfi-1)
+  #:use-module (sly actor)
+  #:use-module (sly audio)
+  #:use-module (sly utils)
+  #:use-module (lisparuga enemies)
+  #:use-module (lisparuga explosions)
+  #:use-module (lisparuga player)
+  #:use-module (lisparuga world)
+  #:export (load-music*
+            load-sample*
+            loop-music
+            enemy-hit-sound
+            player-shoot-sound
+            player-death-sound
+            explosion-sound
+            play-sound-effects))
+
+(define load-music*
+  (memoize
+   (lambda (file)
+     (load-music (string-append "assets/music/" file)))))
+
+(define (loop-music music)
+  (play-music music #:loop? #t))
+
+(define (load-sample* file)
+  (load-sample (string-append "assets/sounds/" file)))
+
+(define (enemy-hit-sound world time)
+  (and (any (lambda (enemy)
+              (let ((hit-time (enemy-last-hit-time (actor-ref enemy))))
+                (and hit-time (= time hit-time))))
+            (world-enemies world))
+       'enemy-hit))
+
+(define (player-shoot-sound world time)
+  (and (zero? (modulo time 5))
+       (player-shooting? (actor-ref (world-player world)))
+       'player-shoot))
+
+(define (player-death-sound world time)
+  (and (let ((death-time (player-last-death-time
+                          (actor-ref (world-player world)))))
+         (and death-time (= time death-time)))
+       'player-death))
+
+(define (explosion-sound world time)
+  (and (any (lambda (explosion)
+              (let ((explode-time (explosion-time explosion)))
+                (= time explode-time)))
+            (world-explosions world))
+       'explosion))
+
+(define (play-sound-effects sounds)
+  (for-each play-sample sounds))
diff --git a/lisparuga/utils.scm b/lisparuga/utils.scm
index 0c67504..db7c1d8 100644
--- a/lisparuga/utils.scm
+++ b/lisparuga/utils.scm
@@ -15,12 +15,25 @@
 ;;; along with Lisparuga.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (lisparuga utils)
+  #:use-module (sly input keyboard)
   #:use-module (sly math rect)
   #:use-module (sly math vector)
+  #:use-module (sly signal)
   #:export (resolution
             origin2
-            bounds))
+            bounds
+            key-toggle))
 
 (define resolution (vector2 120 160))
 (define origin2 (vector2 0 0))
 (define bounds (make-rect (vector2 0 0) resolution))
+
+(define (key-toggle key)
+  "Create a signal that is initially #f and toggles between #t and #f
+each time KEY is pressed."
+  (signal-fold (lambda (down? previous)
+                 (and down? (not previous)))
+               #f
+               (signal-filter identity #f
+                              ;; Ignore repeated key down signals.
+                              (signal-drop-repeats (key-down? key)))))
diff --git a/lisparuga/view.scm b/lisparuga/view.scm
new file mode 100644
index 0000000..e43d32e
--- /dev/null
+++ b/lisparuga/view.scm
@@ -0,0 +1,172 @@
+;;; Lisparuga
+;;; Copyright © 2016 David Thompson <davet@gnu.org>
+;;;
+;;; Lisparuga 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.
+;;;
+;;; Lisparuga 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 Lisparuga.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (lisparuga view)
+  #:use-module (ice-9 match)
+  #:use-module (sly actor)
+  #:use-module (sly live-reload)
+  #:use-module (sly math rect)
+  #:use-module (sly math vector)
+  #:use-module (sly render)
+  #:use-module (sly render camera)
+  #:use-module (sly render color)
+  #:use-module (sly render font)
+  #:use-module (sly render sprite)
+  #:use-module (sly render sprite-batch)
+  #:use-module (sly render tileset)
+  #:use-module (sly signal)
+  #:use-module (sly utils)
+  #:use-module (lisparuga bullets)
+  #:use-module (lisparuga enemies)
+  #:use-module (lisparuga explosions)
+  #:use-module (lisparuga player)
+  #:use-module (lisparuga stats)
+  #:use-module (lisparuga world)
+  #:use-module (lisparuga utils)
+  #:export (resolution-scale
+            scaled-resolution
+            camera
+            scaled-camera
+            font-color
+            render-status-text
+            load-sprite/live
+            load-tileset/live
+            make-chain-sprite
+            make-scrolling-background
+            render-sprite-maybe
+            render-bullets
+            render-enemies
+            render-player
+            render-explosions))
+
+(define resolution-scale 4)
+(define scaled-resolution (v* resolution resolution-scale))
+
+(define camera
+  (2d-camera #:area (make-rect 0 0 (vx resolution) (vy resolution))))
+
+(define scaled-camera
+  (2d-camera #:area (make-rect 0 0
+                               (vx scaled-resolution)
+                               (vy scaled-resolution))))
+
+(define font-color (rgb #xdeeed6))
+
+(define render-status-text
+  (memoize
+   (lambda (font text)
+     (render-sprite
+      (make-label font text #:blended? #f #:anchor 'center)))))
+
+(define load-sprite/live (with-live-reload load-sprite))
+(define load-tileset/live (with-live-reload load-tileset))
+
+(define make-chain-sprite
+  (memoize
+   (lambda (tileset stats)
+     (make-sprite (tileset-ref tileset
+                               (- (match (stats-chain-type stats)
+                                    ('light 2)
+                                    ('dark  5))
+                                  (1- (stats-chain-progress stats))))
+                  #:anchor 'top-left))))
+
+(define (make-scrolling-background background timer speed)
+  (signal-let ((background background)
+               (time timer))
+    (if background
+        (let* ((height (vy resolution))
+               (y (- (* (modulo time (round (/ height speed))) speed)))
+               (render (render-sprite background)))
+          (render-begin
+           (move (vector2 0 y) render)
+           (move (vector2 0 (+ y height)) render)))
+        render-nothing)))
+
+(define (render-sprite-maybe sprite)
+  (signal-map (lambda (sprite)
+                (if sprite
+                    (render-sprite sprite)
+                    render-nothing))
+              sprite))
+
+(define bullet-rect (make-rect -8 -8 16 16))
+(define enemy-rect (make-rect -8 -8 16 16))
+(define explosion-rect (make-rect -8 -8 16 16))
+
+(define (render-bullets bullets tileset batch)
+  (lambda (context)
+    (with-sprite-batch batch context
+      (for-each (lambda (actor)
+                  (let* ((bullet (actor-ref actor))
+                         (rect (rect-move bullet-rect
+                                          (bullet-position bullet)))
+                         (tex (tileset-ref tileset
+                                           (match (bullet-type bullet)
+                                             ('player-light 12)
+                                             ('player-dark 13)
+                                             ('large-light 9)
+                                             ('large-dark 8)
+                                             ('small-light 11)
+                                             ('small-dark 10)))))
+                    (sprite-batch-add! batch context tex rect)))
+                bullets))))
+
+(define (render-enemies enemies tileset batch time)
+  (lambda (context)
+    (with-sprite-batch batch context
+      (for-each (lambda (actor)
+                  (let* ((enemy (actor-ref actor))
+                         (hit-time (enemy-last-hit-time enemy))
+                         (hit? (and hit-time (zero? (- time hit-time))))
+                         (rect (rect-move enemy-rect (enemy-position enemy)))
+                         (tex (tileset-ref tileset
+                                           (+ (match (enemy-type enemy)
+                                                ('popcorn-dark 0)
+                                                ('popcorn-light 4)
+                                                ('pincer-dark 8)
+                                                ('pincer-light 12))
+                                              (if hit?
+                                                  ;; Use the hit
+                                                  ;; indicator frame.
+                                                  2
+                                                  ;; Swap between the
+                                                  ;; 2 normal
+                                                  ;; animation frames.
+                                                  (modulo (round (/ time 5))
+                                                          2))))))
+                    (sprite-batch-add! batch context tex rect)))
+                enemies))))
+
+(define (render-player player sprite time)
+  (if (and (player-invincible? player time)
+           (odd? (round (/ time 3))))
+      render-nothing
+      (move (player-position player)
+            (render-sprite sprite))))
+
+(define (render-explosions explosions tileset batch time)
+  (lambda (context)
+    (with-sprite-batch batch context
+      (for-each (lambda (explosion)
+                  (let* ((start-time (explosion-time explosion))
+                         (rect (rect-move explosion-rect
+                                          (explosion-position explosion)))
+                         ;; 3 frames of animation.
+                         (frame (min 2 (floor (/ (- time start-time) 5))))
+                         (tex (tileset-ref tileset frame)))
+                    (sprite-batch-add! batch context tex rect)))
+                explosions))))