summaryrefslogtreecommitdiff
path: root/examples
diff options
context:
space:
mode:
Diffstat (limited to 'examples')
-rwxr-xr-xexamples/2048/2048.scm245
-rw-r--r--examples/animation.scm61
-rw-r--r--examples/common.scm4
-rw-r--r--examples/font.scm43
-rw-r--r--examples/framebuffer.scm36
-rw-r--r--examples/life.scm50
-rw-r--r--examples/mines/mines.scm133
-rw-r--r--examples/shapes.scm56
-rw-r--r--examples/simple.scm23
-rw-r--r--examples/tilemap.scm52
10 files changed, 410 insertions, 293 deletions
diff --git a/examples/2048/2048.scm b/examples/2048/2048.scm
index e9eb16d..8d2ecf9 100755
--- a/examples/2048/2048.scm
+++ b/examples/2048/2048.scm
@@ -254,25 +254,26 @@
(define-signal board
(signal-map 2048-board 2048-state))
-(define-signal score-saver
- (signal-tap (lambda (state)
- (when (board-lose? (2048-board state))
- (save-best-score state)))
- 2048-state))
+(add-signal-hook! 2048-state
+ (lambda (state)
+ (when (board-lose? (2048-board state))
+ (save-best-score state))))
+
+(define-signal same-score?
+ (signal-let ((current 2048-state)
+ (prev (signal-delay 1 2048-state)))
+ (= (2048-score prev)
+ (2048-score current))))
;;;
;;; Rendering
;;;
-(init-window)
-(enable-fonts)
+(define (maybe-play-sample sample)
+ (and sample (play-sample sample)))
(define background (rgb #xfaf8ef))
-(define tile-texture (load-texture "tile.png"))
-
-(define font (load-default-font 32))
-
(define text-color-1 (rgb #x776e65))
(define text-color-2 (rgb #xf9f6f2))
@@ -308,15 +309,12 @@
(define (tile-text-color n)
(assoc-ref (assoc-ref tile-properties n) 'text-color))
-(define tile-sprite
- (make-sprite tile-texture #:anchor (vector2 0 0)))
-
-(define tile-label-cache
+(define (make-tile-label-cache font)
(map (lambda (n)
(cons n (make-label font (number->string n) #:anchor 'center)))
'(2 4 8 16 32 64 128 256 512 1024 2048)))
-(define (render-tile x y n)
+(define (render-tile tile-texture tile-sprite tile-label-cache x y n)
(let ((w (texture-width tile-texture))
(h (texture-height tile-texture))
(label (assoc-ref tile-label-cache n))
@@ -334,130 +332,191 @@
(define window-width 640)
(define window-height 480)
-(define board-width
- (* board-size (texture-width tile-texture)))
-(define board-height
- (* board-size (texture-height tile-texture)))
-(define center-pos
- (vector2 (/ (- window-width board-width) 2) 8))
(define (enumerate-board board)
(enumerate (map (cut enumerate <>) board)))
-(define (render-board board)
+(define (render-board board tile-texture tile-sprite tile-label-cache)
(list->renderer
(append-map
(match-lambda
((y (row ...))
(map (match-lambda
((x n)
- (render-tile x y n)))
+ (render-tile tile-texture tile-sprite tile-label-cache x y n)))
row)))
(enumerate-board board))))
-(define-signal tiles
- (signal-map render-board board))
-
-(define play-again-font (load-default-font 16))
-
(define (render-label font text anchor)
(with-color black
(render-sprite
(make-label font text #:anchor anchor))))
-(define-signal status-message
- (let ((play-again (render-label play-again-font
- "Press N to play again"
- 'top-center))
- (game-over (render-label font "GAME OVER" 'bottom-center))
- (you-win (render-label font "YOU WIN!" 'bottom-center)))
- (signal-map
- (lambda (board)
- (let ((message (cond
- ((board-lose? board) game-over)
- ((board-win? board) you-win)
- (else #f))))
- (if message
- (move (vector2 (/ board-width 2)
- (/ board-height 2))
- (render-begin message play-again))
- render-nothing)))
- board)))
-
-(define instruction-font (load-default-font 16))
-
(define instruction-text
"Use the arrow keys to join the numbers and get to the 2048 tile!")
-(define-signal instructions
- (with-color text-color-1
- (move (vector2 (/ board-width 2)
- (- window-height (vy center-pos)))
- (render-sprite
- (make-label instruction-font instruction-text
- #:anchor 'top-center)))))
-
-(define score-header-font (load-default-font 14))
-(define score-font (load-default-font 22))
-
(define (score-label text score x)
(let* ((duration 15)
(position-tween (let* ((to (vector2 0 -32))
(from (v- to (vector2 0 -8))))
(tween vlerp ease-linear from to duration)))
(color-tween (tween color-lerp ease-linear
- transparent text-color-1 duration))
- (header (make-label score-header-font text #:anchor 'top-center)))
- (signal-let* ((score (signal-drop-repeats score))
+ transparent text-color-1 duration)))
+ (signal-let* ((score-font score-font)
+ (x x)
+ (header (render-label-maybe score-header-font
+ text
+ 'top-center))
+ (score (signal-drop-repeats score))
(timer (signal-drop (lambda (t) (> t duration))
0 (signal-since 1 score))))
- (let ((score (make-label score-font (number->string score)
- #:anchor 'center)))
- (move (vector2 x (- window-height 28))
- (render-begin
- (with-color text-color-1
- (render-sprite header))
- (move (position-tween timer)
- (with-color (color-tween timer)
- (render-sprite score)))))))))
+ (if (and score-font header x)
+ (let ((score (make-label score-font (number->string score)
+ #:anchor 'center)))
+ (move (vector2 x (- window-height 28))
+ (render-begin
+ (with-color text-color-1 header)
+ (move (position-tween timer)
+ (with-color (color-tween timer)
+ (render-sprite score))))))
+ render-nothing))))
+
+(define camera
+ (2d-camera #:area (make-rect 0 0 640 480) #:clear-color background))
+
+(define* (render-label-maybe font message anchor)
+ (signal-map-maybe (lambda (font)
+ (render-label font message anchor))
+ font))
+
+(define-signal tile-texture
+ (on-start (load-texture "tile.png")))
+
+(define-signal board-width
+ (signal-map-maybe (lambda (tile-texture)
+ (* board-size (texture-width tile-texture)))
+ tile-texture))
+
+(define-signal board-height
+ (signal-map-maybe (lambda (tile-texture)
+ (* board-size (texture-height tile-texture)))
+ tile-texture))
+
+(define-signal center-pos
+ (signal-map-maybe (lambda (board-width)
+ (vector2 (/ (- window-width board-width) 2) 8))
+ board-width))
+
+(define-signal score-unchanged-sound
+ (on-start (load-sample "../sounds/hit.wav")))
+
+(define-signal score-changed-sound
+ (on-start (load-sample "../sounds/jump.wav")))
+
+(define-signal sound-effect
+ (signal-map-maybe (cut if <> <> <>)
+ same-score?
+ score-unchanged-sound
+ score-changed-sound))
+
+(define-signal font
+ (on-start (load-default-font 32)))
+
+(define-signal tile-sprite
+ (signal-map-maybe (cut make-sprite <> #:anchor (vector2 0 0))
+ tile-texture))
+
+(define-signal tile-label-cache
+ (signal-map-maybe make-tile-label-cache font))
+
+(define-signal tiles
+ (signal-map-maybe render-board
+ board
+ tile-texture
+ tile-sprite
+ tile-label-cache))
+
+(define-signal instruction-font
+ (on-start (load-default-font 16)))
+
+(define-signal play-again-font
+ (on-start (load-default-font 16)))
+
+(define-signal score-header-font
+ (on-start (load-default-font 14)))
+
+(define-signal score-font
+ (on-start (load-default-font 22)))
+
+(define-signal status-message
+ (signal-let ((board board)
+ (play-again (render-label-maybe play-again-font
+ "Press N to play again"
+ 'top-center))
+ (game-over (render-label-maybe font "GAME OVER" 'bottom-center))
+ (you-win (render-label-maybe font "YOU WIN!" 'bottom-center))
+ (board-width board-width)
+ (board-height board-height))
+ (let ((message (cond
+ ((board-lose? board) game-over)
+ ((board-win? board) you-win)
+ (else #f))))
+ (if message
+ (move (vector2 (/ board-width 2)
+ (/ board-height 2))
+ (render-begin message play-again))
+ render-nothing))))
(define-signal score
- (score-label "SCORE" (signal-map 2048-score 2048-state) (/ board-width 4)))
+ (score-label "SCORE"
+ (signal-map 2048-score 2048-state)
+ (signal-map-maybe (cut / <> 4) board-width)))
(define-signal best-score
- (score-label "BEST" (signal-map 2048-best-score 2048-state)
- (- board-width (/ board-width 4))))
+ (score-label "BEST"
+ (signal-map 2048-best-score 2048-state)
+ (signal-map-maybe (lambda (width)
+ (- width (/ width 4)))
+ board-width)))
-(define-signal 2048-view
- (signal-let ((instructions instructions)
- (tiles tiles)
- (score score)
- (best-score best-score)
- (status-message status-message))
- (move center-pos
- (render-begin
- instructions
- tiles
- score
- best-score
- status-message))))
+(define-signal instructions
+ (signal-map-maybe (lambda (board-width center-pos instruction-font)
+ (with-color text-color-1
+ (move (vector2 (/ board-width 2)
+ (- window-height (vy center-pos)))
+ (render-sprite
+ (make-label instruction-font instruction-text
+ #:anchor 'top-center)))))
+ board-width
+ center-pos
+ instruction-font))
-(define camera
- (2d-camera #:area (make-rect 0 0 640 480) #:clear-color background))
+(define-signal 2048-view
+ (signal-map-maybe (lambda (center . renderers)
+ (move center (list->renderer renderers)))
+ center-pos
+ instructions
+ tiles
+ score
+ best-score
+ status-message))
(define-signal 2048-scene
(signal-let ((view 2048-view))
- (with-camera camera view)))
+ (with-camera camera (or view render-nothing))))
;;;
;;; Initialization
;;;
-(start-sly-repl)
+;; (start-sly-repl)
+(add-signal-hook! sound-effect maybe-play-sample)
(add-hook! window-close-hook stop-game-loop)
(with-window (make-window #:title "2048")
+ (enable-fonts)
+ (enable-audio)
(run-game-loop 2048-scene))
;;; Local Variables:
diff --git a/examples/animation.scm b/examples/animation.scm
index 8aaff2e..6afbf34 100644
--- a/examples/animation.scm
+++ b/examples/animation.scm
@@ -15,12 +15,14 @@
;;; along with this program. If not, see
;;; <http://www.gnu.org/licenses/>.
-(use-modules (sly utils)
+(use-modules (srfi srfi-43)
+ (sly utils)
(sly game)
(sly window)
(sly signal)
(sly math)
(sly math rect)
+ ((sly math transform) #:prefix t:)
(sly math tween)
(sly math vector)
(sly render)
@@ -33,31 +35,54 @@
(define sprite* (memoize make-sprite))
(define move* (memoize move))
-(define walk-cycle
- (let ((tiles (load-tileset "images/princess.png" 64 64)))
- (list->vector
- (map (lambda (id)
- (sprite* (tileset-ref tiles id)))
- '(19 20 21 22 23 24 25 26)))))
+(define (make-walk-cycle tiles)
+ (list->vector
+ (map (lambda (id)
+ (sprite* (tileset-ref tiles id)))
+ '(19 20 21 22 23 24 25 26))))
(define position-tween
(tween vlerp (compose ease-linear ease-loop)
- (vector2 480 240) (vector2 160 240) 120))
+ (vector2 640 240) (vector2 0 240) 90))
-(define frame-tween
- (let* ((frame-count (vector-length walk-cycle))
- (frame-rate (/ 60 frame-count)))
- (tween (compose floor lerp) (compose ease-linear ease-loop)
- 0 frame-count (* frame-count frame-rate))))
+(define (make-frame-tween walk-cycle)
+ (if (vector-empty? walk-cycle)
+ (const 0)
+ (let* ((frame-count (vector-length walk-cycle))
+ (frame-rate (/ 60 frame-count)))
+ (tween (compose floor lerp) (compose ease-linear ease-loop)
+ 0 frame-count (* frame-count frame-rate)))))
(define camera (2d-camera #:area (make-rect 0 0 640 480)))
+(define (move/interpolate new old renderer)
+ (lambda (gfx)
+ (graphics-model-view-excursion gfx
+ (lambda (gfx)
+ (let ((v (vlerp old new (graphics-alpha gfx))))
+ (graphics-model-view-mul! gfx (t:translate v))
+ (renderer gfx))))))
+
+(define (render time walk-cycle frame-tween)
+ (let* ((frame (vector-ref walk-cycle (frame-tween time))))
+ (with-camera camera
+ (move/interpolate (position-tween time)
+ (position-tween (1- time))
+ (render-sprite frame)))))
+
+(define-signal walk-cycle
+ (signal-map-maybe make-walk-cycle
+ (on-start (load-tileset "images/princess.png" 64 64))))
+
+(define-signal time (signal-timer))
+
+(define-signal frame-tween
+ (signal-map-maybe make-frame-tween walk-cycle))
+
(define-signal scene
- (signal-let ((time (signal-timer)))
- (let* ((frame (vector-ref walk-cycle (frame-tween time))))
- (with-camera camera
- (move* (position-tween time)
- (render-sprite frame))))))
+ (signal-map (lambda (render)
+ (or render render-nothing))
+ (signal-map-maybe render time walk-cycle frame-tween)))
(with-window (make-window #:title "Animation")
(run-game-loop scene))
diff --git a/examples/common.scm b/examples/common.scm
index 915c5fa..0c54447 100644
--- a/examples/common.scm
+++ b/examples/common.scm
@@ -18,8 +18,6 @@
(use-modules (sly)
(sly fps))
-(sly-init)
-
(add-hook! key-press-hook (lambda (key)
(when (eq? key 'escape)
(stop-game-loop))))
@@ -31,4 +29,4 @@
(format #t "FPS: ~d\n" (signal-ref fps)))
60)
-(start-sly-repl)
+;; (start-sly-repl)
diff --git a/examples/font.scm b/examples/font.scm
index 64d32e0..f5b4a0d 100644
--- a/examples/font.scm
+++ b/examples/font.scm
@@ -19,6 +19,7 @@
(sly fps)
(sly signal)
(sly window)
+ (sly math rect)
(sly math vector)
(sly render)
(sly render camera)
@@ -30,36 +31,34 @@
(load "common.scm")
-(define font (load-default-font 18))
-
(define camera (2d-camera #:area (make-rect 0 0 640 480)))
-(define-signal render-message
- (move (vector2 320 240)
- (render-sprite
- (make-label font "The quick brown fox jumped over the lazy dog."
- #:anchor 'center))))
-
-(define-signal render-fps
- (signal-let ((fps fps))
- (let ((text (format #f "FPS: ~d" fps)))
- (move (vector2 0 480)
- (render-sprite (make-label font text))))))
+(define (render-messages font fps pos)
+ (render-begin
+ (move (vector2 320 240)
+ (render-sprite
+ (make-label font "The quick brown fox jumped over the lazy dog."
+ #:anchor 'center)))
+ (let ((text (format #f "FPS: ~d" fps)))
+ (move (vector2 0 480)
+ (render-sprite (make-label font text))))
+ (let ((text (format #f "Mouse: (~d, ~d)" (vx pos) (vy pos))))
+ (move (vector2 0 460)
+ (render-sprite (make-label font text))))))
-(define-signal render-mouse
- (signal-let ((pos (signal-throttle 10 mouse-position)))
- (let ((text (format #f "Mouse: (~d, ~d)" (vx pos) (vy pos))))
- (move (vector2 0 460)
- (render-sprite (make-label font text))))))
+(define-signal font (on-start (load-default-font 18)))
(define-signal scene
- (signal-let ((message render-message)
- (fps render-fps)
- (mouse render-mouse))
+ (signal-let ((fps fps)
+ (mouse-position (signal-throttle 10 mouse-position))
+ (font font))
(with-camera camera
- (render-begin message fps mouse))))
+ (if font
+ (render-messages font fps mouse-position)
+ render-nothing))))
(with-window (make-window #:title "Fonts")
+ (enable-fonts)
(run-game-loop scene))
;;; Local Variables:
diff --git a/examples/framebuffer.scm b/examples/framebuffer.scm
index 894cbc3..50c65e8 100644
--- a/examples/framebuffer.scm
+++ b/examples/framebuffer.scm
@@ -31,30 +31,36 @@
(load "common.scm")
-(define framebuffer
- (make-framebuffer 320 240))
-
(define inner-camera
(2d-camera #:area (make-rect 0 0 320 240)))
(define outer-camera
(2d-camera #:area (make-rect 0 0 640 480)))
-(define inner-sprite
- (load-sprite "images/p1_front.png"))
+(define-signal framebuffer
+ (on-start (make-framebuffer 320 240)))
+
+(define-signal outer-sprite
+ (signal-map-maybe (lambda (framebuffer)
+ (make-sprite (framebuffer-texture framebuffer)
+ #:anchor 'bottom-left))
+ framebuffer))
-(define outer-sprite
- (make-sprite (framebuffer-texture framebuffer)
- #:anchor 'bottom-left))
+(define-signal player-sprite
+ (on-start (load-sprite "images/p1_front.png")))
(define-signal scene
- (render-begin
- (with-framebuffer framebuffer
- (with-camera inner-camera
- (move (vector2 160 120)
- (render-sprite inner-sprite))))
- (with-camera outer-camera
- (scale 2 (render-sprite outer-sprite)))))
+ (signal-let ((framebuffer framebuffer)
+ (outer-sprite outer-sprite)
+ (inner-sprite player-sprite))
+ (if (and framebuffer outer-sprite inner-sprite)
+ (render-begin
+ (with-framebuffer framebuffer
+ (with-camera inner-camera
+ (move (vector2 160 120) (render-sprite inner-sprite))))
+ (with-camera outer-camera
+ (scale 2 (render-sprite outer-sprite))))
+ render-nothing)))
(with-window (make-window #:title "Simple Sprite Demo")
(run-game-loop scene))
diff --git a/examples/life.scm b/examples/life.scm
index 763e5d4..4e747ec 100644
--- a/examples/life.scm
+++ b/examples/life.scm
@@ -68,17 +68,17 @@
(define tile-size 32)
(define window-res (vector2 448 480))
-(define tileset
- (load-tileset "mines/images/tiles.png" 32 32))
+(define-signal tileset
+ (on-start (load-tileset "mines/images/tiles.png" 32 32)))
-(define alive-texture
+(define (alive-texture tileset)
(tileset-ref tileset 12))
-(define empty-texture
+(define (empty-texture tileset)
(tileset-ref tileset 13))
-(define batch
- (make-sprite-batch (expt 14 2)))
+(define-signal batch
+ (on-start (make-sprite-batch (expt 14 2))))
;;;
;;; State
@@ -296,23 +296,27 @@ If there is no neighbor on an edge, the board wraps around"
;; Model of the tile grid
(define-signal tiles-view
(signal-let ((board board)
- (board-size board-size))
- (lambda (gfx)
- (with-sprite-batch batch gfx
- (enumerate-each
- (lambda (row y)
- (enumerate-each
- (lambda (alive? x)
- (let ((rect (rect-move sprite-rect
- (tile-pos y x board-size tile-size))))
- (sprite-batch-add! batch
- gfx
- (if alive?
- alive-texture
- empty-texture)
- rect)))
- (vlist->list row)))
- (vlist->list board))))))
+ (board-size board-size)
+ (batch batch)
+ (tileset tileset))
+ (if tileset
+ (lambda (gfx)
+ (with-sprite-batch batch gfx
+ (enumerate-each
+ (lambda (row y)
+ (enumerate-each
+ (lambda (alive? x)
+ (let ((rect (rect-move sprite-rect
+ (tile-pos y x board-size tile-size))))
+ (sprite-batch-add! batch
+ gfx
+ (if alive?
+ (alive-texture tileset)
+ (empty-texture tileset))
+ rect)))
+ (vlist->list row)))
+ (vlist->list board))))
+ render-nothing)))
(define-signal camera
(signal-let ((running? simulation-running?))
diff --git a/examples/mines/mines.scm b/examples/mines/mines.scm
index 502d780..0b93473 100644
--- a/examples/mines/mines.scm
+++ b/examples/mines/mines.scm
@@ -289,17 +289,7 @@
;;; View
;;;
-(init-window)
-(enable-fonts)
-
-(define font (load-default-font))
-
-;; Minefield is 8x8, and there are 2 layers of tile graphics.
-(define batch (make-sprite-batch (* 8 8 2)))
-
-(define tileset (load-tileset "images/tiles.png" 32 32))
-
-(define tiles
+(define (make-tiles tileset)
(map (match-lambda
((key . tile-index)
(cons key (tileset-ref tileset tile-index))))
@@ -318,66 +308,92 @@
(tile-up . 13)
(tile-down . 12))))
-(define (tile-ref key)
+(define (tile-ref tiles key)
(assoc-ref tiles key))
-(define (tile-base tile)
- (tile-ref
- (if (tile-shown? tile)
- 'tile-down
- 'tile-up)))
-
-(define (tile-overlay tile)
- (and=> (cond
- ((tile-shown-mine? tile) 'exploded)
- ((tile-flagged-mine? tile) 'flag)
- ((tile-flagged-maybe? tile) 'maybe)
- ((and (tile-shown-not-mine? tile)
- (tile-neighboring-mines? tile))
- (tile-mine-count tile))
- (else #f))
- tile-ref))
+(define (tile-base tiles tile)
+ (tile-ref tiles
+ (if (tile-shown? tile)
+ 'tile-down
+ 'tile-up)))
+
+(define (tile-overlay tiles tile)
+ (let ((type (cond
+ ((tile-shown-mine? tile) 'exploded)
+ ((tile-flagged-mine? tile) 'flag)
+ ((tile-flagged-maybe? tile) 'maybe)
+ ((and (tile-shown-not-mine? tile)
+ (tile-neighboring-mines? tile))
+ (tile-mine-count tile))
+ (else #f))))
+ (tile-ref tiles type)))
(define tile-rect (make-rect 0 0 32 32))
-(define-signal board-view
- (signal-let ((board board))
- (lambda (gfx)
- (with-sprite-batch batch gfx
- (enumerate-each
- (lambda (row y)
- (enumerate-each
- (lambda (tile x)
- (let ((rect (rect-move tile-rect
- (* x tile-size)
- (* y tile-size)))
- (base-tex (tile-base tile))
- (overlay-tex (tile-overlay tile)))
- (sprite-batch-add! batch gfx base-tex rect)
- (when overlay-tex
- (sprite-batch-add! batch gfx overlay-tex rect))))
- row))
- board)))))
-
-(define (render-message message)
+(define (render-board board tiles batch)
+ (lambda (gfx)
+ (with-sprite-batch batch gfx
+ (enumerate-each
+ (lambda (row y)
+ (enumerate-each
+ (lambda (tile x)
+ (let ((rect (rect-move tile-rect
+ (* x tile-size)
+ (* y tile-size)))
+ (base-tex (tile-base tiles tile))
+ (overlay-tex (tile-overlay tiles tile)))
+ (sprite-batch-add! batch gfx base-tex rect)
+ (when overlay-tex
+ (sprite-batch-add! batch gfx overlay-tex rect))))
+ row))
+ board))))
+
+(define (render-message font message)
(move (vector2 (/ (vx resolution) 2)
(- (vy resolution) 64))
(render-sprite
(make-label font message #:anchor 'center))))
-(define-signal status-message
- (let ((game-over (render-message "GAME OVER - Press N to play again"))
- (you-win (render-message "YOU WIN! - Press N to play again")))
- (signal-let ((board board))
- (cond
- ((board-lose? board) game-over)
- ((board-win? board) you-win)
- (else render-nothing)))))
+(define (render-message-maybe message)
+ (signal-map-maybe (lambda (font)
+ (render-message font message))
+ font))
(define camera
(2d-camera #:area (make-rect (vector2 0 0) resolution)
#:clear-color tango-dark-plum))
+(define-signal font
+ (on-start (load-default-font)))
+
+;; Minefield is 8x8, and there are 2 layers of tile graphics.
+(define-signal batch
+ (on-start (make-sprite-batch (* 8 8 2))))
+
+(define-signal tileset
+ (on-start (load-tileset "images/tiles.png" 32 32)))
+
+(define-signal tiles
+ (signal-map-maybe make-tiles tileset))
+
+(define-signal board-view
+ (signal-map-maybe render-board board tiles batch))
+
+(define-signal status-message
+ (signal-let ((game-over (render-message-maybe
+ "GAME OVER - Press N to play again"))
+ (you-win (render-message-maybe
+ "YOU WIN! - Press N to play again"))
+ (board board))
+ (cond
+ ((not (or game-over you-win)) ; assets not loaded
+ render-nothing)
+ ((board-lose? board)
+ game-over)
+ ((board-win? board)
+ you-win)
+ (else render-nothing))))
+
(define-signal scene
(signal-let ((view board-view)
(status status-message)
@@ -385,17 +401,18 @@
(with-camera camera
(render-begin
status
- (move center view)))))
+ (move center (or view render-nothing))))))
;;;
;;; Initialization
;;;
-(start-sly-repl)
+;;(start-sly-repl)
(add-hook! window-close-hook stop-game-loop)
(with-window (make-window #:title "Mines" #:resolution resolution)
+ (enable-fonts)
(run-game-loop scene))
;;; Local Variables:
diff --git a/examples/shapes.scm b/examples/shapes.scm
index abaf371..1c20219 100644
--- a/examples/shapes.scm
+++ b/examples/shapes.scm
@@ -15,7 +15,8 @@
;;; along with this program. If not, see
;;; <http://www.gnu.org/licenses/>.
-(use-modules (sly game)
+(use-modules (srfi srfi-26)
+ (sly game)
(sly window)
(sly utils)
(sly signal)
@@ -31,45 +32,58 @@
(load "common.scm")
-(define crate-texture
- (load-texture "images/crate.png"))
+(define-signal crate-texture
+ (on-start (load-texture "images/crate.png")))
-(define sky-background
- (load-sprite "images/country-sky.png"))
+(define-signal sky-background
+ (on-start (load-sprite "images/country-sky.png")))
-(define forest-background
- (load-sprite "images/country-trees.png"))
+(define-signal forest-background
+ (on-start (load-sprite "images/country-trees.png")))
-(define background
+(define (make-background sky forest)
(scale 1/10
(move (vector3 0 0 -10)
(render-begin
- (render-sprite sky-background)
- (render-sprite forest-background)))))
+ (render-sprite sky)
+ (render-sprite forest)))))
-(define unit-cube
- (make-cube 1 #:texture crate-texture))
+(define-signal background
+ (signal-map-maybe make-background
+ sky-background
+ forest-background))
-(define cubes
+(define-signal unit-cube
+ (signal-map-maybe (cut make-cube 1 #:texture <>)
+ crate-texture))
+
+(define (make-cubes unit-cube)
(move (vector3 0 0 -3)
(render-begin
(move (vector3 2 0 0) unit-cube)
unit-cube
(move (vector3 -2 0 0) unit-cube))))
+(define-signal cubes
+ (signal-map-maybe make-cubes unit-cube))
+
(define camera
(3d-camera #:area (make-rect 0 0 640 480)))
(define-signal scene
(signal-let ((rotation (signal-map (lambda (x) (/ x 48))
- (signal-timer))))
- (with-camera camera
- (render-begin
- background
- ;; Spinnin' cubes!
- (with-depth-test #t
- (rotate-x (* rotation 2)
- (rotate-y rotation cubes)))))))
+ (signal-timer)))
+ (background background)
+ (cubes cubes))
+ (if (and background cubes)
+ (with-camera camera
+ (render-begin
+ background
+ ;; Spinnin' cubes!
+ (with-depth-test #t
+ (rotate-x (* rotation 2)
+ (rotate-y rotation cubes)))))
+ render-nothing)))
(with-window (make-window #:title "Shapes!")
(run-game-loop scene))
diff --git a/examples/simple.scm b/examples/simple.scm
index 0f3760b..f1882b7 100644
--- a/examples/simple.scm
+++ b/examples/simple.scm
@@ -15,27 +15,16 @@
;;; along with this program. If not, see
;;; <http://www.gnu.org/licenses/>.
-(use-modules (sly game)
- (sly window)
- (sly utils)
- (sly signal)
- (sly math rect)
- (sly math vector)
- (sly render)
- (sly render camera)
- (sly render color)
- (sly render shader)
- (sly render sprite)
- (sly render texture))
+(use-modules (sly))
(load "common.scm")
-(define sprite (load-sprite "images/p1_front.png"))
-
(define-signal scene
- (with-camera (2d-camera #:area (make-rect 0 0 640 480))
- (move (vector2 320 240)
- (render-sprite sprite))))
+ (signal-let ((sprite (on-start (load-sprite "images/p1_front.png")
+ null-sprite)))
+ (with-camera (2d-camera #:area (make-rect 0 0 640 480))
+ (move (vector2 320 240)
+ (render-sprite sprite)))))
(with-window (make-window #:title "Simple Sprite Demo")
(run-game-loop scene))
diff --git a/examples/tilemap.scm b/examples/tilemap.scm
index 2e6bdf9..430e6a0 100644
--- a/examples/tilemap.scm
+++ b/examples/tilemap.scm
@@ -47,13 +47,13 @@
;; loading. Just a hardcoded tile map that demonstrates the
;; split-texture procedure.
-(define (build-map tile-indices)
+(define (build-map tileset tile-indices)
(list->vlist*
(map (lambda (row)
(map (cut tileset-ref tileset <>) row))
tile-indices)))
-(define (random-map width height)
+(define (random-map tileset width height)
(let ((n (vector-length (tileset-tiles tileset))))
(list->vlist*
(list-tabulate
@@ -66,39 +66,45 @@
(define tile-width 32)
(define tile-height 32)
-(define tileset
- (load-tileset "images/tiles.png" tile-width tile-height))
(define map-width 20)
(define map-height 15)
(define map-tiles
- (build-map
- '((65 65 65 65 65 65 65 65 65 224 194 225 194 192 209 210 65 65 65 65)
- (65 65 65 65 65 65 65 65 208 193 225 194 176 241 177 192 210 65 65 65)
- (65 65 65 65 65 65 65 65 224 225 194 194 226 65 240 177 192 210 65 65)
- (65 65 65 65 65 65 65 65 224 225 225 176 242 65 65 240 177 226 65 65)
- (65 65 65 65 65 65 65 208 193 225 225 226 65 65 65 65 224 226 65 65)
- (65 65 65 65 65 65 208 193 194 225 225 226 65 65 65 208 193 226 65 65)
- (65 65 65 65 208 209 193 194 194 225 194 192 209 209 209 193 176 242 65 65)
- (65 65 65 65 224 194 194 194 225 176 241 241 177 225 225 194 192 209 209 209)
- (65 65 65 65 240 177 225 225 176 242 65 65 240 241 241 177 225 225 194 225)
- (65 65 65 208 209 193 225 176 242 65 65 65 65 65 65 240 241 241 241 241)
- (65 65 208 193 225 225 176 242 65 65 65 65 65 65 65 65 65 65 65 65)
- (65 208 193 225 176 241 242 65 65 65 65 65 65 65 65 65 65 65 65 65)
- (208 193 225 176 242 65 65 65 65 65 65 65 65 65 65 65 65 65 65 65)
- (193 225 225 226 65 65 65 65 65 65 65 65 65 65 65 65 65 65 65 65)
- (225 225 176 242 65 65 65 65 65 65 65 65 65 65 65 65 65 65 65 65))))
+ '((65 65 65 65 65 65 65 65 65 224 194 225 194 192 209 210 65 65 65 65)
+ (65 65 65 65 65 65 65 65 208 193 225 194 176 241 177 192 210 65 65 65)
+ (65 65 65 65 65 65 65 65 224 225 194 194 226 65 240 177 192 210 65 65)
+ (65 65 65 65 65 65 65 65 224 225 225 176 242 65 65 240 177 226 65 65)
+ (65 65 65 65 65 65 65 208 193 225 225 226 65 65 65 65 224 226 65 65)
+ (65 65 65 65 65 65 208 193 194 225 225 226 65 65 65 208 193 226 65 65)
+ (65 65 65 65 208 209 193 194 194 225 194 192 209 209 209 193 176 242 65 65)
+ (65 65 65 65 224 194 194 194 225 176 241 241 177 225 225 194 192 209 209 209)
+ (65 65 65 65 240 177 225 225 176 242 65 65 240 241 241 177 225 225 194 225)
+ (65 65 65 208 209 193 225 176 242 65 65 65 65 65 65 240 241 241 241 241)
+ (65 65 208 193 225 225 176 242 65 65 65 65 65 65 65 65 65 65 65 65)
+ (65 208 193 225 176 241 242 65 65 65 65 65 65 65 65 65 65 65 65 65)
+ (208 193 225 176 242 65 65 65 65 65 65 65 65 65 65 65 65 65 65 65)
+ (193 225 225 226 65 65 65 65 65 65 65 65 65 65 65 65 65 65 65 65)
+ (225 225 176 242 65 65 65 65 65 65 65 65 65 65 65 65 65 65 65 65)))
-(define render
+(define (render tiles)
(move (v- (vector2 320 240)
(v* (vector2 tile-width tile-height)
(vector2 10 15/2)))
- (list->renderer (compile-tile-layer map-tiles 32 32))))
+ (list->renderer
+ (compile-tile-layer (build-map tiles map-tiles) 32 32))))
(define camera (2d-camera #:area (make-rect 0 0 640 480)))
+(define-signal tileset
+ (on-start
+ (load-tileset "images/tiles.png" tile-width tile-height)))
+
(define-signal scene
- (with-camera camera render))
+ (signal-let ((tileset tileset))
+ (if tileset
+ (with-camera camera
+ (render tileset))
+ render-nothing)))
(with-window (make-window #:title "Tilemap")
(run-game-loop scene))
generated by cgit v1.2.3 (git 2.25.4) at 2024-11-22 12:29:17 +0000