diff options
| -rw-r--r-- | Makefile.am | 2 | ||||
| -rw-r--r-- | game.scm | 176 | ||||
| -rw-r--r-- | lisparuga/audio.scm | 72 | ||||
| -rw-r--r-- | lisparuga/utils.scm | 15 | ||||
| -rw-r--r-- | lisparuga/view.scm | 172 |
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 @@ -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)))) |