summaryrefslogtreecommitdiff
path: root/examples/tile-map.scm
blob: ae1342b9f505866cbf1ad25df2262c0a464a7e69 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
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/example.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)