summaryrefslogtreecommitdiff
path: root/examples
diff options
context:
space:
mode:
authorDavid Thompson <dthompson2@worcester.edu>2015-09-21 19:44:10 -0400
committerDavid Thompson <dthompson2@worcester.edu>2015-09-21 19:48:44 -0400
commit46544b7dba0081f22e686f70c606a338c7fa52dd (patch)
tree9688f43493606f7b0e4da8784a7804cc32f128eb /examples
parentb7bf25020f146331d161d86ef30df31d2959a8dc (diff)
render: Reimplement rendering engine using functional combinators.
Warning: This is a huge commit. I completely gutted the old scene graph and replaced it with a somewhat monadic rendering combinator module instead. The interface remains purely functional, but replaces the <model> data type with procedures in the rendering monad instead. This opens the door for rendering *anything*, not just meshes. Now I can implement particle systems and other non-static things.
Diffstat (limited to 'examples')
-rwxr-xr-xexamples/2048/2048.scm140
-rw-r--r--examples/animation.scm23
-rw-r--r--examples/font.scm39
-rw-r--r--examples/joystick.scm34
-rw-r--r--examples/life.scm53
-rw-r--r--examples/mines/mines.scm86
-rw-r--r--examples/simple.scm21
-rw-r--r--examples/tilemap.scm19
8 files changed, 222 insertions, 193 deletions
diff --git a/examples/2048/2048.scm b/examples/2048/2048.scm
index 97922de..05eb78b 100755
--- a/examples/2048/2048.scm
+++ b/examples/2048/2048.scm
@@ -33,11 +33,10 @@
(sly math transform)
(sly math tween)
(sly math vector)
+ (sly render)
(sly render camera)
(sly render color)
(sly render font)
- (sly render model)
- (sly render scene)
(sly render sprite)
(sly render texture)
(sly input keyboard)
@@ -310,26 +309,29 @@
(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-sprite
+ (make-sprite tile-texture #:anchor (vector2 0 0)))
(define tile-label-cache
(map (lambda (n)
- (cons n (label font (number->string n) #:anchor 'center)))
+ (cons n (make-label font (number->string n) #:anchor 'center)))
'(2 4 8 16 32 64 128 256 512 1024 2048)))
-(define (make-tile x y n)
- (let* ((w (texture-width tile-texture))
- (h (texture-height tile-texture))
- (label (assoc-ref tile-label-cache n))
- (label-color (tile-text-color n))
- (bg-color (tile-bg-color n))
- (tile (model-group (model-paint bg-color tile-sprite)
- (if (zero? n)
- null-model
- (chain label
- (model-paint label-color)
- (model-move (vector2 (/ w 2) (/ h 2))))))))
- (model-move (vector2 (* x w) (* y h)) tile)))
+(define (render-tile x y n)
+ (let ((w (texture-width tile-texture))
+ (h (texture-height tile-texture))
+ (label (assoc-ref tile-label-cache n))
+ (label-color (tile-text-color n))
+ (bg-color (tile-bg-color n)))
+ (move (vector2 (* x w) (* y h))
+ (render-begin
+ (with-color bg-color
+ (render-sprite tile-sprite))
+ (if (zero? n)
+ render-nothing
+ (with-color label-color
+ (move (vector2 (/ w 2) (/ h 2))
+ (render-sprite label))))))))
(define window-width 640)
(define window-height 480)
@@ -343,29 +345,33 @@
(define (enumerate-board board)
(enumerate (map (cut enumerate <>) board)))
+(define (render-board board)
+ (list->renderer
+ (append-map
+ (match-lambda
+ ((y (row ...))
+ (map (match-lambda
+ ((x n)
+ (render-tile x y n)))
+ row)))
+ (enumerate-board board))))
+
(define-signal tiles
- (signal-map (lambda (board)
- (list->model
- (append-map
- (match-lambda
- ((y (row ...))
- (map (match-lambda
- ((x n)
- (make-tile x y n)))
- row)))
- (enumerate-board board))))
- board))
+ (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 (model-paint black (label play-again-font
- "Press N to play again"
- #:anchor 'top-center)))
- (game-over (model-paint black (label font "GAME OVER"
- #:anchor 'bottom-center)))
- (you-win (model-paint black (label font "YOU WIN!"
- #:anchor 'bottom-center))))
+ (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
@@ -373,10 +379,10 @@
((board-win? board) you-win)
(else #f))))
(if message
- (model-move (vector2 (/ board-width 2)
- (/ board-height 2))
- (model-group message play-again))
- null-model)))
+ (move (vector2 (/ board-width 2)
+ (/ board-height 2))
+ (render-begin message play-again))
+ render-nothing)))
board)))
(define instruction-font (load-default-font 16))
@@ -385,11 +391,12 @@
"Use the arrow keys to join the numbers and get to the 2048 tile!")
(define-signal instructions
- (chain (label instruction-font instruction-text
- #:anchor 'top-center)
- (model-paint text-color-1)
- (model-move (vector2 (/ board-width 2)
- (- window-height (vy center-pos))))))
+ (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))
@@ -401,18 +408,19 @@
(tween vlerp ease-linear from to duration)))
(color-tween (tween color-lerp ease-linear
transparent text-color-1 duration))
- (header (label score-header-font text #:anchor 'top-center)))
+ (header (make-label score-header-font text #:anchor 'top-center)))
(signal-let* ((score (signal-drop-repeats score))
(timer (signal-drop (lambda (t) (> t duration))
0 (signal-since 1 score))))
- (let ((score (label score-font (number->string score)
- #:anchor 'center)))
- (model-move (vector2 x (- window-height 28))
- (model-group
- (model-paint text-color-1 header)
- (chain score
- (model-paint (color-tween timer))
- (model-move (position-tween timer)))))))))
+ (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)))))))))
(define-signal score
(score-label "SCORE" (signal-map 2048-score 2048-state) (/ board-width 4)))
@@ -421,20 +429,26 @@
(score-label "BEST" (signal-map 2048-best-score 2048-state)
(- board-width (/ board-width 4))))
-(define-signal 2048-model
- (signal-map (cut model-move center-pos <>)
- (signal-map model-group
- instructions tiles score best-score status-message)))
+(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 camera
- (let ((viewport (make-viewport (make-rect 0 0 640 480)
- #:clear-color background)))
- (orthographic-camera window-width window-height
- #:viewport viewport)))
+ (2d-camera #:area (make-rect 0 0 640 480) #:clear-color background))
(define-signal 2048-scene
- (signal-let ((model 2048-model))
- (make-scene camera model)))
+ (signal-let ((view 2048-view))
+ (with-camera camera view)))
;;;
;;; Initialization
diff --git a/examples/animation.scm b/examples/animation.scm
index 5dc9166..8aaff2e 100644
--- a/examples/animation.scm
+++ b/examples/animation.scm
@@ -15,25 +15,29 @@
;;; along with this program. If not, see
;;; <http://www.gnu.org/licenses/>.
-(use-modules (sly game)
+(use-modules (sly utils)
+ (sly game)
(sly window)
(sly signal)
(sly math)
+ (sly math rect)
(sly math tween)
(sly math vector)
+ (sly render)
(sly render camera)
- (sly render model)
(sly render sprite)
- (sly render tileset)
- (sly render scene))
+ (sly render tileset))
(load "common.scm")
+(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)))
+ (sprite* (tileset-ref tiles id)))
'(19 20 21 22 23 24 25 26)))))
(define position-tween
@@ -46,13 +50,14 @@
(tween (compose floor lerp) (compose ease-linear ease-loop)
0 frame-count (* frame-count frame-rate))))
-(define camera (orthographic-camera 640 480))
+(define camera (2d-camera #:area (make-rect 0 0 640 480)))
(define-signal scene
(signal-let ((time (signal-timer)))
- (let* ((frame (vector-ref walk-cycle (frame-tween time)))
- (model (model-move (position-tween time) frame)))
- (make-scene camera model))))
+ (let* ((frame (vector-ref walk-cycle (frame-tween time))))
+ (with-camera camera
+ (move* (position-tween time)
+ (render-sprite frame))))))
(with-window (make-window #:title "Animation")
(run-game-loop scene))
diff --git a/examples/font.scm b/examples/font.scm
index 4d481d3..64d32e0 100644
--- a/examples/font.scm
+++ b/examples/font.scm
@@ -20,39 +20,44 @@
(sly signal)
(sly window)
(sly math vector)
+ (sly render)
(sly render camera)
(sly render color)
(sly render font)
- (sly render model)
- (sly render scene)
+ (sly render sprite)
+ (sly render texture)
(sly input mouse))
(load "common.scm")
(define font (load-default-font 18))
-(define-signal message-label
- (model-move (vector2 320 240)
- (label font "The quick brown fox jumped over the lazy dog."
- #:anchor 'center)))
+(define camera (2d-camera #:area (make-rect 0 0 640 480)))
-(define-signal fps-label
+(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)))
- (model-move (vector2 0 480) (label font text)))))
+ (move (vector2 0 480)
+ (render-sprite (make-label font text))))))
-(define-signal mouse-label
- (signal-let ((pos (signal-throttle 5 mouse-position)))
+(define-signal render-mouse
+ (signal-let ((pos (signal-throttle 10 mouse-position)))
(let ((text (format #f "Mouse: (~d, ~d)" (vx pos) (vy pos))))
- (model-move (vector2 0 460) (label font text)))))
-
-(define-signal model
- (signal-map model-group message-label fps-label mouse-label))
-
-(define camera (orthographic-camera 640 480))
+ (move (vector2 0 460)
+ (render-sprite (make-label font text))))))
(define-signal scene
- (signal-map (lambda (model) (make-scene camera model)) model))
+ (signal-let ((message render-message)
+ (fps render-fps)
+ (mouse render-mouse))
+ (with-camera camera
+ (render-begin message fps mouse))))
(with-window (make-window #:title "Fonts")
(run-game-loop scene))
diff --git a/examples/joystick.scm b/examples/joystick.scm
index a191de5..661b18e 100644
--- a/examples/joystick.scm
+++ b/examples/joystick.scm
@@ -1,5 +1,6 @@
;;; Sly
;;; Copyright (C) 2014 Jordan Russell <jordan.likes.curry@gmail.com>
+;;; Copyright (C) 2015 David Thompson <davet@gnu.org>
;;;
;;; This program is free software: you can redistribute it and/or
;;; modify it under the terms of the GNU General Public License as
@@ -17,21 +18,21 @@
;;; Commentary:
;;
-;; Joystick example code
+;; Joystick example code.
;;
;;; Code:
(use-modules (sly game)
(sly signal)
(sly window)
+ (sly math rect)
(sly math vector)
(sly input joystick)
+ (sly render)
(sly render camera)
- (sly render model)
(sly render sprite)
(sly render texture)
- (sly render font)
- (sly render scene))
+ (sly render font))
(load "common.scm")
@@ -42,7 +43,10 @@
(define resolution (vector2 640 480))
-(define player (load-sprite "images/p1_front.png"))
+(define player-texture
+ (load-texture "images/p1_front.png"))
+
+(define player (make-sprite player-texture))
(define-signal player-position
(signal-fold v+ (vector2 320 240)
@@ -56,7 +60,8 @@
(define-signal caption
(signal-map (lambda (text)
- (model-move (vector2 -76 -90) (label font text)))
+ (move (vector2 -76 -90)
+ (render-sprite (make-label font text))))
(signal-merge
(make-signal "Press a button")
(button-caption-signal "Hello there" 0)
@@ -64,15 +69,20 @@
(button-caption-signal "This is the other caption" 2)
(button-caption-signal "This is the other other caption" 3))))
-(define-signal model
- (signal-map (lambda (position caption)
- (model-move position (model-group player caption)))
- player-position caption))
+(define-signal view
+ (signal-let ((position player-position)
+ (caption caption))
+ (move position
+ (render-begin
+ (render-sprite player)
+ caption))))
-(define camera (orthographic-camera (vx resolution) (vy resolution)))
+(define camera
+ (2d-camera #:area (make-rect (vector2 0 0) resolution)))
(define-signal scene
- (signal-map (lambda (model) (make-scene camera model)) model))
+ (signal-let ((view view))
+ (with-camera camera view)))
(add-hook! joystick-axis-hook
(lambda (which axis value)
diff --git a/examples/life.scm b/examples/life.scm
index 2842690..2d4e30a 100644
--- a/examples/life.scm
+++ b/examples/life.scm
@@ -1,6 +1,6 @@
;;; Life, Sly edition
;;; Copyright (C) 2015 Christopher Allan Webber <cwebber@dustycloud.org>
-;;; Copyright (C) 2014 David Thompson <davet@gnu.org>
+;;; Copyright (C) 2014, 2015 David Thompson <davet@gnu.org>
;;;
;;; This program is free software: you can redistribute it and/or
;;; modify it under the terms of the GNU General Public License as
@@ -30,11 +30,10 @@
(sly math rect)
(sly math transform)
(sly math vector)
+ (sly render)
(sly render camera)
- (sly render model)
(sly render sprite)
(sly render color)
- (sly render scene)
(sly input mouse))
;;;
@@ -68,15 +67,17 @@
(define tile-size 32)
(define window-res (vector2 448 480))
+(define alive-texture
+ (load-texture "mines/images/tile-down.png"))
+
+(define empty-texture
+ (load-texture "mines/images/tile-up.png"))
+
(define sprite-cell-alive
- (load-sprite
- "mines/images/tile-down.png"
- #:anchor 'bottom-left))
+ (make-sprite alive-texture #:anchor 'bottom-left))
(define sprite-cell-empty
- (load-sprite
- "mines/images/tile-up.png"
- #:anchor 'bottom-left))
+ (make-sprite empty-texture #:anchor 'bottom-left))
;;;
;;; State
@@ -106,10 +107,7 @@
;; Give a heartbeat indicating it's time to run an evolution on the board
;; (if the simulation is running)
(define-signal time-to-evolve
- (signal-map
- (lambda _
- 'evolve)
- (signal-every 20)))
+ (signal-constant 'evolve (signal-every 20)))
(define (tile-on-board? x y board-size)
"Is the tile on the board?"
@@ -295,17 +293,18 @@ If there is no neighbor on an edge, the board wraps around"
(define-signal tiles-view
(signal-let ((board board)
(board-size board-size))
- (list->model
+ (list->renderer
(enumerate-map
(lambda (row row-count)
- (list->model
+ (list->renderer
(enumerate-map
(lambda (tile-alive col-count)
- (model-move (tile-pos row-count col-count
- board-size tile-size)
- (if tile-alive
- sprite-cell-alive
- sprite-cell-empty)))
+ (move (tile-pos row-count col-count
+ board-size tile-size)
+ (render-sprite
+ (if tile-alive
+ sprite-cell-alive
+ sprite-cell-empty))))
(vlist->list row))))
;; FIXME:
;; This slows things down more than it should have to
@@ -314,17 +313,13 @@ If there is no neighbor on an edge, the board wraps around"
(define-signal camera
(signal-let ((running? simulation-running?))
- (orthographic-camera
- (vx window-res) (vy window-res)
- #:viewport (make-viewport (make-rect (vector2 0 0) window-res)
- #:clear-color (if running?
- tango-dark-chameleon
- tango-dark-scarlet-red)))))
+ (2d-camera #:area (make-rect (vector2 0 0) window-res)
+ #:clear-color (if running?
+ tango-dark-chameleon
+ tango-dark-scarlet-red))))
(define-signal scene
- (signal-let ((model tiles-view)
- (camera camera))
- (make-scene camera model)))
+ (signal-map with-camera camera tiles-view))
;;;
;;; Initialization
diff --git a/examples/mines/mines.scm b/examples/mines/mines.scm
index 3a9ee7d..0b55d8b 100644
--- a/examples/mines/mines.scm
+++ b/examples/mines/mines.scm
@@ -34,12 +34,12 @@
(sly math rect)
(sly math transform)
(sly math vector)
+ (sly render)
(sly render camera)
(sly render color)
(sly render font)
- (sly render model)
(sly render sprite)
- (sly render scene)
+ (sly render texture)
(sly input keyboard)
(sly input mouse))
@@ -296,9 +296,11 @@
(define sprites
(map (match-lambda
((key . config)
- (cons key (load-sprite
- (string-append "images/" (assoc-ref config 'name) ".png")
- #:anchor (assoc-ref config 'anchor)))))
+ (let ((sprite (load-sprite (string-append "images/"
+ (assoc-ref config 'name)
+ ".png")
+ #:anchor (assoc-ref config 'anchor))))
+ (cons key sprite))))
'((1 . ((name . "1-mine")
(anchor . center)))
(2 . ((name . "2-mines")
@@ -348,57 +350,55 @@
(else #f))
sprite-ref))
-(define draw-tile
- (let ((offset (translate (vector2 (/ tile-size 2) (/ tile-size 2)))))
+(define render-tile
+ (let ((offset (vector2 (/ tile-size 2) (/ tile-size 2))))
(lambda (tile)
- (model-group (tile-base-sprite tile)
- (let ((overlay (tile-overlay-sprite tile)))
- (if overlay
- (model-place offset overlay)
- null-model))))))
+ (render-begin
+ (render-sprite (tile-base-sprite tile))
+ (let ((overlay (tile-overlay-sprite tile)))
+ (if overlay
+ (move offset (render-sprite overlay))
+ render-nothing))))))
(define-signal board-view
(signal-let ((board board))
- (define (draw-column tile x)
- (model-move (vector2 (* x tile-size) 0)
- (draw-tile tile)))
+ (define (render-column tile x)
+ (move (vector2 (* x tile-size) 0)
+ (render-tile tile)))
- (define (draw-row row y)
- (chain (enumerate-map draw-column row)
- (list->model)
- (model-move (vector2 0 (* y tile-size)))))
+ (define (render-row row y)
+ (move (vector2 0 (* y tile-size))
+ (list->renderer (enumerate-map render-column row))))
- (list->model (enumerate-map draw-row board))))
+ (list->renderer (enumerate-map render-row board))))
-(define-signal status-message
- (signal-let ((board board))
- (define (make-message message)
- (label font message #:anchor 'center))
+(define (render-message message)
+ (move (vector2 (/ (vx resolution) 2)
+ (- (vy resolution) 64))
+ (render-sprite
+ (make-label font message #:anchor 'center))))
- (model-move
- (vector2 (/ (vx resolution) 2) (- (vy resolution) 64))
- (list->model
+(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)
- (list (make-message "GAME OVER - Press N to play again")))
- ((board-win? board)
- (list (make-message "YOU WIN! - Press N to play again")))
- (else '()))))))
-
-(define-signal model
- (signal-let ((view board-view)
- (status status-message)
- (center center-position))
- (model-group status (model-move center view))))
+ ((board-lose? board) game-over)
+ ((board-win? board) you-win)
+ (else render-nothing)))))
(define camera
- (orthographic-camera
- (vx resolution) (vy resolution)
- #:viewport (make-viewport (make-rect (vector2 0 0) resolution)
- #:clear-color tango-dark-plum)))
+ (2d-camera #:area (make-rect (vector2 0 0) resolution)
+ #:clear-color tango-dark-plum))
(define-signal scene
- (signal-map (lambda (model) (make-scene camera model)) model))
+ (signal-let ((view board-view)
+ (status status-message)
+ (center center-position))
+ (with-camera camera
+ (render-begin
+ status
+ (move center view)))))
;;;
;;; Initialization
diff --git a/examples/simple.scm b/examples/simple.scm
index e4de293..0f3760b 100644
--- a/examples/simple.scm
+++ b/examples/simple.scm
@@ -1,5 +1,5 @@
;;; Sly
-;;; Copyright (C) 2013, 2014 David Thompson <dthompson2@worcester.edu>
+;;; Copyright (C) 2013, 2014, 2015 David Thompson <dthompson2@worcester.edu>
;;;
;;; This program is free software: you can redistribute it and/or
;;; modify it under the terms of the GNU General Public License as
@@ -19,22 +19,23 @@
(sly window)
(sly utils)
(sly signal)
+ (sly math rect)
(sly math vector)
+ (sly render)
(sly render camera)
- (sly render model)
- (sly render sprite)
(sly render color)
- (sly render scene))
+ (sly render shader)
+ (sly render sprite)
+ (sly render texture))
(load "common.scm")
-(define model
- (model-move (vector2 320 240)
- (load-sprite "images/p1_front.png")))
-
-(define camera (orthographic-camera 640 480))
+(define sprite (load-sprite "images/p1_front.png"))
-(define-signal scene (make-scene camera model))
+(define-signal scene
+ (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 7c32b11..2e6bdf9 100644
--- a/examples/tilemap.scm
+++ b/examples/tilemap.scm
@@ -24,16 +24,15 @@
(sly window)
(sly signal)
(sly utils)
+ (sly render)
(sly render camera)
(sly render color)
- (sly render model)
(sly render mesh)
(sly render shader)
(sly render sprite)
(sly render texture)
(sly render tileset)
(sly render tile-map)
- (sly render scene)
(sly math vector)
(sly math tween)
(sly input keyboard))
@@ -90,16 +89,16 @@
(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 model
- (model-move (v- (vector2 320 240)
- (v* (vector2 tile-width tile-height)
- (vector2 10 15/2)))
- (list->model (compile-tile-layer map-tiles 32 32))))
+(define render
+ (move (v- (vector2 320 240)
+ (v* (vector2 tile-width tile-height)
+ (vector2 10 15/2)))
+ (list->renderer (compile-tile-layer map-tiles 32 32))))
-(define camera
- (orthographic-camera 640 480))
+(define camera (2d-camera #:area (make-rect 0 0 640 480)))
-(define-signal scene (make-scene camera model))
+(define-signal scene
+ (with-camera camera render))
(with-window (make-window #:title "Tilemap")
(run-game-loop scene))