summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--README.org2
-rwxr-xr-xexamples/2048/2048.scm85
-rw-r--r--examples/animation.scm4
-rw-r--r--examples/font.scm12
-rw-r--r--examples/joystick.scm4
-rw-r--r--examples/mines/mines.scm24
-rw-r--r--examples/simple.scm5
-rw-r--r--examples/tilemap.scm9
-rw-r--r--sly/render/model.scm23
9 files changed, 86 insertions, 82 deletions
diff --git a/README.org b/README.org
index c534276..6a7a0b5 100644
--- a/README.org
+++ b/README.org
@@ -37,7 +37,7 @@
(sly render sprite))
(define scene
- (move (vector2 320 240) (load-sprite "gnu.png")))
+ (model-move (vector2 320 240) (load-sprite "gnu.png")))
(define camera (orthographic-camera 640 480))
diff --git a/examples/2048/2048.scm b/examples/2048/2048.scm
index 7bffe0b..b5efd34 100755
--- a/examples/2048/2048.scm
+++ b/examples/2048/2048.scm
@@ -323,15 +323,14 @@
(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))
- (group*
- (cons (paint bg-color tile-sprite)
- (if (zero? n)
- '()
- (list (move (vector2 (/ w 2) (/ h 2))
- (group
- (paint label-color
- label))))))))))
+ (chain `(,(model-paint bg-color tile-sprite)
+ ,@(if (zero? n)
+ '()
+ (list (chain label
+ (model-paint label-color)
+ (model-move (vector2 (/ w 2) (/ h 2)))))))
+ (list->model)
+ (model-move (vector2 (* x w) (* y h))))))
(define window-width 640)
(define window-height 480)
@@ -347,7 +346,7 @@
(define-signal tiles
(signal-map (lambda (board)
- (group*
+ (list->model
(append-map
(match-lambda
((y (row ...))
@@ -361,25 +360,26 @@
(define play-again-font (load-default-font 16))
(define-signal status-message
- (let ((play-again (paint black (label play-again-font
- "Press N to play again"
- #:anchor 'top-center)))
- (game-over (paint black (label font "GAME OVER"
- #:anchor 'bottom-center)))
- (you-win (paint black (label font "YOU WIN!"
- #:anchor 'bottom-center))))
+ (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))))
(signal-map
- (lambda (board)
- (let ((message (cond
- ((board-lose? board) game-over)
- ((board-win? board) you-win)
- (else #f))))
- (move (vector2 (/ board-width 2)
- (/ board-height 2))
- (group* (if message
- (list message play-again)
- '())))))
- board)))
+ (lambda (board)
+ (let ((message (cond
+ ((board-lose? board) game-over)
+ ((board-win? board) you-win)
+ (else #f))))
+ (chain (if message
+ (list message play-again)
+ '())
+ (list->model)
+ (model-move (vector2 (/ board-width 2)
+ (/ board-height 2))))))
+ board)))
(define instruction-font (load-default-font 16))
@@ -387,11 +387,11 @@
"Use the arrow keys to join the numbers and get to the 2048 tile!")
(define-signal instructions
- (move (vector2 (/ board-width 2) (- window-height (vy center-pos)))
- (group
- (paint text-color-1
- (label instruction-font instruction-text
- #:anchor 'top-center)))))
+ (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))))))
(define score-header-font (load-default-font 14))
(define score-font (load-default-font 22))
@@ -408,13 +408,12 @@
(signal-map (lambda (score timer)
(let ((score (label score-font (number->string score)
#:anchor 'center)))
- (move (vector2 x (- window-height 28))
- (group
- (paint text-color-1 header)
- (move (position-tween timer)
- (group
- (paint (color-tween timer)
- score)))))))
+ (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)))))))
score
(signal-drop (lambda (t) (> t duration))
0 (signal-since 1 score)))))
@@ -427,9 +426,9 @@
(- board-width (/ board-width 4))))
(define-signal 2048-scene
- (signal-map (cut move center-pos <>)
- (signal-map group instructions tiles score
- best-score status-message)))
+ (signal-map (cut model-move center-pos <>)
+ (signal-map model-group
+ instructions tiles score best-score status-message)))
(define camera
(orthographic-camera window-width window-height
diff --git a/examples/animation.scm b/examples/animation.scm
index ef736d2..c64d581 100644
--- a/examples/animation.scm
+++ b/examples/animation.scm
@@ -47,8 +47,8 @@
(define-signal scene
(signal-map (lambda (time)
- (move (position-tween time)
- (vector-ref walk-cycle (frame-tween time))))
+ (model-move (position-tween time)
+ (vector-ref walk-cycle (frame-tween time))))
(signal-timer)))
(define camera (orthographic-camera 640 480))
diff --git a/examples/font.scm b/examples/font.scm
index b3fcfc3..33c4940 100644
--- a/examples/font.scm
+++ b/examples/font.scm
@@ -34,24 +34,24 @@
(define font (load-default-font 18))
(define-signal message-label
- (move (vector2 320 240)
- (label font "The quick brown fox jumped over the lazy dog."
- #:anchor 'center)))
+ (model-move (vector2 320 240)
+ (label font "The quick brown fox jumped over the lazy dog."
+ #:anchor 'center)))
(define-signal fps-label
(signal-map (lambda (fps)
(let ((text (format #f "FPS: ~d" fps)))
- (move (vector2 0 480) (label font text))))
+ (model-move (vector2 0 480) (label font text))))
fps))
(define-signal mouse-label
(signal-map (lambda (p)
(let ((text (format #f "Mouse: (~d, ~d)" (vx p) (vy p))))
- (move (vector2 0 460) (label font text))))
+ (model-move (vector2 0 460) (label font text))))
(signal-throttle 5 mouse-position)))
(define-signal scene
- (signal-map group message-label fps-label mouse-label))
+ (signal-map model-group message-label fps-label mouse-label))
(define camera (orthographic-camera 640 480))
diff --git a/examples/joystick.scm b/examples/joystick.scm
index 7aa83c7..ae090da 100644
--- a/examples/joystick.scm
+++ b/examples/joystick.scm
@@ -55,7 +55,7 @@
(define-signal caption
(signal-map (lambda (text)
- (move (vector2 -76 -90) (label font text)))
+ (model-move (vector2 -76 -90) (label font text)))
(signal-merge
(make-signal "Press a button")
(button-caption-signal "Hello there" 0)
@@ -65,7 +65,7 @@
(define-signal scene
(signal-map (lambda (position caption)
- (move position (group player caption)))
+ (model-move position (model-group player caption)))
player-position caption))
(define camera (orthographic-camera (vx resolution) (vy resolution)))
diff --git a/examples/mines/mines.scm b/examples/mines/mines.scm
index e10fba5..126db24 100644
--- a/examples/mines/mines.scm
+++ b/examples/mines/mines.scm
@@ -350,24 +350,25 @@
(lambda (tile)
;; A tile may or may not have an overlay, so we do a little
;; quasiquoting magic to build the right list.
- (group*
+ (list->model
`(,(tile-base-sprite tile)
,@(let ((overlay (tile-overlay-sprite tile)))
(if overlay
- (list (place offset (group overlay)))
+ (list (model-place offset overlay))
'())))))))
(define-signal board-view
(signal-map (lambda (board)
(define (draw-column tile x)
- (move (vector2 (* x tile-size) 0)
- (draw-tile tile)))
+ (model-move (vector2 (* x tile-size) 0)
+ (draw-tile tile)))
(define (draw-row row y)
- (move (vector2 0 (* y tile-size))
- (group* (enumerate-map draw-column row))))
+ (chain (enumerate-map draw-column row)
+ (list->model)
+ (model-move (vector2 0 (* y tile-size)))))
- (group* (enumerate-map draw-row board)))
+ (list->model (enumerate-map draw-row board)))
board))
(define-signal status-message
@@ -375,9 +376,9 @@
(define (make-message message)
(label font message #:anchor 'center))
- (move
+ (model-move
(vector2 (/ (vx resolution) 2) (- (vy resolution) 64))
- (group*
+ (list->model
(cond
((board-lose? board)
(list (make-message "GAME OVER - Press N to play again")))
@@ -388,9 +389,8 @@
(define-signal scene
(signal-map (lambda (board-view status center-position)
- (group
- status
- (move center-position board-view)))
+ (model-group status
+ (model-move center-position board-view)))
board-view status-message center-position))
(define camera
diff --git a/examples/simple.scm b/examples/simple.scm
index 1596cfe..820a3ce 100644
--- a/examples/simple.scm
+++ b/examples/simple.scm
@@ -27,9 +27,8 @@
(load "common.scm")
(define scene
- (chain (load-sprite "images/p1_front.png")
- (paint red)
- (move (vector2 320 240))))
+ (model-move (vector2 320 240)
+ (load-sprite "images/p1_front.png")))
(define camera (orthographic-camera 640 480))
diff --git a/examples/tilemap.scm b/examples/tilemap.scm
index 5e54bde..bb4d9ef 100644
--- a/examples/tilemap.scm
+++ b/examples/tilemap.scm
@@ -90,10 +90,11 @@
(225 225 176 242 65 65 65 65 65 65 65 65 65 65 65 65 65 65 65 65))))
(define scene
- (move (v- (vector2 320 240)
- (v* (vector2 tile-width tile-height)
- (vector2 10 15/2)))
- (group* (compile-tile-layer map-tiles 32 32))))
+ (chain (compile-tile-layer map-tiles 32 32)
+ (list->model)
+ (model-move (v- (vector2 320 240)
+ (v* (vector2 tile-width tile-height)
+ (vector2 10 15/2))))))
(define camera
(orthographic-camera 640 480))
diff --git a/sly/render/model.scm b/sly/render/model.scm
index fdda5ed..2686d8c 100644
--- a/sly/render/model.scm
+++ b/sly/render/model.scm
@@ -43,7 +43,12 @@
model-mesh model-transform model-texture model-shader model-color
model-blend-mode model-depth-test? model-children
draw-model
- paint blend group group* move place))
+ model-paint
+ model-blend
+ model-group
+ list->model
+ model-move
+ model-place))
;; Representation of a single OpenGL render call.
(define-record-type <model>
@@ -160,29 +165,29 @@ CONTEXT."
;;; Utility Procedures
;;;
-(define (paint color model)
+(define (model-paint color model)
"Create a copy of MODEL, but with a new COLOR."
(model-inherit model #:color color))
-(define (blend blend-mode model)
+(define (model-blend blend-mode model)
"Create a copy of MODEL, but with a new BLEND-MODE."
(model-inherit model #:blend-mode blend-mode))
-(define (group . children)
- "Create a new group containing the list of CHILDREN."
+(define (model-group . children)
+ "Create a new compound model containing the list of CHILDREN."
(make-model #:children children))
-(define (group* children)
- "Create a new group containing the list of CHILDREN."
+(define (list->model children)
+ "Create a new compound model containing the list of CHILDREN."
(make-model #:children children))
-(define (move position model)
+(define (model-move position model)
"Create a new group in which the list of CHILDREN are translated by
the vector POSITION."
(model-inherit model #:transform (transform* (model-transform model)
(translate position))))
-(define (place transform model)
+(define (model-place transform model)
"Create a new group in which the tranformation matrices of the
CHILDREN are multiplied by TRANSFORM."
(model-inherit model #:transform (transform* (model-transform model)