blob: f552d1ae57d540920caeefba713aa31a552fe567 (
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
101
102
103
104
105
106
107
108
109
110
111
112
113
|
(use-modules (chickadee)
(chickadee math grid)
(chickadee math vector)
(chickadee math rect)
(chickadee graphics color)
(chickadee graphics font)
(chickadee graphics path)
(chickadee graphics sprite))
(define grid (make-grid))
(define item-color (make-color 0.7 0.0 0.0 0.7))
(define cell-color (make-color 0.0 0.7 0.0 0.4))
(define player-color (make-color 0.0 0.0 0.7 0.8))
(define player-pos (vec2 32.0 32.0))
(define player-speed 2)
(define player-velocity (vec2 0.0 0.0))
(define null-vec2 (vec2 0.0 0.0))
(define last-cell-count -1)
(define cell-painter
(with-style ((fill-color cell-color))
(fill (square null-vec2 (grid-cell-size grid)))))
(define cell-canvas (make-empty-canvas))
(define item-canvas (make-empty-canvas))
(define (make-cell-painter)
(let ((size (grid-cell-size grid)))
(apply superimpose
(grid-cell-fold (lambda (cell x y memo)
(cons (translate (vec2 (* x size) (* y size))
cell-painter)
memo))
'()
grid))))
(define (make-item-painter item rect)
(with-style ((fill-color (if (eq? item 'player)
player-color
item-color)))
(fill
(rectangle (vec2 (rect-x rect)
(rect-y rect))
(rect-width rect)
(rect-height rect)))))
(define (compose-item-painters)
(apply superimpose
(grid-item-fold (lambda (item rect memo)
(cons (make-item-painter item rect) memo))
'()
grid)))
(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)
(set-canvas-painter! item-canvas (compose-item-painters)))
(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)))
(unless (vec2= player-velocity null-vec2)
(vec2-add! player-pos player-velocity)
(grid-move grid 'player player-pos
(lambda (a b)
(if (eq? a 'player)
slide
#f)))
(set-canvas-painter! item-canvas (compose-item-painters)))
(let ((cell-count (grid-cell-count grid)))
(unless (= cell-count last-cell-count)
(set! last-cell-count cell-count)
(set-canvas-painter! cell-canvas (make-cell-painter)))))
(define %cell-rect
(make-rect 0.0 0.0 (grid-cell-size grid) (grid-cell-size grid)))
(define %cell-count-pos
(vec2 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)
(draw-canvas cell-canvas)
(let ((size (grid-cell-size grid)))
(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))
(draw-canvas item-canvas))
(run-game #:load load #:draw draw #:update update)
|
