Re-add key-pressed? and key-released? procedures.
[chickadee.git] / examples / grid.scm
CommitLineData
7c5135bf
DT
1(use-modules (chickadee)
2 (chickadee math grid)
3 (chickadee math vector)
4 (chickadee math rect)
5 (chickadee render)
6 (chickadee render color)
7 (chickadee render font)
8 (chickadee render shapes)
607e537e 9 (chickadee render sprite))
7c5135bf 10
7c5135bf
DT
11(define grid (make-grid))
12(define item-color (make-color 0.7 0.0 0.0 0.5))
13(define cell-color (make-color 0.0 0.7 0.0 0.2))
14(define player-color (make-color 0.0 0.0 0.7 0.8))
15(define player-pos #v(32.0 32.0))
16(define player-speed 2)
17(define player-velocity #v(0.0 0.0))
18
19(define (load)
7c5135bf
DT
20 (grid-add grid 'wall-left 0 0 32 480)
21 (grid-add grid 'wall-top 32 448 576 32)
22 (grid-add grid 'wall-right 608 0 32 480)
23 (grid-add grid 'wall-bottom 32 0 576 32)
24 (grid-add grid 'box-1 100 100 100 50)
25 (grid-add grid 'box-2 300 300 50 100)
26 (grid-add grid 'box-3 350 150 200 75)
27 (grid-add grid 'box-4 150 140 130 75)
28 (grid-add grid 'player (vec2-x player-pos) (vec2-y player-pos) 32 32))
29
30(define (update dt)
31 (set-vec2-x! player-velocity 0.0)
32 (set-vec2-y! player-velocity 0.0)
33 (when (key-pressed? 'up)
34 (set-vec2-y! player-velocity player-speed))
35 (when (key-pressed? 'down)
36 (set-vec2-y! player-velocity (- player-speed)))
37 (when (key-pressed? 'right)
38 (set-vec2-x! player-velocity player-speed))
39 (when (key-pressed? 'left)
40 (set-vec2-x! player-velocity (- player-speed)))
41 (vec2-add! player-pos player-velocity)
42 (grid-move grid 'player player-pos
43 (lambda (a b)
44 (if (eq? a 'player)
45 slide
46 #f))))
47
48(define %cell-rect
49 (make-rect 0.0 0.0 (grid-cell-size grid) (grid-cell-size grid)))
50(define %cell-count-pos
51 #v(0.0 0.0))
52
53(define number->string*
54 (let ((cache (make-hash-table)))
55 (lambda (n)
56 (or (hashv-ref cache n)
57 (begin
58 (let ((s (number->string n)))
59 (hashv-set! cache n s)
60 s))))))
61
62(define (draw alpha)
63 (with-blend-mode 'alpha
64 (let ((size (grid-cell-size grid)))
65 (for-each-cell (lambda (cell x y)
66 (set-rect-x! %cell-rect (* x size))
67 (set-rect-y! %cell-rect (* y size))
68 (draw-filled-rect %cell-rect cell-color))
69 grid)
70 (with-batched-sprites
71 (for-each-cell (lambda (cell x y)
72 (set-vec2-x! %cell-count-pos (+ (* x size) (/ size 2)))
73 (set-vec2-y! %cell-count-pos (+ (* y size) (/ size 2)))
fe89f847 74 (draw-text (number->string* (cell-count cell))
7c5135bf
DT
75 %cell-count-pos))
76 grid)))
77 (for-each-item (lambda (item rect)
78 (if (eq? item 'player)
79 (draw-filled-rect rect player-color)
80 (draw-filled-rect rect item-color)))
81 grid)))
82
75c5cdef 83(run-game #:load load #:draw draw #:update update)