blob: 38ebfede4b65243eb0653eebbbc7907eeeb9cfd8 (
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
|
(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
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)
(frame-delay 16)
(input-config *default-input-config*)
(preload #f) (create #f) (update #f) (render #f)
(debug? #f))
(make-game*
title: title
width: width
height: height
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! ──────────────────────────────────────────────────────────────
;; Main event loop and lifecycle orchestration
(define (game-run! game)
;; 1. SDL2 init (audio excluded — mixer.scm not yet extracted;
;; user calls init-audio! in their preload: hook)
(sdl2:set-main-ready!)
(sdl2:init! '(video joystick game-controller))
(ttf:init!)
(img:init! '(png))
;; Open any already-connected game controllers
(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))))
;; 2. Create window + renderer
(game-window-set! game
(sdl2:create-window! (game-title game) 'centered 'centered
(game-width game) (game-height game) '()))
(game-renderer-set! game
(sdl2:create-renderer! (game-window game) -1 '(accelerated)))
;; 3. preload: hook — user loads assets here
(when (game-preload-hook game)
((game-preload-hook game) game))
;; 4. create: hook — user builds initial scene here
(when (game-create-hook game)
((game-create-hook game) game))
;; 5. Frame loop
(let loop ((last-ticks (sdl2:get-ticks)))
(let* ((now (sdl2:get-ticks))
(dt (- now last-ticks)))
;; Collect all pending SDL2 events
(sdl2:pump-events!)
(let* ((events (let collect ((lst '()))
(if (not (sdl2:has-events?))
(reverse lst)
(let ((e (sdl2:make-event)))
(sdl2:poll-event! e)
(collect (cons e lst))))))
(input (input-state-update (game-input game) events
(game-input-config game))))
(game-input-set! game input)
(unless (input-held? input 'quit)
;; Dispatch to active state hooks, or fall back to game's own hooks
(let* ((active (game-active-state game))
(state (and active
(hash-table-ref/default (game-states game) active #f)))
(update-fn (or (and state (state-hook state #:update))
(game-update-hook game)))
(render-fn (or (and state (state-hook state #:render))
(game-render-hook game))))
(when update-fn (update-fn game dt))
;; Auto camera-follow: if scene has a camera-target tag, follow it
(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)))))))
(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))
(sdl2:delay! (game-frame-delay game))
(loop now)))))
;; 6. Cleanup
(sdl2:destroy-window! (game-window game))
(sdl2:quit!))
) ;; end module
|
