Commitf9e54e5aRecorded24 Sep 2026Repositorysigil-audio

(sigil audio ladder): step a producer's render rate down when it cannot keep up

Message

Crash the Stack's rate ladder, lifted out so every game gets it. The game declares rungs, a budget and a floor, times each pull of its producer, and asks once a frame whether to step. The rules that phone measurements taught are built in: the median of 60 measured pulls decides, never one pull; pulls within 150 ms of a cue and the 30 after an open or a step are not measured; the rate only goes down (a pin is the one way up); and a remembered rate carries the buffering it was measured under, so a restore under different buffering is ignored. The reason for the current rate reads as DEVICE, STORED, HINT, PIN or LADDER@<seconds>S for a readout.

Changed
 src/sigil/audio/ladder.sgl | 354 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 test/test-ladder.sgl       | 218 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 572 insertions(+)
Diff
src/sigil/audio/ladder.sgladded
@@ -0,0 +1,354 @@
+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 can raise the rate.
+52
;;; - **A stored rate is a measurement under one buffering.** The rung a
+53
;;; device lands on is not a property of the device alone: the same phone
+54
;;; settled at 24000 with a 256 ms ring and at 32000, 3 s sooner, with a
+55
;;; 320 ms ring, because a ring that is not repeatedly drained gives a
+56
;;; calmer median. So what the ladder asks you to remember carries a `key:`
+57
;;; (describe the buffering: "ring 12288"), and `rate-ladder-restore!`
+58
;;; ignores a stored rate whose key differs.
+59
;;;
+60
;;; ## Reasons, for a readout
+61
;;;
+62
;;; `rate-ladder-reason` answers why the rate is what it is: `device` (the
+63
;;; device's own rate), `stored` (restored from a previous boot), `hint` (the
+64
;;; game started low, e.g. from the page's cores/memory hints), `pin` (a test
+65
;;; or a player's setting pinned it; the ladder does not step), or
+66
;;; `(ladder . seconds)` (the ladder stepped, that many seconds after the
+67
;;; ladder was made). `rate-ladder-reason-string` and `rate-ladder-report`
+68
;;; spell it the way a one-line readout wants it.
+69
+70
(define-library (sigil audio ladder)
+71
(import (sigil core)
+72
(sigil math)
+73
(sigil struct)
+74
(sigil list)
+75
(sigil string))
+76
+77
(export make-rate-ladder
+78
rate-ladder?
+79
rate-ladder-rate
+80
rate-ladder-device-rate
+81
rate-ladder-rungs
+82
rate-ladder-budget
+83
rate-ladder-set-budget!
+84
rate-ladder-reason
+85
rate-ladder-reason-string
+86
rate-ladder-report
+87
rate-ladder-pinned?
+88
rate-ladder-pin!
+89
rate-ladder-unpin!
+90
rate-ladder-hint!
+91
rate-ladder-restore!
+92
rate-ladder-remembered
+93
rate-ladder-opened!
+94
rate-ladder-quiet!
+95
rate-ladder-record!
+96
rate-ladder-measure
+97
rate-ladder-step!
+98
rate-ladder-pulls
+99
rate-ladder-last-cost) ; the median cost per frame (ms) of the last window decided, or #f
+100
+101
(begin
+102
(define-struct rate-ladder
+103
(device-rate)
+104
(rungs) ; below the device's rate, at or above the floor, descending
+105
(budget mutable: #t) ; ms per frame the producer may spend, steady
+106
(window) ; measured pulls a decision takes
+107
(skip) ; pulls refused after an open or a step
+108
(quiet-ms) ; ms refused after a cue
+109
(frame-rate) ; the frames per second the budget is per
+110
(clock) ; () -> ms
+111
(remember) ; (string) -> any, or #f: called after a step
+112
(key) ; the buffering a remembered rate was measured under
+113
(boot-ms)
+114
(rate mutable: #t)
+115
(reason mutable: #t)
+116
(pinned mutable: #t)
+117
(samples) ; the window: per-frame costs, ms
+118
(count mutable: #t) ; measured pulls in the window
+119
(skip-left mutable: #t)
+120
(quiet-until mutable: #t)
+121
(last-cost mutable: #t)) ; the median of the last window decided, ms per frame, or #f
+122
+123
;;; Make a ladder for a producer on a device running at DEVICE-RATE Hz.
+124
;;;
+125
;;; Keywords:
+126
;;; rungs: the rates below the device's to step through, in any
+127
;;; order (default '(32000 24000 22050)). Rungs at or above
+128
;;; the device's rate are dropped.
+129
;;; floor: the lowest rate the ladder may reach (default #f: the
+130
;;; lowest rung). A judgement about your weakest device.
+131
;;; budget-ms: the steady cost per frame the producer may spend, ms
+132
;;; (default 4.0)
+133
;;; frame-rate: the frames per second that budget is per (default 60)
+134
;;; window: measured pulls per decision (default 60)
+135
;;; skip: pulls refused after an open or a step (default 30)
+136
;;; quiet-ms: ms refused after rate-ladder-quiet! (default 150)
+137
;;; remember: a procedure given rate-ladder-remembered's string after
+138
;;; each step (a store for the next boot), or #f
+139
;;; key: the buffering the rate is measured under, as a string
+140
;;; (default ""), e.g. "ring 16384"
+141
;;; clock: a procedure answering the time in ms (default
+142
;;; current-milliseconds; a test passes its own)
+143
(define (make-rate-ladder device-rate
+144
(keys: (rungs '(32000 24000 22050))
+145
(floor #f)
+146
(budget-ms 4.0)
+147
(frame-rate 60)
+148
(window 60)
+149
(skip 30)
+150
(quiet-ms 150)
+151
(remember #f)
+152
(key "")
+153
(clock current-milliseconds)))
+154
(let* ((low (or floor 0))
+155
(rs (list-sort > (filter (lambda (r) (and (< r device-rate) (>= r low))) rungs)))
+156
(now (clock)))
+157
(rate-ladder device-rate: device-rate
+158
rungs: rs
+159
budget: (* 1.0 budget-ms)
+160
window: (max 1 window)
+161
skip: (max 0 skip)
+162
quiet-ms: quiet-ms
+163
frame-rate: frame-rate
+164
clock: clock
+165
remember: remember
+166
key: key
+167
boot-ms: now
+168
rate: device-rate
+169
reason: 'device
+170
pinned: #f
+171
samples: (make-vector (max 1 window) 0.0)
+172
count: 0
+173
skip-left: (max 0 skip)
+174
quiet-until: now
+175
last-cost: #f)))
+176
+177
;;; The budget, ms per frame. A test arm lowers it to force the ladder.
+178
(define (rate-ladder-set-budget! l ms)
+179
(when (and (number? ms) (> ms 0))
+180
(set-rate-ladder-budget! l (* 1.0 ms))))
+181
+182
(define (clear-window! l)
+183
(set-rate-ladder-count! l 0))
+184
+185
;; ---------------------------------------------------------------------
+186
;; Reasons
+187
;; ---------------------------------------------------------------------
+188
+189
;;; Why the rate is what it is, for a readout: "DEVICE", "STORED", "HINT",
+190
;;; "PIN" or "LADDER@<seconds>S".
+191
(define (rate-ladder-reason-string l)
+192
(let ((r (rate-ladder-reason l)))
+193
(cond ((pair? r) (string-append "LADDER@" (number->string (cdr r)) "S"))
+194
((eq? r 'stored) "STORED")
+195
((eq? r 'hint) "HINT")
+196
((eq? r 'pin) "PIN")
+197
(else "DEVICE"))))
+198
+199
;;; "<device-rate>/<rate> BY <reason>", e.g. "48000/24000 BY LADDER@20.2S".
+200
(define (rate-ladder-report l)
+201
(string-append (number->string (rate-ladder-device-rate l)) "/"
+202
(number->string (rate-ladder-rate l)) " BY "
+203
(rate-ladder-reason-string l)))
+204
+205
(define (rate-ladder-pinned? l) (and (rate-ladder-pinned l) #t))
+206
+207
;; ---------------------------------------------------------------------
+208
;; Starting rates: pin, hint, stored
+209
;; ---------------------------------------------------------------------
+210
+211
;;; Pin the rate (clamped to the device's): the ladder stops stepping and
+212
;;; reports PIN. A pin is the only way the rate goes up.
+213
(define (rate-ladder-pin! l rate)
+214
(set-rate-ladder-rate! l (max 1 (min rate (rate-ladder-device-rate l))))
+215
(set-rate-ladder-pinned! l #t)
+216
(set-rate-ladder-reason! l 'pin)
+217
(clear-window! l)
+218
(rate-ladder-rate l))
+219
+220
;;; Lift a pin: back to the device's rate, and the ladder runs again.
+221
(define (rate-ladder-unpin! l)
+222
(set-rate-ladder-pinned! l #f)
+223
(set-rate-ladder-rate! l (rate-ladder-device-rate l))
+224
(set-rate-ladder-reason! l 'device)
+225
(clear-window! l)
+226
(rate-ladder-rate l))
+227
+228
;;; Start low on a device the game already believes is weak (the page's
+229
;;; cores/memory hints). Applies only while the ladder is unpinned and
+230
;;; still at the device's rate, and only downward. Answers #t if applied.
+231
(define (rate-ladder-hint! l rate)
+232
(if (and (not (rate-ladder-pinned l))
+233
(eq? (rate-ladder-reason l) 'device)
+234
(< rate (rate-ladder-device-rate l))
+235
(> rate 0))
+236
(begin
+237
(set-rate-ladder-rate! l rate)
+238
(set-rate-ladder-reason! l 'hint)
+239
(clear-window! l)
+240
#t)
+241
#f))
+242
+243
;;; The string to keep for the next boot: "<rate> <key>".
+244
(define (rate-ladder-remembered l)
+245
(string-append (number->string (rate-ladder-rate l)) " " (rate-ladder-key l)))
+246
+247
;;; Restore a rate a previous boot remembered (rate-ladder-remembered's
+248
;;; string). Ignored, answering #f, when the ladder is pinned, the string
+249
;;; does not read, it was measured under a different key, or it is not
+250
;;; below the rate in force (a restore never raises the rate). Answers the
+251
;;; restored rate otherwise.
+252
(define (rate-ladder-restore! l stored)
+253
(let* ((sp (and (string? stored) (string-index stored (lambda (c) (char=? c #\space)))))
+254
(rate (and sp (string->number (substring stored 0 sp))))
+255
(key (and sp (substring stored (+ sp 1) (string-length stored)))))
+256
(if (and rate key
+257
(integer? rate)
+258
(> rate 0)
+259
(not (rate-ladder-pinned l))
+260
(equal? key (rate-ladder-key l))
+261
(< rate (rate-ladder-rate l)))
+262
(begin
+263
(set-rate-ladder-rate! l rate)
+264
(set-rate-ladder-reason! l 'stored)
+265
(clear-window! l)
+266
rate)
+267
#f)))
+268
+269
;; ---------------------------------------------------------------------
+270
;; Measuring
+271
;; ---------------------------------------------------------------------
+272
+273
;;; The producer (re)opened: its first pulls carry the open's own work, so
+274
;;; the next `skip` pulls and the next `quiet-ms` are not measured, and the
+275
;;; window starts over.
+276
(define (rate-ladder-opened! l)
+277
(clear-window! l)
+278
(set-rate-ladder-skip-left! l (rate-ladder-skip l))
+279
(rate-ladder-quiet! l))
+280
+281
;;; A cue (a tap's sound, an effect) just played: the pulls in the next
+282
;;; `quiet-ms` share a frame with its drawing and are not measured.
+283
(define (rate-ladder-quiet! l)
+284
(set-rate-ladder-quiet-until! l (+ ((rate-ladder-clock l)) (rate-ladder-quiet-ms l))))
+285
+286
;;; Record one pull: MS spent producing FRAMES frames at the ladder's
+287
;;; current rate. Answers #t if it was measured, #f if refused (inside a
+288
;;; skip or a quiet window, the window already full and waiting for
+289
;;; rate-ladder-step!, or no frames).
+290
(define (rate-ladder-record! l ms frames)
+291
(let ((now ((rate-ladder-clock l))))
+292
(cond ((or (not (number? frames)) (<= frames 0)) #f)
+293
((> (rate-ladder-skip-left l) 0)
+294
(set-rate-ladder-skip-left! l (- (rate-ladder-skip-left l) 1))
+295
#f)
+296
((< now (rate-ladder-quiet-until l)) #f)
+297
((>= (rate-ladder-count l) (rate-ladder-window l)) #f)
+298
(else
+299
;; ms per frame-rate frame: the frames one display frame needs
+300
;; at this rate, at this pull's cost per frame
+301
(vector-set! (rate-ladder-samples l) (rate-ladder-count l)
+302
(/ (* 1.0 ms (rate-ladder-rate l))
+303
(* frames (rate-ladder-frame-rate l))))
+304
(set-rate-ladder-count! l (+ (rate-ladder-count l) 1))
+305
#t))))
+306
+307
;;; Call THUNK (the producer's pull of FRAMES frames), timing it with the
+308
;;; ladder's clock, record the pull, and answer THUNK's result.
+309
(define (rate-ladder-measure l frames thunk)
+310
(let* ((t0 ((rate-ladder-clock l)))
+311
(result (thunk)))
+312
(rate-ladder-record! l (- ((rate-ladder-clock l)) t0) frames)
+313
result))
+314
+315
;;; Measured pulls in the current window.
+316
(define (rate-ladder-pulls l) (rate-ladder-count l))
+317
+318
(define (median v n)
+319
(let* ((s (list-sort < (let loop ((i (- n 1)) (acc '()))
+320
(if (< i 0) acc (loop (- i 1) (cons (vector-ref v i) acc))))))
+321
(half (/ (- n (modulo n 2)) 2)))
+322
(if (even? n)
+323
(/ (+ (list-ref s (- half 1)) (list-ref s half)) 2.0)
+324
(list-ref s half))))
+325
+326
(define (rung-below l rate)
+327
(let loop ((rs (rate-ladder-rungs l)))
+328
(cond ((null? rs) #f)
+329
((< (car rs) rate) (car rs))
+330
(else (loop (cdr rs))))))
+331
+332
;;; Once a frame. When the window is full, decide on its median: over
+333
;;; budget, with a rung below and no pin, step down and answer the new
+334
;;; rate (the producer should reopen at it; the next `skip` pulls are
+335
;;; refused, and the remember procedure is called). Otherwise answer #f.
+336
;;; The rate never goes up here.
+337
(define (rate-ladder-step! l)
+338
(if (< (rate-ladder-count l) (rate-ladder-window l))
+339
#f
+340
(let ((cost (median (rate-ladder-samples l) (rate-ladder-window l)))
+341
(next (rung-below l (rate-ladder-rate l))))
+342
(set-rate-ladder-last-cost! l cost)
+343
(clear-window! l)
+344
(if (and (not (rate-ladder-pinned l))
+345
(> cost (rate-ladder-budget l))
+346
next)
+347
(let ((secs (/ (round (/ (- ((rate-ladder-clock l)) (rate-ladder-boot-ms l)) 100)) 10.0)))
+348
(set-rate-ladder-rate! l next)
+349
(set-rate-ladder-reason! l (cons 'ladder secs))
+350
(set-rate-ladder-skip-left! l (rate-ladder-skip l))
+351
(when (rate-ladder-remember l)
+352
((rate-ladder-remember l) (rate-ladder-remembered l)))
+353
next)
+354
#f))))))
test/test-ladder.sgladded
@@ -0,0 +1,218 @@
+1
;;; Tests for (sigil audio ladder)
+2
;;;
+3
;;; A fake clock drives every test: a pull "costs" what the test says, so a
+4
;;; slow producer is forced rather than hoped for. Budget 4 ms per 60 fps
+5
;;; frame; at 48000 a frame is 800 frames of audio, so a pull of 800 frames
+6
;;; costing 8 ms is twice the budget.
+7
+8
(import (sigil test)
+9
(sigil math)
+10
(sigil audio ladder))
+11
+12
(define now 0)
+13
(define (clock) now)
+14
(define (advance! ms) (set! now (+ now ms)))
+15
+16
(define (ladder . extra)
+17
(set! now 0)
+18
(apply make-rate-ladder 48000 clock: clock budget-ms: 4.0 floor: 22050 extra))
+19
+20
;; Pull n times at `rate`, each pull 800 device-rate-frame-equivalents costing
+21
;; `per-frame` ms per 60 fps frame, 16 ms apart. Answers the pulls measured.
+22
(define (pulls! l n per-frame)
+23
(let loop ((i 0) (measured 0))
+24
(if (>= i n)
+25
measured
+26
(let* ((rate (rate-ladder-rate l))
+27
(frames (/ rate 60))
+28
(ok (rate-ladder-record! l per-frame frames)))
+29
(advance! 16)
+30
(loop (+ i 1) (if ok (+ measured 1) measured))))))
+31
+32
;; One window after the skip: 30 skipped pulls, then 60 measured, then a step.
+33
(define (window! l per-frame)
+34
(pulls! l 90 per-frame)
+35
(rate-ladder-step! l))
+36
+37
(test-group "starting state"
+38
(test "starts at the device's rate, for the device's reason"
+39
(let ((l (ladder)))
+40
(assert-equal 48000 (rate-ladder-rate l))
+41
(assert-equal 'device (rate-ladder-reason l))
+42
(assert-equal "48000/48000 BY DEVICE" (rate-ladder-report l))))
+43
+44
(test "rungs at or above the device's rate, or below the floor, are dropped"
+45
(let ((l (make-rate-ladder 44100 rungs: '(48000 44100 32000 16000 24000) floor: 22050 clock: clock)))
+46
(assert-equal '(32000 24000) (rate-ladder-rungs l)))))
+47
+48
(test-group "a slow producer steps down, never up"
+49
(test "twice over budget: 48000 -> 32000 -> 24000 -> 22050, then the floor holds"
+50
(let* ((l (ladder))
+51
(steps (list (window! l 8.0) (window! l 8.0) (window! l 8.0) (window! l 8.0) (window! l 8.0))))
+52
(assert-equal '(32000 24000 22050 #f #f) steps)
+53
(assert-equal 22050 (rate-ladder-rate l))
+54
(assert-true (pair? (rate-ladder-reason l)))
+55
(assert-equal 'ladder (car (rate-ladder-reason l)))))
+56
+57
(test "a producer that turns fast after a step does not raise the rate"
+58
(let ((l (ladder)))
+59
(assert-equal 32000 (window! l 8.0))
+60
(assert-equal 24000 (window! l 8.0))
+61
;; now ten windows at a tenth of the budget
+62
(let loop ((i 0) (stepped '()))
+63
(if (< i 10)
+64
(loop (+ i 1) (cons (window! l 0.4) stepped))
+65
(begin
+66
(assert-equal '(#f #f #f #f #f #f #f #f #f #f) stepped)
+67
(assert-equal 24000 (rate-ladder-rate l)))))))
+68
+69
(test "under budget, nothing steps and the cost is reported"
+70
(let ((l (ladder)))
+71
(assert-false (window! l 3.9))
+72
(assert-equal 48000 (rate-ladder-rate l))
+73
(assert-true (< (abs (- (rate-ladder-last-cost l) 3.9)) 1e-9))))
+74
+75
(test "the reason names the second the step happened"
+76
(let ((l (ladder)))
+77
(window! l 8.0)
+78
;; 90 pulls 16 ms apart: the step is decided at 1440 ms
+79
(assert-equal '(ladder . 1.4) (rate-ladder-reason l))
+80
(assert-equal "48000/32000 BY LADDER@1.4S" (rate-ladder-report l)))))
+81
+82
(test-group "the median decides, never one pull"
+83
(test "59 steady pulls and one hostile one: no step, though the mean is over budget"
+84
(let ((l (ladder)))
+85
(pulls! l 30 2.0) ; the skip
+86
(pulls! l 59 2.0)
+87
(pulls! l 1 400.0) ; a tap's frame that slipped the quiet rule
+88
;; the mean of that window is (59*2 + 400)/60 = 8.6 ms: twice the budget
+89
(assert-true (> (/ (+ (* 59 2.0) 400.0) 60) 4.0))
+90
(assert-false (rate-ladder-step! l))
+91
(assert-equal 48000 (rate-ladder-rate l))
+92
(assert-equal 2.0 (rate-ladder-last-cost l)))))
+93
+94
(test-group "refused pulls"
+95
(test "the first 30 pulls after making the ladder are skipped"
+96
(let ((l (ladder)))
+97
(assert-equal 0 (pulls! l 30 8.0))
+98
(assert-equal 60 (pulls! l 60 8.0))))
+99
+100
(test "pulls within 150 ms of a cue are not measured"
+101
(let ((l (ladder)))
+102
(pulls! l 30 1.0)
+103
(rate-ladder-quiet! l)
+104
;; 16 ms apart: pulls at +0 .. +144 are inside the quiet window (10 of them)
+105
(assert-equal 0 (pulls! l 10 50.0))
+106
(assert-equal 5 (pulls! l 5 1.0))
+107
(assert-equal 5 (rate-ladder-pulls l))))
+108
+109
(test "a burst of cues never lets a slow tap's frame decide"
+110
(let ((l (ladder)))
+111
(pulls! l 30 1.0)
+112
;; every 10th pull is a tap: quiet, then a hostile 100 ms pull in its frame
+113
(let loop ((i 0))
+114
(when (< i 60)
+115
(rate-ladder-quiet! l)
+116
(rate-ladder-record! l 100.0 800)
+117
(advance! 200)
+118
(pulls! l 9 1.0)
+119
(loop (+ i 1))))
+120
(assert-false (rate-ladder-step! l))
+121
(assert-equal 1.0 (rate-ladder-last-cost l))))
+122
+123
(test "an open refuses the next 30 pulls and restarts the window"
+124
(let ((l (ladder)))
+125
(pulls! l 30 1.0)
+126
(pulls! l 40 1.0)
+127
(assert-equal 40 (rate-ladder-pulls l))
+128
(rate-ladder-opened! l)
+129
(advance! 200)
+130
(assert-equal 0 (rate-ladder-pulls l))
+131
(assert-equal 0 (pulls! l 30 1.0))
+132
(assert-equal 1 (pulls! l 1 1.0))))
+133
+134
(test "a step refuses the next 30 pulls (the producer reopens)"
+135
(let ((l (ladder)))
+136
(assert-equal 32000 (window! l 8.0))
+137
(assert-equal 0 (pulls! l 30 8.0))
+138
(assert-equal 1 (pulls! l 1 8.0))))
+139
+140
(test "a full window refuses pulls until the step reads it"
+141
(let ((l (ladder)))
+142
(pulls! l 30 1.0)
+143
(assert-equal 60 (pulls! l 70 1.0))
+144
(assert-false (rate-ladder-step! l))
+145
(assert-equal 1 (pulls! l 1 1.0))))
+146
+147
(test "a pull of no frames is refused"
+148
(let ((l (ladder skip: 0)))
+149
(assert-false (rate-ladder-record! l 1.0 0)))))
+150
+151
(test-group "measuring"
+152
(test "rate-ladder-measure times the thunk and answers its value"
+153
(let ((l (ladder skip: 0)))
+154
(advance! 1000)
+155
(assert-equal 'pulled (rate-ladder-measure l 800 (lambda () (advance! 3) 'pulled)))
+156
(assert-equal 1 (rate-ladder-pulls l))))
+157
+158
(test "the cost is per 60 fps frame at the ladder's rate"
+159
(let ((l (ladder skip: 0 window: 1)))
+160
(advance! 1000)
+161
;; 1600 frames at 48000 in 8 ms: a 60 fps frame (800 frames) costs 4 ms
+162
(rate-ladder-record! l 8.0 1600)
+163
(rate-ladder-step! l)
+164
(assert-equal 4.0 (rate-ladder-last-cost l)))))
+165
+166
(test-group "pin, hint and stored"
+167
(test "a pinned ladder never steps, however slow"
+168
(let ((l (ladder)))
+169
(rate-ladder-pin! l 48000)
+170
(assert-false (window! l 50.0))
+171
(assert-equal "48000/48000 BY PIN" (rate-ladder-report l))))
+172
+173
(test "unpin returns to the device's rate and the ladder runs"
+174
(let ((l (ladder)))
+175
(rate-ladder-pin! l 24000)
+176
(rate-ladder-unpin! l)
+177
(assert-equal 48000 (rate-ladder-rate l))
+178
(assert-equal 32000 (window! l 8.0))))
+179
+180
(test "a hint starts lower; it does not apply over a pin or after a step"
+181
(let ((l (ladder)))
+182
(assert-true (rate-ladder-hint! l 24000))
+183
(assert-equal "48000/24000 BY HINT" (rate-ladder-report l))
+184
(assert-equal 22050 (window! l 8.0)))
+185
(let ((l (ladder)))
+186
(rate-ladder-pin! l 32000)
+187
(assert-false (rate-ladder-hint! l 24000))
+188
(assert-equal 32000 (rate-ladder-rate l)))
+189
(let ((l (ladder)))
+190
(window! l 8.0)
+191
(assert-false (rate-ladder-hint! l 24000))))
+192
+193
(test "a step hands the remember procedure the rate and the key"
+194
(let* ((kept #f)
+195
(l (ladder key: "ring 12288" remember: (lambda (s) (set! kept s)))))
+196
(window! l 8.0)
+197
(assert-equal "32000 ring 12288" kept)))
+198
+199
(test "a stored rate is restored under the same buffering key"
+200
(let ((l (ladder key: "ring 12288")))
+201
(assert-equal 24000 (rate-ladder-restore! l "24000 ring 12288"))
+202
(assert-equal "48000/24000 BY STORED" (rate-ladder-report l))))
+203
+204
(test "a stored rate measured under another buffering is ignored"
+205
(let ((l (ladder key: "ring 15360")))
+206
(assert-false (rate-ladder-restore! l "24000 ring 12288"))
+207
(assert-equal 48000 (rate-ladder-rate l))
+208
(assert-equal 'device (rate-ladder-reason l))))
+209
+210
(test "a restore never raises the rate, and a garbled string is ignored"
+211
(let ((l (ladder key: "k")))
+212
(window! l 8.0)
+213
(window! l 8.0)
+214
(assert-false (rate-ladder-restore! l "32000 k"))
+215
(assert-equal 24000 (rate-ladder-rate l))
+216
(assert-false (rate-ladder-restore! l "fast k"))
+217
(assert-false (rate-ladder-restore! l "22050"))
+218
(assert-false (rate-ladder-restore! l #f)))))