examples: tiled: Add smooth scrolling with arrow keys.

1 files changed, 52 insertions, 13 deletions

diff --git a/examples/tiled.scm b/examples/tiled.scm
index c64f7b6..0f7c4fa 100644
--- a/examples/tiled.scm
+++ b/examples/tiled.scm
@@ -1,6 +1,7 @@
 (use-modules (chickadee)
              (chickadee math vector)
              (chickadee math rect)
+             (chickadee graphics color)
              (chickadee graphics font)
              (chickadee graphics tiled)
              (ice-9 format)
@@ -8,35 +9,73 @@
              (srfi srfi-11))
 
 (define map #f)
-(define camera #v(0.0 0.0))
-(define text-position #v(4.0 4.0))
+(define prev-camera (vec2 0.0 0.0))
+(define camera (vec2 0.0 0.0))
+(define render-camera (vec2 0.0 0.0))
+(define text-position (vec2 4.0 4.0))
 (define text "0, 0")
+(define (stats-message)
+  (format #f "fps: ~1,2f"
+          (/ 1000.0 avg-frame-time)))
+(define start-time 0.0)
+(define avg-frame-time 16)
+(define stats-text (stats-message))
+(define stats-text-pos (vec2 4.0 464.0))
+(define last-update start-time)
+(define scroll-speed 6.0)
 
 (define (load)
   (set! map (load-tile-map "maps/example.tmx")))
 
 (define (draw alpha)
-  (draw-tile-map map #:position camera)
-  (draw-text text text-position))
+  ;; Linearly interpolate between the current camera position and the
+  ;; previous camera position based on the alpha value.  This makes
+  ;; the scrolling appear much smoother because the Chickadee game
+  ;; loop does not render in lock-step with updates.
+  (let ((beta (- 1.0 alpha)))
+    (set-vec2-x! render-camera
+                 (+ (* (vec2-x camera) alpha)
+                    (* (vec2-x prev-camera) beta)))
+    (set-vec2-y! render-camera
+                 (+ (* (vec2-y camera) alpha)
+                    (* (vec2-y prev-camera) beta))))
+  (draw-tile-map map #:camera render-camera)
+  (draw-text text text-position #:color black)
+  (draw-text stats-text stats-text-pos #:color black)
+  (let ((current-time (elapsed-time)))
+    (set! avg-frame-time
+          (+ (* (- current-time start-time) 0.1)
+             (* avg-frame-time 0.9)))
+    (set! start-time current-time)
+    (when (>= (- current-time last-update) 1000)
+      (set! stats-text (stats-message))
+      (set! last-update current-time))))
+
+(define (update dt)
+  (vec2-copy! camera prev-camera)
+  (set-vec2-x! camera
+               (+ (vec2-x camera)
+                  (if (key-pressed? 'right) scroll-speed 0.0)
+                  (if (key-pressed? 'left) (- scroll-speed) 0.0)))
+  (set-vec2-y! camera
+               (+ (vec2-y camera)
+                  (if (key-pressed? 'up) scroll-speed 0.0)
+                  (if (key-pressed? 'down) (- scroll-speed) 0.0))))
 
-(define inc 8.0)
 (define (key-press key modifiers repeat?)
   (match key
-    ('up (set-vec2-y! camera (- (vec2-y camera) inc)))
-    ('down (set-vec2-y! camera (+ (vec2-y camera) inc)))
-    ('right (set-vec2-x! camera (- (vec2-x camera) inc)))
-    ('left (set-vec2-x! camera (+ (vec2-x camera) inc)))
-    ('q (abort-game))
+    ((or 'escape 'q) (abort-game))
     (_ #t)))
 
 (define (mouse-move x y x-rel y-rel buttons)
-  (let-values (((tx ty) (point->tile map x y)))
+  (let-values (((tx ty) (point->tile map (- x (vec2-x camera)) (- y (vec2-y camera)))))
     (set! text (format #f "~d, ~d" tx ty))))
 
-(run-game #:window-width 320
-          #:window-height 240
+(run-game #:window-width 640
+          #:window-height 480
           #:window-title "tile map demo"
           #:load load
           #:draw draw
+          #:update update
           #:key-press key-press
           #:mouse-move mouse-move)