summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Makefile.am2
-rw-r--r--game.scm176
-rw-r--r--lisparuga/audio.scm72
-rw-r--r--lisparuga/utils.scm15
-rw-r--r--lisparuga/view.scm172
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))))