summaryrefslogtreecommitdiff
path: root/examples/grid.scm
blob: 6fab47ab5ad58749bf576b375606c336a5b7b84f (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
(use-modules (chickadee)
             (chickadee math grid)
             (chickadee math vector)
             (chickadee math rect)
             (chickadee render)
             (chickadee render color)
             (chickadee render font)
             (chickadee render shapes)
             (chickadee render sprite)
             (chickadee sdl)
             (sdl2 input keyboard))

(define grid (make-grid))
(define item-color (make-color 0.7 0.0 0.0 0.5))
(define cell-color (make-color 0.0 0.7 0.0 0.2))
(define player-color (make-color 0.0 0.0 0.7 0.8))
(define player-pos #v(32.0 32.0))
(define player-speed 2)
(define player-velocity #v(0.0 0.0))

(define (load)
  (grid-add grid 'wall-left 0 0 32 480)
  (grid-add grid 'wall-top 32 448 576 32)
  (grid-add grid 'wall-right 608 0 32 480)
  (grid-add grid 'wall-bottom 32 0 576 32)
  (grid-add grid 'box-1 100 100 100 50)
  (grid-add grid 'box-2 300 300 50 100)
  (grid-add grid 'box-3 350 150 200 75)
  (grid-add grid 'box-4 150 140 130 75)
  (grid-add grid 'player (vec2-x player-pos) (vec2-y player-pos) 32 32))

(define (update dt)
  (set-vec2-x! player-velocity 0.0)
  (set-vec2-y! player-velocity 0.0)
  (when (key-pressed? 'up)
    (set-vec2-y! player-velocity player-speed))
  (when (key-pressed? 'down)
    (set-vec2-y! player-velocity (- player-speed)))
  (when (key-pressed? 'right)
    (set-vec2-x! player-velocity player-speed))
  (when (key-pressed? 'left)
    (set-vec2-x! player-velocity (- player-speed)))
  (vec2-add! player-pos player-velocity)
  (grid-move grid 'player player-pos
             (lambda (a b)
               (if (eq? a 'player)
                   slide
                   #f))))

(define %cell-rect
  (make-rect 0.0 0.0 (grid-cell-size grid) (grid-cell-size grid)))
(define %cell-count-pos
  #v(0.0 0.0))

(define number->string*
  (let ((cache (make-hash-table)))
    (lambda (n)
      (or (hashv-ref cache n)
          (begin
            (let ((s (number->string n)))
              (hashv-set! cache n s)
              s))))))

(define (draw alpha)
  (with-blend-mode 'alpha
    (let ((size (grid-cell-size grid)))
      (for-each-cell (lambda (cell x y)
                       (set-rect-x! %cell-rect (* x size))
                       (set-rect-y! %cell-rect (* y size))
                       (draw-filled-rect %cell-rect cell-color))
                     grid)
      (with-batched-sprites
       (for-each-cell (lambda (cell x y)
                        (set-vec2-x! %cell-count-pos (+ (* x size) (/ size 2)))
                        (set-vec2-y! %cell-count-pos (+ (* y size) (/ size 2)))
                        (draw-text (number->string* (cell-count cell))
                                   %cell-count-pos))
                      grid)))
    (for-each-item (lambda (item rect)
                     (if (eq? item 'player)
                         (draw-filled-rect rect player-color)
                         (draw-filled-rect rect item-color)))
                   grid)))

(run-game/sdl #:load load #:draw draw #:update update)