blob: 2feb69e3c04aae90fdb93358882d34f562434756 (
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
|
(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)
;; Programmatic level: same geometry as the old static-tile floor + mid shelf,
;; but as a real tile layer so tile collisions and detect-on-solid work.
(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)
(shelf-tile 20)
(air (map (lambda (_) (map (lambda (_) 0) (iota ncols))) (iota nrows)))
(floor-row (map (lambda (_) floor-tile) (iota ncols)))
(with-floor (append (take air (- nrows 1)) (list floor-row)))
;; Shelf top at same Y as before: gh - 6*th pixels from top
(shelf-r (inexact->exact (floor (/ (- gh (* 6 th)) th))))
(shelf-c0 10)
(shelf-n 10)
(row-before (list-ref with-floor shelf-r))
(shelf-row
(map (lambda (c)
(if (and (>= c shelf-c0) (< c (+ shelf-c0 shelf-n)))
shelf-tile
(list-ref row-before c)))
(iota ncols)))
(map-data (append (take with-floor shelf-r)
(list shelf-row)
(drop with-floor (+ shelf-r 1))))
(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))
(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 (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*)
|
