blob: f73504926ffaa9641e98ac5044a1f33739128eed (
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
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
|
(library (strigoform level)
(export tile-width
tile-height
make-level-object
level-object?
level-object-x
level-object-type
level-object-properties
make-level
level?
level-height
level-foreground
level-collision
level-objects
level-update!
draw-level-foreground
rect-collides-with-level?)
(import (scheme base)
(hoot match)
(strigoform assets)
(strigoform canvas)
(strigoform game-area)
(strigoform math)
(strigoform type))
;; action id, sprite sheet offset, x, y
(define %tile-size (+ 4 8 8 8))
(define tile-width 16.0)
(define tile-height 16.0)
(define level-width 15)
(define-type level-object
make-level-object
level-object?
(x level-object-x set-level-object-x!)
(type level-object-type set-level-object-type!)
(properties level-object-properties set-level-object-properties!))
(define-type level
make-level
level?
(height level-height set-level-height!)
(foreground level-foreground set-level-foreground!)
(collision level-collision set-level-collision!)
(objects level-objects set-level-objects!))
(define (level-offset x y)
(+ (* level-width y) x))
(define (point-collides-with-level? level x y)
(match level
(#('level height foreground collision objects)
(let ((tx (exact (truncate (/ x tile-width))))
(ty (exact (truncate (/ y tile-height)))))
(and (>= tx 0) (< tx level-width)
(>= ty 0) (< tx height)
(= (bytevector-u8-ref collision (level-offset tx ty)) 1))))))
(define (rect-collides-with-level? level x y w h scroll)
(match level
(#('level height foreground collision objects)
(let* ((y (+ y (- (* height tile-height) game-height scroll)))
(tx0 (exact (truncate (/ x tile-width))))
(ty0 (exact (truncate (/ y tile-height))))
(tx1 (exact (truncate (/ (+ x w) tile-width))))
(ty1 (exact (truncate (/ (+ y h) tile-height)))))
(define (occupied? x y)
(and (>= x 0) (< x level-width)
(>= y 0) (< x height)
(= (bytevector-u8-ref collision (level-offset x y)) 1)))
(or (occupied? tx0 ty0)
(occupied? tx1 ty0)
(occupied? tx1 ty1)
(occupied? tx0 ty1))))))
(define (draw-level-layer context level layer parallax scroll)
(match level
(#('level height _ _ _)
(let* ((tw tile-width)
(th tile-height)
(scroll (* scroll parallax))
(pixel-y-offset (- (* height th) scroll game-height))
(scroll-y-offset (- height (exact (truncate (/ scroll tile-height)))))
(y-start (clamp (- scroll-y-offset 21) 0 height))
(y-end (clamp scroll-y-offset 0 height)))
(do ((y y-start (+ y 1)))
((= y y-end))
(let* ((row (vector-ref layer y))
(k (/ (bytevector-length row) 16))
(ty (* y tile-height)))
(do ((x 0 (+ x 1)))
((= x k))
(let* ((offset (* x 16))
(tx (f64-ref row offset))
(ix (f64-ref row (+ offset 8))))
(draw-image context image:map
ix 0.0 tw th
tx (- ty pixel-y-offset) tw th)))))))))
(define (draw-level-foreground context level scroll)
(match level
(#('level height foreground collision objects)
(draw-level-layer context level foreground 1.0 scroll))))
(define (level-update! level scroll last-row-scanned do-action)
(match level
(#('level height foreground collision objects)
(let ((row (max
(exact
(truncate
(/ (- (* height tile-height)
game-height scroll)
tile-height)))
0)))
(do ((y row (+ y 1)))
((= y last-row-scanned))
(for-each (lambda (obj)
(match obj
(#('level-object x type properties)
(let ((x* (+ (* x tile-width)
(/ tile-width 2.0)))
(y* (+ (* (- y row 1) tile-height)
(/ tile-height 2.0))))
(do-action type x* y* properties)))))
(vector-ref objects y)))
row)))))
|
