diff options
| -rw-r--r-- | README.org | 2 | ||||
| -rwxr-xr-x | examples/2048/2048.scm | 85 | ||||
| -rw-r--r-- | examples/animation.scm | 4 | ||||
| -rw-r--r-- | examples/font.scm | 12 | ||||
| -rw-r--r-- | examples/joystick.scm | 4 | ||||
| -rw-r--r-- | examples/mines/mines.scm | 24 | ||||
| -rw-r--r-- | examples/simple.scm | 5 | ||||
| -rw-r--r-- | examples/tilemap.scm | 9 | ||||
| -rw-r--r-- | sly/render/model.scm | 23 |
9 files changed, 86 insertions, 82 deletions
@@ -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) |