From e05aa45f672eb49312449d359a9e345223741b19 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Fri, 9 Apr 2021 22:37:49 -0400
Subject: graphics: Rewrite tile map module.

---
 examples/tile-map.scm | 100 ++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 100 insertions(+)
 create mode 100644 examples/tile-map.scm

(limited to 'examples/tile-map.scm')

diff --git a/examples/tile-map.scm b/examples/tile-map.scm
new file mode 100644
index 0000000..52d6b94
--- /dev/null
+++ b/examples/tile-map.scm
@@ -0,0 +1,100 @@
+(use-modules (chickadee)
+             (chickadee math vector)
+             (chickadee math rect)
+             (chickadee graphics color)
+             (chickadee graphics font)
+             (chickadee graphics tile-map)
+             (ice-9 format)
+             (ice-9 match)
+             (srfi srfi-11))
+
+(define window-width 960)
+(define window-height 540)
+(define map #f)
+(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"
+          (/ 1.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 (- window-height 16.0)))
+(define last-update start-time)
+(define scroll-speed 6.0)
+
+(define (load)
+  (set! map (load-tile-map "maps/example3.tmx")))
+
+(define (draw alpha)
+  ;; 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
+                 (round
+                  (+ (* (vec2-x camera) alpha)
+                     (* (vec2-x prev-camera) beta))))
+    (set-vec2-y! render-camera
+                 (round
+                  (+ (* (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) 1.0)
+      (set! stats-text (stats-message))
+      (set! last-update current-time))))
+
+(define (refresh-tile-coords x y)
+  (call-with-values (lambda ()
+                      (point->tile map
+                                   (+ x (vec2-x camera))
+                                   (+ y (vec2-y camera))))
+    (lambda (tx ty)
+      (set! text (format #f "~d, ~d" tx ty)))))
+
+(define (update dt)
+  (vec2-copy! camera prev-camera)
+  (set-vec2! camera
+             (min (max (+ (vec2-x camera)
+                          (if (key-pressed? 'right) scroll-speed 0.0)
+                          (if (key-pressed? 'left) (- scroll-speed) 0.0))
+                       0.0)
+                  (- (* (tile-map-width map) (tile-map-tile-width map))
+                     window-width))
+             (min (max (+ (vec2-y camera)
+                          (if (key-pressed? 'up) scroll-speed 0.0)
+                          (if (key-pressed? 'down) (- scroll-speed) 0.0))
+                       0.0)
+                  (- (* (tile-map-height map) (tile-map-tile-height map))
+                     window-height)))
+  (when (or (key-pressed? 'left) (key-pressed? 'right)
+            (key-pressed? 'down) (key-pressed? 'up))
+    (refresh-tile-coords (mouse-x) (mouse-y))))
+
+(define (key-press key modifiers repeat?)
+  (match key
+    ((or 'escape 'q) (abort-game))
+    (_ #t)))
+
+(define (mouse-move x y x-rel y-rel buttons)
+  (refresh-tile-coords x y))
+
+(run-game #:window-width window-width
+          #:window-height window-height
+          #:window-title "tile map demo"
+          #:load load
+          #:draw draw
+          #:update update
+          #:key-press key-press
+          #:mouse-move mouse-move)
-- 
cgit v1.2.3