diff options
author | David Thompson <dthompson2@worcester.edu> | 2016-02-10 22:00:02 -0500 |
---|---|---|
committer | David Thompson <dthompson2@worcester.edu> | 2016-02-10 22:01:38 -0500 |
commit | 4b1370fc286db564e32a8e2e890061bc3ed413ac (patch) | |
tree | 35030b58d5634b54018106bfb80a7af89054fdf1 | |
parent | 5571463e79247d6cb338a015e5bbf94d4bafde44 (diff) |
examples: Update everything to use deferred GL resource loading.
-rwxr-xr-x | examples/2048/2048.scm | 245 | ||||
-rw-r--r-- | examples/animation.scm | 61 | ||||
-rw-r--r-- | examples/common.scm | 4 | ||||
-rw-r--r-- | examples/font.scm | 43 | ||||
-rw-r--r-- | examples/framebuffer.scm | 36 | ||||
-rw-r--r-- | examples/life.scm | 50 | ||||
-rw-r--r-- | examples/mines/mines.scm | 133 | ||||
-rw-r--r-- | examples/shapes.scm | 56 | ||||
-rw-r--r-- | examples/simple.scm | 23 | ||||
-rw-r--r-- | examples/tilemap.scm | 52 |
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)) |