summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rwxr-xr-xexamples/2048/204866
-rw-r--r--examples/animation.scm65
-rw-r--r--examples/common.scm1
-rw-r--r--examples/simple.scm31
4 files changed, 90 insertions, 73 deletions
diff --git a/examples/2048/2048 b/examples/2048/2048
index ddf46df..8d0c134 100755
--- a/examples/2048/2048
+++ b/examples/2048/2048
@@ -327,12 +327,14 @@
(label (assoc-ref tile-label-cache n))
(label-color (tile-text-color n))
(bg-color (tile-bg-color n)))
- (apply group-move (vector2 (* x w) (* y h))
- (model-paint bg-color tile-sprite)
- (if (zero? n)
- '()
- (list (group-move (vector2 (/ w 2) (/ h 2))
- (model-paint label-color label)))))))
+ (group-move (vector2 (* x w) (* y h))
+ (make-group
+ (cons (model-paint bg-color tile-sprite)
+ (if (zero? n)
+ '()
+ (list (group-move (vector2 (/ w 2) (/ h 2))
+ (group (model-paint label-color
+ label))))))))))
(define window-width 640)
(define window-height 480)
@@ -362,22 +364,25 @@
(define play-again-font (load-default-font 16))
(define-signal status-message
- (signal-map
- (lambda (board)
- (let ((message (cond
- ((board-lose? board) "GAME OVER")
- ((board-win? board) "YOU WIN!")
- (else #f))))
- (apply group-move (vector2 (/ board-width 2)
- (/ board-height 2))
- (if message
- (list (model-paint black (label font message
- #:anchor 'bottom-center))
- (model-paint black (label play-again-font
- "Press N to play again"
- #:anchor 'top-center)))
- '()))))
- board))
+ (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))))
+ (group-move (vector2 (/ board-width 2)
+ (/ board-height 2))
+ (make-group (if message
+ (list message play-again)
+ '())))))
+ board)))
(define instruction-font (load-default-font 16))
@@ -386,9 +391,10 @@
(define-signal instructions
(group-move (vector2 (/ board-width 2) (- window-height (vy center-pos)))
- (model-paint text-color-1
- (label instruction-font instruction-text
- #:anchor 'top-center))))
+ (group
+ (model-paint text-color-1
+ (label instruction-font instruction-text
+ #:anchor 'top-center)))))
(define score-header-font (load-default-font 14))
(define score-font (load-default-font 22))
@@ -406,10 +412,12 @@
(let ((score (label score-font (number->string score)
#:anchor 'center)))
(group-move (vector2 x (- window-height 28))
- (model-paint text-color-1 header)
- (group-move (position-tween timer)
- (model-paint (color-tween timer)
- score)))))
+ (group
+ (model-paint text-color-1 header)
+ (group-move (position-tween timer)
+ (group
+ (model-paint (color-tween timer)
+ score)))))))
score
(signal-drop (lambda (t) (> t duration))
0 (signal-since 1 score)))))
diff --git a/examples/animation.scm b/examples/animation.scm
index b38b1a8..cc84c27 100644
--- a/examples/animation.scm
+++ b/examples/animation.scm
@@ -15,33 +15,52 @@
;;; along with this program. If not, see
;;; <http://www.gnu.org/licenses/>.
-(use-modules (sly animation)
- (sly game)
+(use-modules (sly game)
+ (sly window)
+ (sly signal)
+ (sly math)
+ (sly math tween)
+ (sly math vector)
+ (sly render camera)
+ (sly render group)
(sly render sprite)
- (sly render tileset)
- (sly vector)
- (sly window))
+ (sly render tileset))
(load "common.scm")
-(define (make-demo-animation)
- "Load a texture, split it into 64x64 tiles, and build an animated
-sprite out of it."
- (let* ((tiles (load-tileset "images/princess.png" 64 64))
- (frames (vector (tileset-ref tiles 19)
- (tileset-ref tiles 20)
- (tileset-ref tiles 21)
- (tileset-ref tiles 22)
- (tileset-ref tiles 23)
- (tileset-ref tiles 24)
- (tileset-ref tiles 25)
- (tileset-ref tiles 26))))
- (make-animation frames 6 #t)))
-
-(define sprite (make-sprite (make-demo-animation)
- #:position #(320 240)))
-
-(add-hook! draw-hook (lambda (dt alpha) (draw-sprite sprite)))
+(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 position-tween
+ (tween vlerp (compose ease-linear ease-loop)
+ (vector2 480 240) (vector2 160 240) 120))
+
+(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-signal timer
+ (signal-fold + 0 (signal-every 1)))
+
+(define-signal scene
+ (signal-map (lambda (time)
+ (group-move (position-tween time)
+ (group (vector-ref walk-cycle (frame-tween time)))))
+ timer))
+
+(define camera (orthographic-camera 640 480))
+
+(add-hook! draw-hook (lambda _ (draw-group (signal-ref scene) camera)))
(with-window (make-window #:title "Animation")
(start-game-loop))
+
+;;; Local Variables:
+;;; compile-command: "../pre-inst-env guile animation.scm"
+;;; End:
diff --git a/examples/common.scm b/examples/common.scm
index 46797bb..541488a 100644
--- a/examples/common.scm
+++ b/examples/common.scm
@@ -21,7 +21,6 @@
(sly input keyboard)
(sly repl)
(sly signal)
- (sly render sprite)
(sly window))
(open-window)
diff --git a/examples/simple.scm b/examples/simple.scm
index 0fd4503..9560f6f 100644
--- a/examples/simple.scm
+++ b/examples/simple.scm
@@ -15,34 +15,25 @@
;;; along with this program. If not, see
;;; <http://www.gnu.org/licenses/>.
-(use-modules (sly camera)
- (sly game)
- (sly math rect)
- (sly render scene)
- (sly render sprite)
- (sly math transform)
- (sly vector)
+(use-modules (sly game)
(sly window)
- (sly render color))
+ (sly math vector)
+ (sly render camera)
+ (sly render group)
+ (sly render sprite))
(load "common.scm")
(define scene
- (scene-root
- (scene-node
- (position #(320 240))
- (uniforms `(("color" ,white)))
- (children
- (list (load-sprite "images/p1_front.png"))))))
+ (group-move (vector2 320 240)
+ (group (load-sprite "images/p1_front.png"))))
-(define camera
- (make-camera scene
- identity-transform
- (orthographic-projection 0 640 0 480 0 1)
- (make-rect 0 0 640 480)))
+(define camera (orthographic-camera 640 480))
+
+(add-hook! draw-hook (lambda _ (draw-group scene camera)))
(with-window (make-window #:title "Simple Sprite Demo")
- (start-game-loop camera))
+ (start-game-loop))
;;; Local Variables:
;;; compile-command: "../pre-inst-env guile simple.scm"