blob: ad2e056d26374c78960a2e4c26672c4b7641e07d (
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
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
|
(import scheme
(chicken base)
(chicken random)
(only srfi-1 drop iota take)
(prefix sdl2 "sdl2:")
(prefix sdl2-ttf "ttf:")
(prefix sdl2-image "img:")
downstroke-engine
downstroke-world
downstroke-tilemap
downstroke-physics
downstroke-assets
downstroke-entity
downstroke-scene-loader)
(define *demo-t* 0.0)
(define +static-skip+
'(jump acceleration gravity velocity-x velocity-y
tile-collisions-x tile-collisions-y on-solid))
;; Mid-level shelf only: immovable solid AABBs (same layout as the old tilemap shelf).
(define (make-shelf-platform gw gh tw th)
(let* ((shelf-tile-id 20)
(shelf-c0 10)
(shelf-n 10)
(x0 (* shelf-c0 tw))
(y (- gh (* 6 th))))
(map (lambda (i)
(list #:type 'static-tile
#:x (+ x0 (* i tw)) #:y y #:width tw #:height th
#:tile-id shelf-tile-id #:solid? #t #:immovable? #t
#:gravity? #f #:vx 0 #:vy 0 #:on-ground? #f
#:skip-pipelines +static-skip+))
(iota shelf-n))))
;; Floor only on the tilemap; shelf is entities (see make-shelf-platform).
(define (make-sandbox-tilemap ts tw th gw gh)
(let* ((ncols (inexact->exact (ceiling (/ gw tw))))
(nrows (inexact->exact (ceiling (/ gh th))))
(floor-tile 20)
(air (map (lambda (_) (map (lambda (_) 0) (iota ncols))) (iota nrows)))
(floor-row (map (lambda (_) floor-tile) (iota ncols)))
(map-data (append (take air (- nrows 1)) (list floor-row)))
(layer (make-layer name: "ground"
width: ncols height: nrows
map: map-data)))
(make-tilemap width: ncols height: nrows
tilewidth: tw tileheight: th
tileset-source: ""
tileset: ts
layers: (list layer)
objects: '())))
(define (spawn-boxes tw th)
(map (lambda (i)
(list #:type 'box
#:x (+ 30 (* i 55)) #:y (+ 10 (* (pseudo-random-integer 4) 20))
#:width tw #:height th
#:vx 0 #:vy 0
#:gravity? #t #:on-ground? #f
#:solid? #t #:immovable? #f
#:tile-id 29))
(iota 8)))
;; #:demo-id offsets phase; #:demo-since-jump accumulates ms for jump cadence.
(define (make-demo-bot x y tw th id)
(list #:type 'demo-bot
#:x x #:y y
#:width tw #:height th
#:vx 0 #:vy 0
#:gravity? #t #:on-ground? #f
#:solid? #t #:immovable? #f
#:tile-id 1
#:demo-id id
#:demo-since-jump 0))
(define (update-demo-bot e dt tm)
(let* ((id (entity-ref e #:demo-id 0))
(cycle 2600.0)
(phase (modulo (+ *demo-t* (* id 400.0)) cycle))
(vx (if (< phase (/ cycle 2.0)) 3.0 -3.0))
(e (entity-set e #:vx vx))
;; Set last frame by final pass: detect-on-solid after entity–entity resolve.
(ground? (entity-ref e #:on-ground? #f))
(since (+ (entity-ref e #:demo-since-jump 0) dt))
(jump-every 720.0)
(do-jump? (and ground? (>= since jump-every)))
(since (if do-jump? 0 since))
(e (entity-set e #:demo-since-jump since))
(e (apply-jump e do-jump?))
(e (apply-acceleration e))
(e (apply-gravity e))
(e (apply-velocity-x e))
(e (resolve-tile-collisions-x e tm))
(e (apply-velocity-y e))
(e (resolve-tile-collisions-y e tm)))
e))
(define (update-box e tm)
(let* ((e (apply-gravity e))
(e (apply-velocity-x e))
(e (resolve-tile-collisions-x e tm))
(e (apply-velocity-y e))
(e (resolve-tile-collisions-y e tm)))
e))
(define *game*
(make-game
title: "Demo: Physics Sandbox" width: 600 height: 400
create: (lambda (game)
(let* ((ts (game-load-tileset! game 'tileset
"demo/assets/monochrome_transparent.tsx"))
(tw (tileset-tilewidth ts))
(th (tileset-tileheight ts))
(tex (create-texture-from-tileset (game-renderer game) ts))
(gw (game-width game))
(gh (game-height game))
(tm (make-sandbox-tilemap ts tw th gw gh))
(shelf (make-shelf-platform gw gh tw th))
(bots
(list (make-demo-bot 80 80 tw th 0)
(make-demo-bot 220 60 tw th 1)
(make-demo-bot 380 100 tw th 2)))
(entities (append shelf (spawn-boxes tw th) bots))
(scene (make-scene
entities: entities
tilemap: tm
tileset: #f
camera: (make-camera x: 0 y: 0)
tileset-texture: tex
camera-target: #f
background: '(32 34 40))))
(game-scene-set! game scene)))
update: (lambda (game dt)
(set! *demo-t* (+ *demo-t* dt))
(let* ((scene (game-scene game))
(tm (scene-tilemap scene)))
(scene-update-entities scene
(lambda (e)
(cond
((eq? (entity-type e) 'demo-bot)
(update-demo-bot e dt tm))
((eq? (entity-type e) 'box)
(update-box e tm))
(else e))))
(scene-resolve-collisions scene)
(let ((post (scene-entities scene)))
(scene-update-entities scene
(lambda (e)
(if (entity-ref e #:gravity? #f)
(detect-on-solid e tm post)
e))))))))
(game-run! *game*)
|
