src/sigil/audio/ladder.sgl

1;;; (sigil audio ladder) - Step a producer's render rate down when it cannot keep up

2;;;

3;;; A game that synthesises its audio on the frame thread (a tracker, a synth)

4;;; spends time per frame in proportion to the rate it renders at. On a weak

5;;; device that time does not fit a 60 fps frame, and the audio breaks up. The

6;;; ladder measures what the producer costs, and when the steady cost is over

7;;; budget it steps the render rate down a rung (48000 -> 32000 -> 24000 ->

8;;; 22050, say). The sink then upsamples the lower rate to the device's

9;;; (`set-audio-stream-rate!` on the web sink), so the music keeps playing a

10;;; little duller instead of stuttering.

11;;;

12;;; The ladder is the policy and the measurement; it does not touch a sink or a

13;;; player. The game declares the rungs, the budget and the floor, feeds it the

14;;; cost of each pull, and asks it once a frame whether to step:

15;;;

16;;; ```scheme

17;;; (import (sigil audio ladder))

18;;; (define ladder (make-rate-ladder (audio-context-sample-rate ctx)

19;;; rungs: '(32000 24000 22050)

20;;; budget-ms: 4.0

21;;; key: "ring 16384"))

22;;;

23;;; ;; each pull of the producer: timed and recorded

24;;; (rate-ladder-measure ladder n (lambda () (player-pull! p buf 0 n)))

25;;;

26;;; ;; each cue the game plays: the next pulls are a tap's frame, not a sample

27;;; (rate-ladder-quiet! ladder)

28;;;

29;;; ;; once a frame: a new rate when the ladder stepped, else #f

30;;; (let ((rate (rate-ladder-step! ladder)))

31;;; (when rate (reopen-player-at! rate)))

32;;;

33;;; (rate-ladder-report ladder) ; => "48000/24000 BY LADDER@20.2S"

34;;; ```

35;;;

36;;; ## The rules, and why each one exists

37;;;

38;;; Every rule below was learned from a measurement on a phone (Crash the

39;;; Stack, 2026-09-21 to 23), and the ladder's value is mostly in its refusals:

40;;;

41;;; - **The median of a window of pulls decides, never one pull** (`window:`,

42;;; 60 by default, about a second of frames). The first tile tap's frame

43;;; alone dragged a MEAN from 48000 to 32000: a mean plus one hostile frame

44;;; is not a device's speed.

45;;; - **Pulls next to a cue or an open are not measured.** The frame that

46;;; draws a tap, or parses and opens a tune, is not a sample of steady cost.

47;;; `rate-ladder-quiet!` refuses pulls for `quiet-ms:` (150); an open, and

48;;; every step, refuses the next `skip:` pulls (30) as well.

49;;; - **It steps down only.** A step is a reopen at the audible position,

50;;; heard as a short gap, so a ladder that went up and down would chatter.

51;;; Nothing but an explicit pin (or lifting one) can raise the rate, and no

52;;; hint, restore or step goes below the floor.

53;;; - **A stored rate is a measurement under one buffering.** The rung a

54;;; device lands on is not a property of the device alone: the same phone

55;;; settled at 24000 with a 256 ms ring and at 32000, 3 s sooner, with a

56;;; 320 ms ring, because a ring that is not repeatedly drained gives a

57;;; calmer median. So what the ladder asks you to remember carries a `key:`

58;;; (describe the buffering: "ring 12288"), and `rate-ladder-restore!`

59;;; ignores a stored rate whose key differs.

60;;;

61;;; ## Reasons, for a readout

62;;;

