blob: 1d2c14f113472750f9fb61386207509211a9f857 (
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
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
|
(module downstroke-engine *
(import scheme
(chicken base)
(chicken keyword)
(prefix sdl2 "sdl2:")
(prefix sdl2-ttf "ttf:")
(prefix sdl2-image "img:")
(srfi 69)
defstruct
downstroke-world
downstroke-input
downstroke-assets
downstroke-renderer)
;; ── Game struct ────────────────────────────────────────────────────────────
;; defstruct auto-generates make-game, which we'll wrap with default values
(defstruct game
title width height
scale ;; positive integer: whole-game pixel scaling factor
window renderer
input ;; input-state record
input-config ;; input-config record
assets ;; asset registry (hash-table from assets.scm)
frame-delay
preload-hook ;; (lambda (game) ...)
create-hook ;; (lambda (game) ...)
update-hook ;; (lambda (game dt) ...)
render-hook ;; (lambda (game) ...) — post-render overlay
scene ;; current scene struct; #f until create: runs
states ;; hash-table of name → state-plist
active-state ;; symbol or #f — currently active state name
debug?) ;; boolean: enable debug overlay drawing
;; Store the auto-generated constructor as make-game*
(define make-game* make-game)
;; ── Public constructor wrapper ─────────────────────────────────────────────
;; Wraps the auto-generated make-game (renamed to make-game*) with default values
(define (make-game #!key
(title "Downstroke Game")
(width 640) (height 480)
(scale 1)
(frame-delay 16)
(input-config *default-input-config*)
(preload #f) (create #f) (update #f) (render #f)
(debug? #f))
(unless (and (integer? scale) (positive? scale))
(error "make-game: scale must be a positive integer" scale))
(make-game*
title: title
width: width
height: height
scale: scale
window: #f
renderer: #f
scene: #f
input: (create-input-state input-config)
input-config: input-config
assets: (make-asset-registry)
frame-delay: frame-delay
preload-hook: preload
create-hook: create
update-hook: update
render-hook: render
states: (make-hash-table)
active-state: #f
debug?: debug?))
;; ── Convenience accessors ──────────────────────────────────────────────────
;; game-camera: derived from the current scene (only valid after create: runs)
(define (game-camera game)
(scene-camera (game-scene game)))
;; game-asset: retrieve an asset by key
(define (game-asset game key)
(asset-ref (game-assets game) key))
;; game-asset-set!: store an asset by key
(define (game-asset-set! game key value)
(asset-set! (game-assets game) key value))
;; ── Named scene states ────────────────────────────────────────────────────
;; Construct a state plist with lifecycle hooks.
(define (make-game-state #!key (create #f) (update #f) (render #f))
(list #:create create #:update update #:render render))
;; Retrieve a value from a state plist.
(define (state-hook state key)
(get-keyword key state (lambda () #f)))
;; Register a named state. name is a symbol; state is a make-game-state plist.
(define (game-add-state! game name state)
(hash-table-set! (game-states game) name state))
;; Transition to a named state. Calls the state's create: hook if present.
(define (game-start-state! game name)
(game-active-state-set! game name)
(let* ((state (hash-table-ref (game-states game) name))
(create (state-hook state #:create)))
(when create (create game))))
;; Set renderer draw color for SDL_RenderClear (called every frame before clear).
(define (renderer-set-clear-color! renderer scene)
(let ((bg (and scene (scene-background scene))))
(if (and (list? bg) (>= (length bg) 3))
(let ((r (list-ref bg 0))
(g (list-ref bg 1))
(b (list-ref bg 2))
(a (if (>= (length bg) 4) (list-ref bg 3) 255)))
(set! (sdl2:render-draw-color renderer) (sdl2:make-color r g b a)))
(set! (sdl2:render-draw-color renderer) (sdl2:make-color 0 0 0 255)))))
;; ── game-run! helpers ─────────────────────────────────────────────────────
(define (collect-sdl-events)
(sdl2:pump-events!)
(let collect ((lst '()))
(if (not (sdl2:has-events?))
(reverse lst)
(let ((e (sdl2:make-event)))
(sdl2:poll-event! e)
(collect (cons e lst))))))
(define (resolve-hooks game)
(let* ((active (game-active-state game))
(state (and active
(hash-table-ref/default (game-states game) active #f))))
(values (or (and state (state-hook state #:update)) (game-update-hook game))
(or (and state (state-hook state #:render)) (game-render-hook game)))))
(define (update-camera-follow! game)
(when (game-scene game)
(let ((target-tag (scene-camera-target (game-scene game))))
(when target-tag
(let ((target (scene-find-tagged (game-scene game) target-tag)))
(when target
(camera-follow! (scene-camera (game-scene game))
target
(game-width game)
(game-height game))))))))
(define (game-render! game render-fn)
(renderer-set-clear-color! (game-renderer game) (game-scene game))
(sdl2:render-clear! (game-renderer game))
(when (game-scene game)
(render-scene! (game-renderer game) (game-scene game)))
(when (and (game-debug? game) (game-scene game))
(render-debug-scene! (game-renderer game) (game-scene game)))
(when render-fn (render-fn game))
(sdl2:render-present! (game-renderer game)))
;; ── game-run! ──────────────────────────────────────────────────────────────
(define (game-run! game)
(sdl2:set-main-ready!)
(sdl2:init! '(video joystick game-controller))
(ttf:init!)
(img:init! '(png))
(let init-controllers ((i 0))
(when (< i (sdl2:num-joysticks))
(when (sdl2:is-game-controller? i)
(sdl2:game-controller-open! i))
(init-controllers (+ i 1))))
(let ((scale (game-scale game)))
(game-window-set! game
(sdl2:create-window! (game-title game) 'centered 'centered
(* (game-width game) scale)
(* (game-height game) scale) '()))
(game-renderer-set! game
(sdl2:create-renderer! (game-window game) -1 '(accelerated)))
(when (> scale 1)
(sdl2:render-logical-size-set!
(game-renderer game)
(list (game-width game) (game-height game)))))
(when (game-preload-hook game) ((game-preload-hook game) game))
(when (game-create-hook game) ((game-create-hook game) game))
(let loop ((last-ticks (sdl2:get-ticks)))
(let* ((now (sdl2:get-ticks))
(dt (- now last-ticks))
(input (input-state-update (game-input game) (collect-sdl-events)
(game-input-config game))))
(game-input-set! game input)
(unless (input-held? input 'quit)
(receive (update-fn render-fn) (resolve-hooks game)
(when update-fn (update-fn game dt))
(update-camera-follow! game)
(game-render! game render-fn))
(sdl2:delay! (game-frame-delay game))
(loop now))))
(sdl2:destroy-window! (game-window game))
(sdl2:quit!))
) ;; end module
|