63;;; `rate-ladder-reason` answers why the rate is what it is: `device` (the

64;;; device's own rate), `stored` (restored from a previous boot), `hint` (the

65;;; game started low, e.g. from the page's cores/memory hints), `pin` (a test

66;;; or a player's setting pinned it; the ladder does not step), or

67;;; `(ladder . seconds)` (the ladder stepped, that many seconds after the

68;;; ladder was made). `rate-ladder-reason-string` and `rate-ladder-report`

69;;; spell it the way a one-line readout wants it.

71(define-library (sigil audio ladder)

72 (import (sigil core)

73 (sigil math)

74 (sigil time)

75 (sigil struct)

76 (sigil list)

77 (sigil string))

79 (export make-rate-ladder

80 rate-ladder?

81 rate-ladder-rate

82 rate-ladder-device-rate

83 rate-ladder-rungs

84 rate-ladder-budget

85 rate-ladder-set-budget!

86 rate-ladder-reason

87 rate-ladder-reason-string

88 rate-ladder-report

89 rate-ladder-pinned?

90 rate-ladder-pin!

91 rate-ladder-unpin!

92 rate-ladder-hint!

93 rate-ladder-restore!

94 rate-ladder-remembered

95 rate-ladder-opened!

96 rate-ladder-quiet!

97 rate-ladder-record!

98 rate-ladder-measure

99 rate-ladder-step!

100 rate-ladder-pulls

101 rate-ladder-last-cost) ; the median cost per frame (ms) of the last window decided, or #f

102

103 (begin

104 (define-struct rate-ladder

105 (device-rate)

106 (rungs) ; below the device's rate, at or above the floor, descending

107 (budget mutable: #t) ; ms per frame the producer may spend, steady

108 (window) ; measured pulls a decision takes

109 (skip) ; pulls refused after an open or a step

110 (quiet-ms) ; ms refused after a cue

111 (frame-rate) ; the frames per second the budget is per

112 (clock) ; () -> ms

113 (remember) ; (string) -> any, or #f: called after a step

114 (key) ; the buffering a remembered rate was measured under

115 (lowest) ; the floor: no hint, restore or step goes below it

116 (boot-ms)

117 (rate mutable: #t)

118 (reason mutable: #t)

119 (pinned mutable: #t)

120 (samples) ; the window: per-frame costs, ms

121 (count mutable: #t) ; measured pulls in the window

122 (skip-left mutable: #t)

123 (quiet-until mutable: #t)

124 (last-cost mutable: #t)) ; the median of the last window decided, ms per frame, or #f

125

126 ;;; Make a ladder for a producer on a device running at DEVICE-RATE Hz.

127 ;;;

128 ;;; Keywords:

129 ;;; rungs: the rates below the device's to step through, in any

130 ;;; order (default '(32000 24000 22050)). Rungs at or above

131 ;;; the device's rate are dropped.

132 ;;; floor: the lowest rate the ladder may reach (default #f: the

133 ;;; lowest rung). A judgement about your weakest device.

134 ;;; budget-ms: the steady cost per frame the producer may spend, ms

135 ;;; (default 4.0)

136 ;;; frame-rate: the frames per second that budget is per (default 60)

137 ;;; window: measured pulls per decision (default 60)

138 ;;; skip: pulls refused after an open or a step (default 30)

139 ;;; quiet-ms: ms refused after rate-ladder-quiet! (default 150)

140 ;;; remember: a procedure given rate-ladder-remembered's string after

141 ;;; each step (a store for the next boot), or #f

142 ;;; key: the buffering the rate is measured under, as a string

143 ;;; (default ""), e.g. "ring 16384"

144 ;;; clock: a procedure answering the time in ms (default: the

145 ;;; monotonic clock, fractional ms; a test passes its own).

146 ;;; It must resolve well under a millisecond: a pull costs

147 ;;; tenths of one, and a whole-ms clock rounds those to 0 or

148 ;;; 1, which moves the median across the budget.

149 (define (make-rate-ladder device-rate

150 (keys: (rungs '(32000 24000 22050))

151 (floor #f)

152 (budget-ms 4.0)

153 (frame-rate 60)

154 (window 60)

155 (skip 30)

156 (quiet-ms 150)

157 (remember #f)

158 (key "")

159 (clock monotonic-ms)))

160 (let* ((low (or floor 0))

161 (rs (list-sort > (filter (lambda (r) (and (< r device-rate) (>= r low))) rungs)))

162 (lowest (or floor (if (null? rs) device-rate (list-ref rs (- (length rs) 1)))))

163 (now (clock)))

164 (rate-ladder device-rate: device-rate

165 rungs: rs

166 budget: (* 1.0 budget-ms)

167 window: (max 1 window)

168 skip: (max 0 skip)

169 quiet-ms: quiet-ms

170 frame-rate: frame-rate

171 clock: clock

172 remember: remember

173 key: key

174 lowest: lowest

175 boot-ms: now

176 rate: device-rate

177 reason: 'device

178 pinned: #f

179 samples: (make-vector (max 1 window) 0.0)

180 count: 0

181 skip-left: (max 0 skip)

182 quiet-until: now

183 last-cost: #f)))

184

185 ;; ms on the monotonic clock, fractional (current-jiffy is nanoseconds

186 ;; natively; the browser's clock under wasm)

187 (define (monotonic-ms)

188 (/ (* 1000.0 (current-jiffy)) (jiffies-per-second)))

189

190 ;;; The budget, ms per frame. A test arm lowers it to force the ladder.

191 (define (rate-ladder-set-budget! l ms)

192 (when (and (number? ms) (> ms 0))

193 (set-rate-ladder-budget! l (* 1.0 ms))))

194

195 (define (clear-window! l)

196 (set-rate-ladder-count! l 0))

197

198 ;; ---------------------------------------------------------------------

199 ;; Reasons

200 ;; ---------------------------------------------------------------------

201

202 ;;; Why the rate is what it is, for a readout: "DEVICE", "STORED", "HINT",

203 ;;; "PIN" or "LADDER@<seconds>S".

204 (define (rate-ladder-reason-string l)

205 (let ((r (rate-ladder-reason l)))

206 (cond ((pair? r) (string-append "LADDER@" (number->string (cdr r)) "S"))

207 ((eq? r 'stored) "STORED")

208 ((eq? r 'hint) "HINT")

209 ((eq? r 'pin) "PIN")

210 (else "DEVICE"))))

211

212 ;;; "<device-rate>/<rate> BY <reason>", e.g. "48000/24000 BY LADDER@20.2S".

213 (define (rate-ladder-report l)

214 (string-append (number->string (rate-ladder-device-rate l)) "/"

215 (number->string (rate-ladder-rate l)) " BY "

216 (rate-ladder-reason-string l)))

217

218 (define (rate-ladder-pinned? l) (and (rate-ladder-pinned l) #t))

219

220 ;; ---------------------------------------------------------------------

221 ;; Starting rates: pin, hint, stored

222 ;; ---------------------------------------------------------------------

223

224 ;;; Pin the rate (clamped to the device's): the ladder stops stepping and

225 ;;; reports PIN. A pin, or lifting one, is the only way the rate goes up.

226 (define (rate-ladder-pin! l rate)

227 (set-rate-ladder-rate! l (max 1 (min rate (rate-ladder-device-rate l))))

228 (set-rate-ladder-pinned! l #t)

229 (set-rate-ladder-reason! l 'pin)

230 (clear-window! l)

231 (rate-ladder-rate l))

232

233 ;;; Lift a pin: back to the device's rate (up, if the pin was lower), and

234 ;;; the ladder runs again.

235 (define (rate-ladder-unpin! l)

236 (set-rate-ladder-pinned! l #f)

237 (set-rate-ladder-rate! l (rate-ladder-device-rate l))

238 (set-rate-ladder-reason! l 'device)

239 (clear-window! l)

240 (rate-ladder-rate l))

241

242 ;;; Start low on a device the game already believes is weak (the page's

243 ;;; cores/memory hints). Applies only while the ladder is unpinned and

244 ;;; still at the device's rate, only downward, and not below the floor.

245 ;;; Answers #t if applied.

246 (define (rate-ladder-hint! l rate)

247 (if (and (not (rate-ladder-pinned l))

248 (eq? (rate-ladder-reason l) 'device)

249 (integer? rate)

250 (< rate (rate-ladder-device-rate l))

251 (>= rate (rate-ladder-lowest l)))

252 (begin

253 (set-rate-ladder-rate! l rate)

254 (set-rate-ladder-reason! l 'hint)

255 (clear-window! l)

256 #t)

257 #f))

258

259 ;;; The string to keep for the next boot: "<rate> <key>", or "<rate>" when

260 ;;; the key is "".

261 (define (rate-ladder-remembered l)

262 (if (equal? (rate-ladder-key l) "")

263 (number->string (rate-ladder-rate l))

264 (string-append (number->string (rate-ladder-rate l)) " " (rate-ladder-key l))))

265

266 ;;; Restore a rate a previous boot remembered (rate-ladder-remembered's

267 ;;; string). Ignored, answering #f, when the ladder is pinned, the string

268 ;;; does not read, it was measured under a different key, it is below the

269 ;;; floor, or it is not below the rate in force (a restore never raises the

270 ;;; rate). Answers the restored rate otherwise.

271 (define (rate-ladder-restore! l stored)

272 (let* ((sp (and (string? stored) (string-index stored (lambda (c) (char=? c #\space)))))

273 (end (and (string? stored) (or sp (string-length stored))))

274 (rate (and end (string->number (substring stored 0 end))))

275 (key (and end (if sp (substring stored (+ sp 1) (string-length stored)) ""))))

276 (if (and rate key

277 (integer? rate)

278 (>= rate (rate-ladder-lowest l))

279 (not (rate-ladder-pinned l))

280 (equal? key (rate-ladder-key l))

281 (< rate (rate-ladder-rate l)))

282 (begin

283 (set-rate-ladder-rate! l rate)

284 (set-rate-ladder-reason! l 'stored)

285 (clear-window! l)

286 rate)

287 #f)))

288

289 ;; ---------------------------------------------------------------------

290 ;; Measuring

291 ;; ---------------------------------------------------------------------

292

293 ;;; The producer (re)opened: its first pulls carry the open's own work, so

294 ;;; the next `skip` pulls and the next `quiet-ms` are not measured, and the

295 ;;; window starts over.

296 (define (rate-ladder-opened! l)

297 (clear-window! l)

298 (set-rate-ladder-skip-left! l (rate-ladder-skip l))

299 (rate-ladder-quiet! l))

300

301 ;;; A cue (a tap's sound, an effect) just played: the pulls in the next

302 ;;; `quiet-ms` share a frame with its drawing and are not measured.

303 (define (rate-ladder-quiet! l)

304 (set-rate-ladder-quiet-until! l (+ ((rate-ladder-clock l)) (rate-ladder-quiet-ms l))))

305

306 ;;; Record one pull: MS spent producing FRAMES frames at the ladder's

307 ;;; current rate. Answers #t if it was measured, #f if refused (inside a

308 ;;; skip or a quiet window, the window already full and waiting for

309 ;;; rate-ladder-step!, or no frames).

310 (define (rate-ladder-record! l ms frames)

311 (let ((now ((rate-ladder-clock l))))

312 (cond ((or (not (number? frames)) (<= frames 0)) #f)

313 ((> (rate-ladder-skip-left l) 0)

314 (set-rate-ladder-skip-left! l (- (rate-ladder-skip-left l) 1))

315 #f)

316 ((< now (rate-ladder-quiet-until l)) #f)

317 ((>= (rate-ladder-count l) (rate-ladder-window l)) #f)

318 (else

319 ;; ms per frame-rate frame: the frames one display frame needs

320 ;; at this rate, at this pull's cost per frame

321 (vector-set! (rate-ladder-samples l) (rate-ladder-count l)

322 (/ (* 1.0 ms (rate-ladder-rate l))

323 (* frames (rate-ladder-frame-rate l))))

324 (set-rate-ladder-count! l (+ (rate-ladder-count l) 1))

325 #t))))

326

327 ;;; Call THUNK (the producer's pull of FRAMES frames), timing it with the

328 ;;; ladder's clock, record the pull, and answer THUNK's result.

329 (define (rate-ladder-measure l frames thunk)

330 (let* ((t0 ((rate-ladder-clock l)))

331 (result (thunk)))

332 (rate-ladder-record! l (- ((rate-ladder-clock l)) t0) frames)

333 result))

334

335 ;;; Measured pulls in the current window.

336 (define (rate-ladder-pulls l) (rate-ladder-count l))

337

338 (define (median v n)

339 (let* ((s (list-sort < (let loop ((i (- n 1)) (acc '()))

340 (if (< i 0) acc (loop (- i 1) (cons (vector-ref v i) acc))))))

341 (half (/ (- n (modulo n 2)) 2)))

342 (if (even? n)

343 (/ (+ (list-ref s (- half 1)) (list-ref s half)) 2.0)

344 (list-ref s half))))

345

346 (define (rung-below l rate)

347 (let loop ((rs (rate-ladder-rungs l)))

348 (cond ((null? rs) #f)

349 ((< (car rs) rate) (car rs))

350 (else (loop (cdr rs))))))

351

352 ;;; Once a frame. When the window is full, decide on its median: over

353 ;;; budget, with a rung below and no pin, step down and answer the new

354 ;;; rate (the producer should reopen at it; the next `skip` pulls are

355 ;;; refused, and the remember procedure is called). Otherwise answer #f.

356 ;;; The rate never goes up here.

357 (define (rate-ladder-step! l)

358 (if (< (rate-ladder-count l) (rate-ladder-window l))

359 #f

360 (let ((cost (median (rate-ladder-samples l) (rate-ladder-window l)))

361 (next (rung-below l (rate-ladder-rate l))))

362 (set-rate-ladder-last-cost! l cost)

363 (clear-window! l)

364 (if (and (not (rate-ladder-pinned l))

365 (> cost (rate-ladder-budget l))

366 next)

367 (let ((secs (/ (round (/ (- ((rate-ladder-clock l)) (rate-ladder-boot-ms l)) 100)) 10.0)))

368 (set-rate-ladder-rate! l next)

369 (set-rate-ladder-reason! l (cons 'ladder secs))

370 (set-rate-ladder-skip-left! l (rate-ladder-skip l))

371 (when (rate-ladder-remember l)

372 ((rate-ladder-remember l) (rate-ladder-remembered l)))

373 next)

374 #f))))))