A3: the sound of the gate and the creatures

Message

Finding tones are placed from the world's pickups, one per unfound harmonic; a mute ring-stone hums its harmonic's note; the world's news plays as cues (the pickup's rising partials, the stone's ring, the near miss, the stone sinking, the creatures' calls, silent during a moment). Every region's bed takes the carry through one function, so H2 sounds in every bed once carried. Each voice opening is its own mixer source, and a gate cue not yet rendered plays late, not never.

Changed

 assets/tunes/chirp-a.cts                            |  11 +++++
 assets/tunes/chirp-b.cts                            |  14 ++++++
 assets/tunes/croak-a.cts                            |  10 +++++
 assets/tunes/croak-b.cts                            |  10 +++++
 assets/tunes/croak-h2.cts                           |  10 +++++
 assets/tunes/flurry.cts                             |  15 +++++++
 assets/tunes/miss-h2.cts                            |  10 +++++
 assets/tunes/moth-a.cts                             |   9 ++++
 assets/tunes/moth-b.cts                             |   9 ++++
 assets/tunes/moth-h2.cts                            |  10 +++++
 assets/tunes/pickup-h2.cts                          |  14 ++++++
 assets/tunes/ring-h2.cts                            |  12 +++++
 assets/tunes/song-h2.cts                            |  18 ++++++++
 assets/tunes/stone-slide.cts                        |  10 +++++
 src/harkfell/audio.sgl                              |  45 +++++++++++++++++--
 src/harkfell/sound.sgl                              | 341 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++---------------------------
 test/fixtures/worlds/two/regions/testfen.map        |   7 +++
 test/fixtures/worlds/two/regions/testhollow.map     |   7 +++
 test/fixtures/worlds/two/rooms/testfen/x0y0.room    |  19 ++++++++
 test/fixtures/worlds/two/rooms/testhollow/x2y0.room |  18 ++++++++
 test/fixtures/worlds/two/world.sgl                  |  29 ++++++++++++
 test/test-place.sgl                                 |  63 ++++++++++++++++++++------
 test/test-regions.sgl                               | 111 ++++++++++++++++++++++++++++++++++++++++++++++
 test/test-tunes.sgl                                 |  29 ++++++++++++
 24 files changed, 749 insertions(+), 82 deletions(-)

Diff

assets/tunes/chirp-a.ctsadded

@@ -0,0 +1,11 @@

(tune version: 1 name: "chirp-a" tempo: 120 speed: 2 channels: 1

(bus reverb: zitarev size: 0.6 damp: 0.4 mix: 0.25)

(instruments

    (instrument id: 1 name: "reedling" patch: (flute-wind attack: 0.008 decay: 0.05 sustain: 0.5 release: 0.05 noise-amp: 0.08) volume: 30 send: 0.3))

(patterns

(pattern id: 0 rows: 8

(row 0 (1 "G-6" 1 28 "000"))

(row 1 (1 "B-6" 1 30 "000"))

(row 2 (1 "===" 0 0 "000"))))

+10

(order 0)

+11

(history ("claude" "2026-09-24" "A3 call: a reedling's tsip, two quick notes up")))

assets/tunes/chirp-b.ctsadded

@@ -0,0 +1,14 @@

(tune version: 1 name: "chirp-b" tempo: 120 speed: 2 channels: 1

(bus reverb: zitarev size: 0.6 damp: 0.4 mix: 0.25)

(instruments

    (instrument id: 1 name: "reedling" patch: (flute-wind attack: 0.008 decay: 0.05 sustain: 0.5 release: 0.05 noise-amp: 0.08) volume: 30 send: 0.3))

(patterns

(pattern id: 0 rows: 8

(row 0 (1 "C-7" 1 26 "000"))

(row 1 (1 "===" 0 0 "000"))

(row 2 (1 "A-6" 1 28 "000"))

+10

(row 3 (1 "===" 0 0 "000"))

+11

(row 4 (1 "A-6" 1 22 "000"))

+12

(row 5 (1 "===" 0 0 "000"))))

+13

(order 0)

+14

(history ("claude" "2026-09-24" "A3 call: a reedling's three-note twitter, falling")))

assets/tunes/croak-a.ctsadded

@@ -0,0 +1,10 @@

(tune version: 1 name: "croak-a" tempo: 120 speed: 3 channels: 1

(bus reverb: zitarev size: 0.5 damp: 0.5 mix: 0.2)

(instruments

(instrument id: 1 name: "bellfrog" patch: (karplus-strong decay: 0.9 excite-gain: 0.6) volume: 40 send: 0.3))

(patterns

(pattern id: 0 rows: 12

(row 0 (1 "F-3" 1 40 "000"))

(row 3 (1 "C-3" 1 34 "000"))))

(order 0)

+10

(history ("claude" "2026-09-24" "A3 call: a bellfrog's two-note croak, falling a fourth (off the harmonic)")))

assets/tunes/croak-b.ctsadded

@@ -0,0 +1,10 @@

(tune version: 1 name: "croak-b" tempo: 120 speed: 3 channels: 1

(bus reverb: zitarev size: 0.5 damp: 0.5 mix: 0.2)

(instruments

(instrument id: 1 name: "bellfrog" patch: (karplus-strong decay: 0.9 excite-gain: 0.6) volume: 40 send: 0.3))

(patterns

(pattern id: 0 rows: 12

(row 0 (1 "E-3" 1 38 "000"))

(row 3 (1 "B-2" 1 34 "000"))))

(order 0)

+10

(history ("claude" "2026-09-24" "A3 call: a second bellfrog voice, a step lower")))

assets/tunes/croak-h2.ctsadded

@@ -0,0 +1,10 @@

(tune version: 1 name: "croak-h2" tempo: 120 speed: 3 channels: 1

(bus reverb: zitarev size: 0.5 damp: 0.5 mix: 0.2)

(instruments

(instrument id: 1 name: "bellfrog" patch: (karplus-strong decay: 0.9 excite-gain: 0.6) volume: 40 send: 0.3))

(patterns

(pattern id: 0 rows: 12

(row 0 (1 "A-3" 1 40 "000"))

(row 3 (1 "D-3" 1 34 "000"))))

(order 0)

+10

  (history ("claude" "2026-09-24" "A3 call: carrying H2, the bellfrogs croak in its key, A3 down to D3 (A2's spot-frog)")))

assets/tunes/flurry.ctsadded

@@ -0,0 +1,15 @@

(tune version: 1 name: "flurry" tempo: 120 speed: 2 channels: 2

(bus reverb: zitarev size: 0.6 damp: 0.5 mix: 0.2)

(instruments

    (instrument id: 1 name: "wings" patch: (noise-bed color: pink level: 0.7 centre: 2600 width: 1.6 wander: 0.2 rate: 2.0 trem: 0.9 trem-rate: 22.0 attack: 0.02 release: 0.25 seed: 11) volume: 34 send: 0.15)

    (instrument id: 2 name: "reedling" patch: (flute-wind attack: 0.008 decay: 0.05 sustain: 0.5 release: 0.05 noise-amp: 0.08) volume: 26 send: 0.3))

(patterns

(pattern id: 0 rows: 16

(row 0 (1 "D-4" 1 34 "000") (2 "B-6" 2 26 "000"))

(row 1 (2 "===" 0 0 "000"))

+10

(row 3 (2 "G-6" 2 24 "000"))

+11

(row 4 (2 "===" 0 0 "000"))

+12

(row 6 (1 "===" 0 0 "000") (2 "C-7" 2 20 "000"))

+13

(row 7 (2 "===" 0 0 "000"))))

+14

(order 0)

+15

(history ("claude" "2026-09-24" "A3 call: a reedling flock lifts off: a burst of wings and alarm chirps")))

assets/tunes/miss-h2.ctsadded

@@ -0,0 +1,10 @@

(tune version: 1 name: "miss-h2" tempo: 120 speed: 3 channels: 2

(bus reverb: zitarev size: 0.6 damp: 0.6 mix: 0.25)

(instruments

    (instrument id: 1 name: "ring-stone, off-key" patch: (bell fm-index: 1.4 fm-mod: 1.41 attack: 0.02 decay: 0.7 sustain: 0.0 release: 0.3) volume: 34 send: 0.3))

(patterns

(pattern id: 0 rows: 8

(row 0 (1 "D-3" 1 34 "000"))

(row 1 (2 "D#3" 1 30 "000"))))

(order 0)

+10

  (history ("claude" "2026-09-24" "A3 cue: the near miss: the stone's D3 against a semitone above it, beating, a moment, then silent")))

assets/tunes/moth-a.ctsadded

@@ -0,0 +1,9 @@

(tune version: 1 name: "moth-a" tempo: 120 speed: 3 channels: 1

(bus reverb: zitarev size: 0.8 damp: 0.3 mix: 0.45)

(instruments

    (instrument id: 1 name: "lantern moth" patch: (bell fm-index: 0.5 fm-mod: 3.0 attack: 0.004 decay: 0.5 sustain: 0.0 release: 0.3) volume: 20 send: 0.6))

(patterns

(pattern id: 0 rows: 8

(row 0 (1 "E-6" 1 20 "000"))))

(order 0)

(history ("claude" "2026-09-24" "A3 call: a lantern moth's glassy tink, idle")))

assets/tunes/moth-b.ctsadded

@@ -0,0 +1,9 @@

(tune version: 1 name: "moth-b" tempo: 120 speed: 3 channels: 1

(bus reverb: zitarev size: 0.8 damp: 0.3 mix: 0.45)

(instruments

    (instrument id: 1 name: "lantern moth" patch: (bell fm-index: 0.5 fm-mod: 3.0 attack: 0.004 decay: 0.5 sustain: 0.0 release: 0.3) volume: 20 send: 0.6))

(patterns

(pattern id: 0 rows: 8

(row 0 (1 "B-5" 1 20 "000"))))

(order 0)

(history ("claude" "2026-09-24" "A3 call: a lantern moth's glassy tink, idle, lower")))

assets/tunes/moth-h2.ctsadded

@@ -0,0 +1,10 @@

(tune version: 1 name: "moth-h2" tempo: 120 speed: 3 channels: 2

(bus reverb: zitarev size: 0.85 damp: 0.3 mix: 0.5)

(instruments

    (instrument id: 1 name: "lantern moth, drawn" patch: (bell fm-index: 0.5 fm-mod: 2.0 attack: 0.004 decay: 0.8 sustain: 0.0 release: 0.4) volume: 22 send: 0.6))

(patterns

(pattern id: 0 rows: 8

(row 0 (1 "D-6" 1 22 "000"))

(row 1 (2 "A-6" 1 16 "000"))))

(order 0)

+10

(history ("claude" "2026-09-24" "A3 call: moths drawn to H2 chime in its partials (D6, A6: 8 and 12 times D2)")))

assets/tunes/pickup-h2.ctsadded

@@ -0,0 +1,14 @@

(tune version: 1 name: "pickup-h2" tempo: 120 speed: 4 channels: 6

(bus reverb: zitarev size: 0.85 damp: 0.45 mix: 0.35)

(instruments

    (instrument id: 1 name: "the harmonic joins you" patch: (bell fm-index: 1.2 fm-mod: 2.0 attack: 0.01 decay: 2.6 sustain: 0.0 release: 1.2) volume: 44 send: 0.5))

(patterns

(pattern id: 0 rows: 24

(row 0 (1 "D-3" 1 44 "000"))

(row 2 (2 "D-4" 1 38 "000"))

(row 4 (3 "A-4" 1 34 "000"))

+10

(row 6 (4 "D-5" 1 30 "000"))

+11

(row 8 (5 "F#5" 1 26 "000"))

+12

(row 10 (6 "A-5" 1 22 "000"))))

+13

(order 0)

+14

  (history ("claude" "2026-09-24" "A3 cue: H2 taken; its own partials rise from D3 (2, 4, 6, 8, 10, 12 times the fundamental)")))

assets/tunes/ring-h2.ctsadded

@@ -0,0 +1,12 @@

(tune version: 1 name: "ring-h2" tempo: 120 speed: 4 channels: 3

(bus reverb: zitarev size: 0.9 damp: 0.5 mix: 0.4)

(instruments

    (instrument id: 1 name: "ring-stone, sounding" patch: (bell fm-index: 0.9 fm-mod: 1.41 attack: 0.25 decay: 4.5 sustain: 0.0 release: 2.0) volume: 50 send: 0.6)

    (instrument id: 2 name: "its partials" patch: (bell fm-index: 0.6 fm-mod: 2.0 attack: 0.6 decay: 3.5 sustain: 0.0 release: 1.5) volume: 34 send: 0.6))

(patterns

(pattern id: 0 rows: 16

(row 0 (1 "D-3" 1 50 "000"))

(row 3 (2 "D-4" 2 34 "000"))

+10

(row 6 (3 "A-4" 2 26 "000"))))

+11

(order 0)

+12

  (history ("claude" "2026-09-24" "A3 cue: a ring-stone keyed to H2 rings in sympathy: D3 swelling, its octave and twelfth after")))

assets/tunes/song-h2.ctsadded

@@ -0,0 +1,18 @@

(tune version: 1 name: "song-h2" tempo: 120 speed: 2 channels: 1

(bus reverb: zitarev size: 0.75 damp: 0.4 mix: 0.3)

(instruments

    (instrument id: 1 name: "reedling, singing back" patch: (flute-wind attack: 0.015 decay: 0.08 sustain: 0.6 release: 0.12 noise-amp: 0.06) volume: 32 send: 0.4))

(patterns

(pattern id: 0 rows: 32

(row 0 (1 "D-5" 1 26 "000"))

(row 3 (1 "===" 0 0 "000"))

(row 4 (1 "A-5" 1 30 "000"))

+10

(row 6 (1 "D-6" 1 32 "000"))

+11

(row 9 (1 "===" 0 0 "000"))

+12

(row 10 (1 "C-6" 1 26 "000"))

+13

(row 12 (1 "A-5" 1 28 "000"))

+14

(row 14 (1 "===" 0 0 "000"))

+15

(row 16 (1 "D-6" 1 30 "000"))

+16

(row 21 (1 "===" 0 0 "000"))))

+17

(order 0)

+18

  (history ("claude" "2026-09-24" "A3 call: reedlings sing back once you carry H2: a phrase on D in Reedfen's Dorian (D A D C A D)")))

assets/tunes/stone-slide.ctsadded

@@ -0,0 +1,10 @@

(tune version: 1 name: "stone-slide" tempo: 120 speed: 4 channels: 1

(bus reverb: zitarev size: 0.6 damp: 0.7 mix: 0.2)

(instruments

    (instrument id: 1 name: "stone sinking" patch: (noise-bed color: brown level: 0.8 centre: 320 width: 1.0 wander: 0.4 rate: 3.0 gust: 0.5 gust-rate: 6.0 attack: 0.08 release: 0.35 seed: 7) volume: 46 send: 0.2))

(patterns

(pattern id: 0 rows: 12

(row 0 (1 "D-3" 1 46 "000"))

(row 8 (1 "===" 0 0 "000"))))

(order 0)

+10

(history ("claude" "2026-09-24" "A3 cue: the ring-stone sinks into the floor: a low stone rumble, under a second")))

src/harkfell/audio.sglmodified

@@ -25,6 +25,7 @@

(harkfell shell)

(harkfell tunes)

(harkfell sound)

+28

(harkfell gates)

(harkfell bench))

(export audio-boot! audio-world! audio-gesture! audio-bench! audio-frame! audio-now

@@ -49,8 +50,13 @@

;; "2,3" -> (2 3)

(define (numbers s) (filter number? (map string->number (string-split s ","))))

−52

(define (audio-carry! s) (sound-set-carry! (numbers s)))

+53

;; ?carry=: the body carries these (the world's, A3; and the sound's,

+54

;; for A0's room, which has no world of gates)

+55

(define (audio-carry! s) (shell-set-carry! (numbers s)) (sound-set-carry! (numbers s)))

+57

;; ?tone= (A2's placeholder door): the finding tones are placed from the

+58

;; world's pickups now; this moves A2's placeholder only, which sounds

+59

;; only where the world has no gates.

(define (audio-tone-room! s)

(let ((n (numbers s)))

(when (= (length n) 2) (sound-set-tone-room! (car n) (cadr n)))))

@@ -81,7 +87,38 @@

;; The place the director needs, from the running world; #f outside the

;; written world (A0's test room, the atlas, the sheet).

−84

(define (world-place w ct)

+90

;; A3: the world's pickups, stones and news in absolute world pixels

+91

;; (shift: the map's own pixel origin, as for px py below).

+92

(define (abs-news news sx sy)

+93

(map (lambda (n)

+94

(let ((k (length n)))

+95

;; every item ends with x y

+96

(append (list-head* n (- k 2))

+97

(list (+ sx (list-ref n (- k 2))) (+ sy (list-ref n (- k 1)))))))

+98

news))

+99

+100

(define (list-head* l n) (if (or (= n 0) (null? l)) '() (cons (car l) (list-head* (cdr l) (- n 1)))))

+101

+102

(define (world-place w ct . news)

+103

(let* ((wm (and w (world-map w)))

+104

(sx (if wm (* (worldmap-cols wm) (worldmap-size wm) (worldmap-x0 wm)) 0))

+105

(sy (if wm (* (worldmap-rows wm) (worldmap-size wm) (worldmap-y0 wm)) 0))

+106

(pl (world-place-a2 w ct)))

+107

(and pl

+108

(if (world-gates w)

+109

(let ((tm (world-tiles w)))

+110

(place pl

+111

carry: (world-carry w)

+112

tones: (map (lambda (p) (let ((c (cell-centre tm (pickup-cell p))))

+113

(list (pickup-overtone p) (+ sx (car c)) (+ sy (cdr c)))))

+114

(world-pickups w))

+115

stones: (map (lambda (st) (let ((c (cell-centre tm (stone-cell st))))

+116

                                                      (list (stone-overtone st) (stone-state st) (+ sx (car c)) (+ sy (cdr c)))))

+117

(world-stones w))

+118

news: (abs-news (if (pair? news) (car news) '()) sx sy)))

+119

pl))))

+120

+121

(define (world-place-a2 w ct)

122

(let* ((p (and w (world-room w)))

123

(rm (and p (placed-data p))))

124

(and rm ct

@@ -125,9 +162,9 @@

162

(define (audio-frame! frame-ms work-ms)

163

(let ((now (audio-now)))

164

(if (or (bench-running?) (bench-done?))

−128

(when (bench-running?) (bench-frame! now frame-ms work-ms))

+165

(begin (shell-take-news!) (when (bench-running?) (bench-frame! now frame-ms work-ms)))

166

(let ((dt (if *last* (min 0.25 (- now *last*)) 0.0)))

−130

(sound-frame! now dt (world-place (shell-world) (shell-content)))))

+167

(sound-frame! now dt (world-place (shell-world) (shell-content) (shell-take-news!)))))

168

(set! *last* now)

169

(mixer-pump! now)))

170

src/harkfell/sound.sglmodified

@@ -64,9 +64,10 @@

(export sound-boot! sound-frame! sound-preopen! sound-set-carry! sound-set-tone-room!

sound-ears sound-lines sound-hush sound-bed-levels sound-moment-playing sound-reset!

−67

sound-set-rng! strip-uncarried sound-spots-played DRONE-MOVING

+67

          sound-set-rng! strip-uncarried sound-spots-played DRONE-MOVING sound-bed-notes sound-region sound-cue-tunes sound-voice-source HUM-ID

sound-ears-flick ears-flick?

place place? place-key place-region place-px place-py place-rx place-ry place-moment place-frogs place-levels

+70

place-carry place-tones place-stones place-news

bed-channels-of group-channels

DUCK-GAIN DUCK-IN-S DUCK-OUT-S ROOM-RAMP-S BORDER-S FADE-S STILL-S

DRONE-CHANNELS DEFAULT-LEVELS BED-ID MOMENT-ID TONE-ID)

@@ -105,11 +106,21 @@

106

;; px py the body's centre in world pixels; rx ry the room's coordinate

107

;; still the body is at rest this frame

108

;; returns soft returns so far

+109

;; A3:

+110

;; carry the harmonics carried (the world's), or #f: leave the carry

+111

;; as sound-set-carry! set it (A2's tests)

+112

;; tones ((overtone x y) ...): each unfound harmonic where it lies, in

+113

;; absolute world pixels; #f: A2's one placeholder tone (tests)

+114

;; stones ((overtone state x y) ...): the ring-stones, absolute pixels

+115

;; news what happened this frame ((harkfell gates), (harkfell

+116

;; creatures)), positions absolute: (pickup N x y) (ring N x y)

+117

;; (sink N x y) (open N x y) (near-miss N x y) (call KIND x y)

118

(define-struct place

119

(key default: #f) (region default: #f) (bed-tune default: #f) (groups default: '())

120

(levels default: '()) (moment default: #f) (frogs default: '()) (water default: #f)

121

(px default: 0.0) (py default: 0.0) (rx default: 0) (ry default: 0)

−112

(still default: #f) (returns default: 0))

+122

(still default: #f) (returns default: 0)

+123

(carry default: #f) (tones default: #f) (stones default: '()) (news default: '()))

124

125

;; --- state ---------------------------------------------------------------------

126

(define *say* (lambda parts #f))

@@ -126,10 +137,8 @@

137

(define *moments* '()) ; ((name . player) ...) opened ahead

138

(define *moment* #f) ; (name . player) playing

139

(define *moment-key* #f)

−129

(define *tone-player* #f)

140

(define *tone-room* (cons 11 3)) ; PLACEHOLDER: east of A1's six rooms, until A3 places H2

141

(define *tone-cutoff* #f)

−132

(define *pan* (cons 1.0 1.0)) ; the tone's L R gains

142

(define *still-for* 0.0)

143

(define *still* #f)

144

(define *ears* #f)

@@ -141,6 +150,7 @@

150

(define *seed* 20260924)

151

152

(define (sound-hush) *hush*)

+153

(define (sound-region) *region*)

154

(define (sound-moment-playing) (and *moment* (car *moment*)))

155

(define (sound-ears) *ears*)

156

@@ -180,12 +190,13 @@

190

(when *bed-player* (player-close! *bed-player*))

191

(when *moment* (player-close! (cdr *moment*)))

192

(for-each (lambda (m) (player-close! (cdr m))) *moments*)

−183

(when *tone-player* (player-close! *tone-player*))

+193

(for-each (lambda (v) (player-close! (vector-ref (cdr v) 0))) *voices*)

+194

(set! *voices* '()) (set! *hum-n* #f) (set! *pending-cues* '())

195

(set! *hush* (hush-new)) (set! *key* #f) (set! *region* #f) (set! *groups* '())

196

(set! *bed-player* #f) (set! *bed-src* #f) (set! *levels* '()) (set! *moments* '())

−186

(set! *moment* #f) (set! *moment-key* #f) (set! *tone-player* #f) (set! *tone-cutoff* #f)

+197

(set! *moment* #f) (set! *moment-key* #f) (set! *tone-cutoff* #f)

198

(set! *still-for* 0.0) (set! *still* #f) (set! *ears* #f) (set! *next* '()) (set! *waiting* #f)

−188

(set! *spots* 0) (set! *carry-changed* #f) (set! *bed-tune* #f) (set! *room-levels* '()))

+199

(set! *spots* 0) (set! *carry-changed* #f) (set! *bed-tune* #f) (set! *room-levels* '()) (set! *bed-opened* #f))

200

201

;; --- channels and levels ------------------------------------------------------------

202

;; groups: the region's bed-channels, e.g. (wind water reeds drone)

@@ -273,10 +284,26 @@

284

(and t (guard (e (#t (*say* "sound" "error" "open" name) #f))

285

(open-tune-player t (mixer-rate) loop: loop?)))))

286

−276

(define (open-bed name)

+287

;; The harmonics a region's bed sounds: what you carry, the same in

+288

;; EVERY region (section 5: "the drone is present in every region's

+289

;; bed, so you hear your progress everywhere"; A3's gate).

+290

(define (bed-carry region) *carry*)

+291

+292

;; The bed as last opened (after strip-uncarried): for the gates.

+293

(define *bed-opened* #f)

+294

(define (sound-bed-notes ch)

+295

(if *bed-opened*

+296

          (apply + (map (lambda (p) (length (filter (lambda (c) (and (eqv? (cell-channel c) ch) (number? (cell-note c))))

+297

(tune-pattern-cells p))))

+298

(tune-patterns *bed-opened*)))

+299

0))

+300

+301

(define (open-bed name region)

302

(let ((t (tune-parsed name)))

303

(and t (guard (e (#t (*say* "sound" "error" "open" name) #f))

−279

(open-tune-player (strip-uncarried t *carry*) (mixer-rate) loop: #t)))))

+304

(let ((opened (strip-uncarried t (bed-carry region))))

+305

(set! *bed-opened* opened)

+306

(open-tune-player opened (mixer-rate) loop: #t))))))

307

308

(define (pull-of p) (lambda (out off n) (player-pull! p out off n)))

309

@@ -301,7 +328,7 @@

328

(define *outs* 0)

329

(define (open-region-bed! region groups bed-tune levels now)

330

(let* ((old-src *bed-src*) (old-player *bed-player*) (first? (not old-src))

−304

(p (and bed-tune (open-bed bed-tune))))

+331

(p (and bed-tune (open-bed bed-tune region))))

332

(if (not p)

333

(*say* "sound" "error" "no-bed" (if bed-tune bed-tune "none"))

334

(begin

@@ -395,14 +422,30 @@

422

;; --- listening: the tone, stillness, the ears ----------------------------------------------

423

(define (clamp lo hi x) (max lo (min hi x)))

424

−398

(define (tone-geometry pl)

−399

;; the tone's place: the centre of its room, in world pixels

−400

(let* ((tx (+ (* ROOM-W (car *tone-room*)) (/ ROOM-W 2.0)))

−401

(ty (+ (* ROOM-H (cdr *tone-room*)) (/ ROOM-H 2.0)))

−402

(dx (/ (- tx (place-px pl)) ROOM-W))

−403

(dy (/ (- ty (place-py pl)) ROOM-H)))

+425

;; The unfound harmonics' places: ((overtone x y) ...), absolute world

+426

;; pixels. A3: the place's (the world's pickups); without them, A2's one

+427

;; placeholder, H2 at the centre of *tone-room*.

+428

(define (tone-spots pl)

+429

(or (place-tones pl)

+430

(if (memv 2 *carry*)

+431

'()

+432

(list (list 2 (+ (* ROOM-W (car *tone-room*)) (/ ROOM-W 2.0))

+433

(+ (* ROOM-H (cdr *tone-room*)) (/ ROOM-H 2.0)))))))

+434

+435

;; (dx dy d) in rooms from the body to (x, y).

+436

(define (geometry-to pl x y)

+437

(let ((dx (/ (- x (place-px pl)) ROOM-W))

+438

(dy (/ (- y (place-py pl)) ROOM-H)))

439

(list dx dy (sqrt (+ (* dx dx) (* dy dy))))))

440

+441

;; The loudest unfound harmonic's geometry (the ears point to it), or #f.

+442

(define (tone-geometry pl)

+443

(let loop ((ts (tone-spots pl)) (best #f))

+444

(if (null? ts)

+445

best

+446

(let ((g (geometry-to pl (cadr (car ts)) (caddr (car ts)))))

+447

(loop (cdr ts) (if (or (not best) (< (caddr g) (caddr best))) g best))))))

+448

449

(define (tone-gain d)

450

(cond ((> d (+ TONE-ROOMS 0.5)) 0.0)

451

(else (let ((g (* TONE-GAIN (expt 10.0 (/ (* -1.0 TONE-DB-PER-ROOM (max 0.0 (- d 0.5))) 20.0)))))

@@ -422,20 +465,31 @@

465

((> dy 0.5) (* base 0.6))

466

(else base)))))

467

−425

;; the one-pole's coefficient for a corner (1.0: no filtering), eased

−426

;; toward its target each frame so a change of band is not a step

−427

(define *tone-a* 1.0)

−428

(define *tone-a-target* 1.0)

−429

(define *lp-l* 0.0)

−430

(define *lp-r* 0.0)

+468

;; --- voices: the finding tones and the stone's hum (A3) ------------------------------

+469

;; A VOICE is a looping tune played as a source with its own pan and

+470

;; one-pole low-pass: #(player pan-l pan-r a a-target lp-l lp-r). Each

+471

;; unfound harmonic has one ("tone-hN", tune tone-hN), open while you are

+472

;; in its range; the nearest mute stone has one ("stone-hum", the same

+473

;; tune as its harmonic's finding tone: "the same note you heard when you

+474

;; were finding its harmonic", section 3).

+475

(define *voices* '()) ; ((id . state) ...)

+476

(define HUM-R 88.0) ; px: a mute stone hums inside this (5.5 tiles)

+477

(define HUM-GAIN 0.3)

+478

(define TONE-OPEN-ROOMS (+ TONE-ROOMS 0.5))

+479

(define TONE-CLOSE-ROOMS (+ TONE-ROOMS 1.0))

+480

(define HUM-ID "stone-hum")

+481

+482

(define (tone-id n) (string-append "tone-h" (number->string n)))

+483

(define (tone-id? id) (and (>= (string-length id) 6) (string=? (substring id 0 6) "tone-h")))

+484

485

(define (corner->a fc)

486

(if fc (- 1.0 (exp (/ (* -2.0 3.14159265 fc) (mixer-rate)))) 1.0))

487

−434

(define (tone-pull p)

+488

(define (voice-pull st)

489

(lambda (out off n)

−436

(and (player-pull! p out off n)

−437

(let ((gl (car *pan*)) (gr (cdr *pan*)) (a *tone-a*))

−438

(let loop ((i 0) (yl *lp-l*) (yr *lp-r*))

+490

(and (player-pull! (vector-ref st 0) out off n)

+491

(let ((gl (vector-ref st 1)) (gr (vector-ref st 2)) (a (vector-ref st 3)))

+492

(let loop ((i 0) (yl (vector-ref st 5)) (yr (vector-ref st 6)))

493

(if (< i n)

494

(let* ((o (+ off (* 8 i)))

495

(yl (+ yl (* a (- (bytevector-ieee-single-ref out o 'little) yl))))

@@ -443,36 +497,100 @@

497

(bytevector-ieee-single-set! out o (* gl yl) 'little)

498

(bytevector-ieee-single-set! out (+ o 4) (* gr yr) 'little)

499

(loop (+ i 1) yl yr))

−446

(begin (set! *lp-l* yl) (set! *lp-r* yr))))

+500

(begin (vector-set! st 5 yl) (vector-set! st 6 yr))))

501

#t))))

502

−449

(define (close-tone!)

−450

(mixer-remove! TONE-ID)

−451

(when *tone-player* (player-close! *tone-player*))

−452

(set! *tone-player* #f))

+503

;; Each opening of a voice is its own mixer source, "ID#N" (review, A3:

+504

;; with one id per voice, leaving and re-entering the hum's range inside

+505

;; a fade's 0.6 s let the fade's pending remove delete the NEW source,

+506

;; and the hum stayed silent for good). st slot 7 holds the source id.

+507

(define *voice-n* 0)

+508

+509

(define (voice-src id)

+510

(let ((v (assoc id *voices*)))

+511

(and v (mixer-find (vector-ref (cdr v) 7)))))

512

+513

(define (voice-open! id tune now)

+514

(let ((p (and (tune-text tune) (open tune #t))))

+515

(when p

+516

(set! *voice-n* (+ *voice-n* 1))

+517

(let* ((sid (string-append id "#" (number->string *voice-n*)))

+518

(st (vector p 1.0 1.0 1.0 1.0 0.0 0.0 sid))

+519

(s (mixer-add! sid (voice-pull st) #t)))

+520

(source-factor! s 'dist 0.0 0.0 now)

+521

(when (and *still* (tone-id? id)) (source-factor! s 'still TONE-FORWARD 0.0 now))

+522

(set! *voices* (cons (cons id st) (filter (lambda (v) (not (string=? (car v) id))) *voices*)))))

+523

p))

+524

+525

;; Fade a voice out and close it (once).

+526

(define (voice-fade! id now)

+527

(let ((s (voice-src id)) (v (assoc id *voices*)))

+528

(when (and s v)

+529

(let* ((st (cdr v)) (sid (vector-ref st 7)))

+530

(source-factor! s 'dist 0.0 0.5 now)

+531

(set! *voices* (filter (lambda (x) (not (eq? x v))) *voices*))

+532

(mixer-at! (+ now 0.6) (lambda () (mixer-remove! sid) (player-close! (vector-ref st 0))))))))

+533

+534

;; A voice's mixer source (the gates read the tone's gain), or #f.

+535

(define (sound-voice-source id) (voice-src id))

+536

+537

;; gain; pan -1..1 (equal power, neither side above unity); fc a low-pass

+538

;; corner or #f

+539

(define (voice-set! id gain pan fc now)

+540

(let ((s (voice-src id)) (v (assoc id *voices*)))

+541

(when (and s v)

+542

(let ((st (cdr v)) (a (* 0.25 3.14159265 (+ pan 1.0))))

+543

(source-factor! s 'dist gain 0.25 now)

+544

(vector-set! st 1 (min 1.0 (* 1.41421356 (cos a))))

+545

(vector-set! st 2 (min 1.0 (* 1.41421356 (sin a))))

+546

(vector-set! st 4 (corner->a fc))

+547

(vector-set! st 3 (+ (vector-ref st 3) (* 0.1 (- (vector-ref st 4) (vector-ref st 3)))))))))

+548

+549

;; Every unfound harmonic's tone: open in range, placed, faded and closed

+550

;; once found (review M5) or out of range.

551

(define (tone-frame! pl now)

−455

(when (and (not (memv 2 *carry*)) (not *tone-player*) (tune-text TONE-TUNE))

−456

(set! *tone-player* (open TONE-TUNE #t))

−457

(when *tone-player*

−458

(let ((s (mixer-add! TONE-ID (tone-pull *tone-player*) #t)))

−459

(source-factor! s 'dist 0.0 0.0 now))))

−460

(let ((s (mixer-find TONE-ID)))

−461

(when s

−462

(if (memv 2 *carry*)

−463

;; carried: the tone fades and its player closes (review M5)

−464

(unless (> (source-factor s 'dist now) 0.99)

−465

(source-factor! s 'dist 0.0 0.5 now)

−466

(let ((p *tone-player*))

−467

(mixer-at! (+ now 0.6) (lambda () (when (eq? p *tone-player*) (close-tone!))))))

−468

(let* ((g (tone-geometry pl)) (dx (car g)) (dy (cadr g)) (d (caddr g))

−469

(pan (clamp (- MAX-PAN) MAX-PAN (* 0.6 dx))))

−470

(source-factor! s 'dist (tone-gain d) 0.25 now)

−471

;; equal power, at most MAX-PAN toward it; neither side above unity

−472

(let ((a (* 0.25 3.14159265 (+ pan 1.0))))

−473

(set! *pan* (cons (min 1.0 (* 1.41421356 (cos a))) (min 1.0 (* 1.41421356 (sin a))))))

−474

(set! *tone-a-target* (corner->a (tone-cutoff d dy)))

−475

(set! *tone-a* (+ *tone-a* (* 0.1 (- *tone-a-target* *tone-a*)))))))))

+552

(let ((spots (tone-spots pl)))

+553

(for-each

+554

(lambda (sp)

+555

(let* ((n (car sp)) (id (tone-id n))

+556

(g (geometry-to pl (cadr sp) (caddr sp)))

+557

(dx (car g)) (dy (cadr g)) (d (caddr g))

+558

(open? (assoc id *voices*)))

+559

(cond ((and (not open?) (< d TONE-OPEN-ROOMS))

+560

(when (voice-open! id (tone-id n) now)

+561

(voice-set! id (tone-gain d) (clamp (- MAX-PAN) MAX-PAN (* 0.6 dx)) (tone-cutoff d dy) now)))

+562

((and open? (> d TONE-CLOSE-ROOMS)) (voice-fade! id now))

+563

(open? (voice-set! id (tone-gain d) (clamp (- MAX-PAN) MAX-PAN (* 0.6 dx)) (tone-cutoff d dy) now))

+564

(else #f))))

+565

spots)

+566

;; a tone whose harmonic is no longer unfound (carried): fades

+567

(for-each (lambda (v)

+568

(when (and (tone-id? (car v))

+569

(not (find (lambda (sp) (string=? (tone-id (car sp)) (car v))) spots)))

+570

(voice-fade! (car v) now)))

+571

*voices*)))

+572

+573

;; The nearest mute stone (shut, its harmonic not carried) within HUM-R

+574

;; hums its harmonic's note, quietly, louder as you come closer.

+575

(define *hum-n* #f)

+576

(define (hum-frame! pl now)

+577

(let* ((near (let loop ((ss (place-stones pl)) (best #f) (bd HUM-R))

+578

(if (null? ss)

+579

best

+580

(let* ((st (car ss))

+581

                                (d (sqrt (+ (expt (- (caddr st) (place-px pl)) 2) (expt (- (cadddr st) (place-py pl)) 2)))))

+582

(if (and (eq? (cadr st) 'shut) (not (memv (car st) *carry*)) (< d bd))

+583

(loop (cdr ss) (cons st d) d)

+584

(loop (cdr ss) best bd))))))

+585

(n (and near (car (car near)))))

+586

(when (and (assoc HUM-ID *voices*) (not (eqv? n *hum-n*)))

+587

(voice-fade! HUM-ID now))

+588

(when near

+589

(unless (assoc HUM-ID *voices*) (voice-open! HUM-ID (tone-id n) now))

+590

(let* ((st (car near)) (d (cdr near))

+591

(dx (/ (- (caddr st) (place-px pl)) 200.0)))

+592

(voice-set! HUM-ID (* HUM-GAIN (- 1.0 (/ d HUM-R))) (clamp (- MAX-PAN) MAX-PAN dx) #f now)))

+593

(set! *hum-n* n)))

594

595

(define (still-frame! pl dt now)

596

(set! *still-for* (if (place-still pl) (+ *still-for* dt) 0.0))

@@ -481,8 +599,11 @@

599

(set! *still* now-still)

600

(when *bed-src*

601

(source-factor! *bed-src* 'still (if now-still DUCK-GAIN 1.0) (if now-still STILL-IN-S STILL-OUT-S) now))

−484

(let ((s (mixer-find TONE-ID)))

−485

            (when s (source-factor! s 'still (if now-still TONE-FORWARD 1.0) (if now-still STILL-IN-S STILL-OUT-S) now)))

+602

(for-each (lambda (v)

+603

(when (tone-id? (car v))

+604

(let ((s (voice-src (car v))))

+605

                          (when s (source-factor! s 'still (if now-still TONE-FORWARD 1.0) (if now-still STILL-IN-S STILL-OUT-S) now)))))

+606

*voices*)

607

(apply-room-levels! *room-levels* now (if now-still DRONE-UP-S DRONE-DOWN-S) 'drone)))

608

(let ((was *ears*))

609

(set-ears! pl)

@@ -491,22 +612,110 @@

612

(define (set-ears! pl)

613

(set! *ears*

614

(and *still*

−494

(let* ((g (tone-geometry pl)) (dx (car g)) (dy (cadr g)) (d (caddr g)))

−495

(cond ((or (memv 2 *carry*) (> d (+ TONE-ROOMS 0.5)) (< d 0.3)) 'up)

+615

(let* ((g (or (tone-geometry pl) (list 0.0 0.0 1000.0))) (dx (car g)) (dy (cadr g)) (d (caddr g)))

+616

(cond ((or (> d (+ TONE-ROOMS 0.5)) (< d 0.3)) 'up)

617

((>= (abs dx) (abs dy)) (if (> dx 0) 'right 'left))

618

((< dy 0) 'up)

619

(else 'below))))))

620

621

;; --- spot sounds ---------------------------------------------------------------------------

622

;; (name tune lo hi gain): rendered from assets/tunes/TUNE.cts at boot

+623

;; A3: the bellfrogs call from (harkfell creatures) now, so frog is not a

+624

;; scheduled spot sound; the cues below the first three are played by name

+625

;; from the world's news.

+626

;; In the order they are rendered at boot (a few blocks a frame, about 7 s

+627

;; for all of them at 60 fps): the calls heard in the first rooms first,

+628

;; the gate's and the H2 answers after, the ambient spots last.

629

(define SPOTS

−503

'((frog "spot-frog" 5.0 14.0 0.55)

−504

(bird "spot-bird" 14.0 32.0 0.35)

−505

(plop "spot-plop" 7.0 18.0 0.4)

−506

(return "return-tone" 0.0 0.0 0.5)))

+630

(list (list 'return "return-tone" 0.0 0.0 0.5)

+631

;; the creatures' calls (A3)

+632

(list 'chirp-a "chirp-a" 0.0 0.0 0.35)

+633

(list 'chirp-b "chirp-b" 0.0 0.0 0.35)

+634

(list 'flurry "flurry" 0.0 0.0 0.45)

+635

(list 'croak-a "croak-a" 0.0 0.0 0.55)

+636

(list 'croak-b "croak-b" 0.0 0.0 0.55)

+637

(list 'moth-a "moth-a" 0.0 0.0 0.3)

+638

(list 'moth-b "moth-b" 0.0 0.0 0.3)

+639

;; the gate and the pickup (A3): (name tune 0 0 gain)

+640

(list 'miss-h2 "miss-h2" 0.0 0.0 0.6)

+641

(list 'pickup-h2 "pickup-h2" 0.0 0.0 0.8)

+642

(list 'ring-h2 "ring-h2" 0.0 0.0 0.75)

+643

(list 'stone-slide "stone-slide" 0.0 0.0 0.55)

+644

;; what H2 changes

+645

(list 'croak-h2 "croak-h2" 0.0 0.0 0.55)

+646

(list 'song-h2 "song-h2" 0.0 0.0 0.5)

+647

(list 'moth-h2 "moth-h2" 0.0 0.0 0.35)

+648

;; A2's spot sounds

+649

(list 'bird "spot-bird" 14.0 32.0 0.35)

+650

(list 'plop "spot-plop" 7.0 18.0 0.4)))

+651

+652

;; The world's news as cues, panned by x from the body and quieter with

+653

;; distance. A creature's call, like a spot sound, never starts during a

+654

;; moment (David, 2026-09-24); the gate's and the pickup's always do:

+655

;; they answer what you did.

+656

(define (cue-at! name gain x pl)

+657

(let* ((dx (- x (place-px pl)))

+658

(g (* gain (- 1.0 (* 0.5 (min 1.0 (/ (abs dx) ROOM-W)))))))

+659

(cue! name g (clamp (- MAX-PAN) MAX-PAN (/ dx 200.0)))))

+660

+661

(define (spot-gain name) (let ((e (spot-ref name))) (if e (list-ref e 4) 0.5)))

+662

+663

(define (harmonic-cue base n) (string->symbol (string-append base (number->string n))))

+664

+665

;; The gate's cues are rare and are what A3's web probe listens for, so

+666

;; each says a line (harkfell: sound cue NAME, or cue-missing: not rendered

+667

;; yet or no tune).

+668

;;

+669

;; A gate cue not rendered yet (a door that drops you onto a harmonic

+670

;; takes it on the first frame, before the boot renders have reached it:

+671

;; seen by A3's web probe) jumps the render queue and plays as soon as it

+672

;; is ready ("cue-late"), if that is within PENDING-S; never silently.

+673

(define PENDING-S 3.0)

+674

(define *pending-cues* '()) ; ((name gain pan since) ...)

+675

+676

(define (gate-cue! name gain x pl)

+677

(cond ((assq name *cues*)

+678

(*say* "sound" "cue" (symbol->string name))

+679

(cue-at! name gain x pl))

+680

((spot-ref name)

+681

(*say* "sound" "cue-waiting" (symbol->string name))

+682

(let* ((dx (- x (place-px pl)))

+683

(g (* gain (- 1.0 (* 0.5 (min 1.0 (/ (abs dx) ROOM-W)))))))

+684

(set! *pending-cues* (cons (list name g (clamp (- MAX-PAN) MAX-PAN (/ dx 200.0)) *now*) *pending-cues*)))

+685

(unless (and *cue-job* (eq? (vector-ref *cue-job* 0) name))

+686

(set! *cue-queue* (cons name (filter (lambda (n) (not (eq? n name))) *cue-queue*)))))

+687

(else (*say* "sound" "cue-missing" (symbol->string name)))))

+688

+689

(define (pending-cues-frame!)

+690

(set! *pending-cues*

+691

(filter (lambda (p)

+692

(cond ((assq (car p) *cues*)

+693

(*say* "sound" "cue-late" (symbol->string (car p)))

+694

(cue! (car p) (cadr p) (caddr p))

+695

#f)

+696

((> (- *now* (cadddr p)) PENDING-S)

+697

(*say* "sound" "cue-dropped" (symbol->string (car p)))

+698

#f)

+699

(else #t)))

+700

*pending-cues*)))

+701

+702

(define (news-frame! pl)

+703

(for-each

+704

(lambda (item)

+705

(case (car item)

+706

((pickup) (let ((c (harmonic-cue "pickup-h" (cadr item)))) (gate-cue! c (spot-gain c) (caddr item) pl)))

+707

((ring) (let ((c (harmonic-cue "ring-h" (cadr item)))) (gate-cue! c (spot-gain c) (caddr item) pl)))

+708

((near-miss) (let ((c (harmonic-cue "miss-h" (cadr item)))) (gate-cue! c (spot-gain c) (caddr item) pl)))

+709

((sink) (gate-cue! 'stone-slide (spot-gain 'stone-slide) (caddr item) pl))

+710

((call) (unless *moment* (cue-at! (cadr item) (spot-gain (cadr item)) (caddr item) pl)))

+711

(else #f)))

+712

(place-news pl)))

713

714

(define (spot-ref name) (assq name SPOTS))

715

+716

;; Every tune the director renders as a cue (the gates check each exists).

+717

(define (sound-cue-tunes) (map cadr SPOTS))

+718

719

;; Render the queued cues a few blocks a frame (review M7: a whole cue at

720

;; once, its notes and motif's 2 s release tail, was one long frame each).

721

(define CUE-BLOCK 1024)

@@ -584,10 +793,6 @@

793

(reeds (room-level (place-levels pl) 'reeds))

794

(water (room-level (place-levels pl) 'water))

795

(bx (- (place-px pl) (* ROOM-W (place-rx pl)))))

−587

(when (and (pair? frogs) (due? 'frog now 5.0 14.0))

−588

(let* ((fx (list-ref frogs (min (- (length frogs) 1) (exact (floor (* (rand!) (length frogs)))))))

−589

(dist (abs (- fx bx))))

−590

            (cue! 'frog (* 0.55 (- 1.0 (* 0.5 (min 1.0 (/ dist ROOM-W))))) (clamp (- MAX-PAN) MAX-PAN (/ (- fx bx) 200.0)))))

796

(when (and (> reeds 0.2) (due? 'bird now 14.0 32.0))

797

(cue! 'bird (* 0.35 reeds 1.5) (rand-in (- MAX-PAN) MAX-PAN)))

798

(when (and (> water 0.3) (due? 'plop now 7.0 18.0))

@@ -601,6 +806,10 @@

806

(define (sound-boot! moments say)

807

(set! *say* say)

808

(set! *to-open* moments)

+809

;; a boot renders every cue afresh (a second boot, a world reloaded, starts

+810

;; from nothing: the late-cue gate relies on it)

+811

(when *cue-job* (player-close! (vector-ref *cue-job* 1)))

+812

(set! *cue-job* #f) (set! *cues* (quote ())) (set! *pending-cues* (quote ()))

813

(set! *cue-queue* (map car SPOTS))

814

(for-each tune-text (append moments (list TONE-TUNE) (map cadr SPOTS))))

815

@@ -619,6 +828,7 @@

828

(define (sound-frame! now dt pl)

829

(set! *now* now)

830

(unless pl (set! *ears* #f))

+831

(when (and pl (list? (place-carry pl))) (sound-set-carry! (place-carry pl)))

832

(when pl

833

(set! *hush* (hush-tick *hush* dt))

834

(unless (moment-busy?) (boot-work!))

@@ -646,6 +856,9 @@

856

(cue! 'return 0.5 0.0))

857

(still-frame! pl dt now)

858

(tone-frame! pl now)

+859

(hum-frame! pl now)

+860

(news-frame! pl)

+861

(pending-cues-frame!)

862

(spots-frame! pl now)))

863

864

(define (moment-busy?) (and *moment* #t))

test/fixtures/worlds/two/regions/testfen.mapadded

@@ -0,0 +1,7 @@

(map

region: testfen

origin: (0 0)

layout:

("A")

rooms:

((A "Fen" "the harmonic on the floor")))

test/fixtures/worlds/two/regions/testhollow.mapadded

@@ -0,0 +1,7 @@

(map

region: testhollow

origin: (2 0)

layout:

("A")

rooms:

((A "Hollow" "another region's bed")))

test/fixtures/worlds/two/rooms/testfen/x0y0.roomadded

@@ -0,0 +1,19 @@

(room

region: testfen

at: (0 0)

title: "Fen"

intent: "the harmonic on the floor"

bed: (wind 0.5 drone 0.6)

grid:

("#########################"

"# #"

+10

"# #"

+11

"# #"

+12

"# #"

+13

"# #"

+14

"# #"

+15

"# #"

+16

"# #"

+17

"# #"

+18

"#########################")

+19

things: ((harmonic at: (12 9) overtone: 2)))

test/fixtures/worlds/two/rooms/testhollow/x2y0.roomadded

@@ -0,0 +1,18 @@

(room

region: testhollow

at: (2 0)

title: "Hollow"

intent: "another region's bed"

bed: (wind 0.5 drone 0.6)

grid:

("#########################"

"# #"

+10

"# #"

+11

"# #"

+12

"# #"

+13

"# #"

+14

"# #"

+15

"# #"

+16

"# #"

+17

"# #"

+18

"#########################"))

test/fixtures/worlds/two/world.sgladded

@@ -0,0 +1,29 @@

;;; A two-region fixture world for A3's every-region gate: a pickup of H2

;;; in one region (testfen, Reedfen's bed) and a room in another (testhollow,

;;; the Hollow's bed). The rooms are not neighbours: A1's joins do not cross

;;; regions yet.

(start region: testfen room: (0 0) cell: (2 9))

(palette

(sky-1 "#8fa3b3" "sky") (stone-1 "#5d5a55" "rock") (stone-2 "#7a766f" "rock lit"))

+10

(region testfen

+11

name: "Test fen"

+12

bounds: ((0 0) (0 0))

+13

bed: "reedfen-bed"

+14

bed-channels: (wind water reeds drone)

+15

palette: (sky-1 stone-1 stone-2)

+16

roster: (frog)

+17

moments: ()

+18

gives: ((overtone 2)))

+19

+20

(region testhollow

+21

name: "Test hollow"

+22

bounds: ((2 0) (2 0))

+23

bed: "bed-hollow"

+24

bed-channels: (wind water texture drone)

+25

palette: (sky-1 stone-1 stone-2)

+26

roster: (frog)

+27

moments: ())

+28

+29

(creature frog behaviour: hop)

test/test-place.sglmodified

@@ -18,16 +18,20 @@

(harkfell feel)

(engine mixer)

(harkfell sound)

+21

(harkfell gates)

(harkfell audio))

(define CT (load-content (read-world-source "world")))

−25

;; The body standing in room (x, y) at its start cell, as a world.

+26

;; The body standing in room (x, y) at its start cell, as a world with its

+27

;; gates (the pickups, the stones), as the shell makes it.

(define (world-in x y)

(let* ((rm (content-room CT x y))

(cell (room-start-cell CT rm)))

−29

(world-at (content-map CT)

−30

(cell-body (worldmap-tiles (content-map CT)) HARKFELL-FEEL (car cell) (cdr cell)))))

+31

(world-populate

+32

(world-at (content-map CT)

+33

(cell-body (worldmap-tiles (content-map CT)) HARKFELL-FEEL (car cell) (cdr cell)))

+34

(content-stones CT) (content-pickups CT) '())))

(define (inside? pl)

(and (<= (* 400 (place-rx pl)) (place-px pl) (* 400 (+ 1 (place-rx pl))))

@@ -52,13 +56,14 @@

(assert-true (every (lambda (x) (< 0 x 400)) (place-frogs pl))))))

;; Listening, end to end on the real world: the director given the adapter's

−55

;; place, standing still for 3 s. H2's tone is at its placeholder room (11 3),

−56

;; east of Old Stone (10 3); Fen Edge (8 3) is three rooms from it. The tone

−57

;; must sound in both, louder in Old Stone, and the ears must lean east.

+59

;; place, standing still for 3 s. H2's tone is where the world's pickup lies

+60

;; (A3): the Drowned Channel (9 4), cell (18 7). From the Climb Back (10 4)

+61

;; it is west, next door; from the Fen Edge (8 3) it is east and below, about

+62

;; two rooms off. The tone must sound in both, louder in the Climb Back, and

+63

;; the ears must lean west in one and east in the other.

(define (listen-in x y)

(mixer-open-headless! 32000 (lambda (id buf n gain) #f))

(sound-reset!)

−61

(sound-set-tone-room! 11 3)

(let* ((w (world-in x y))

(base (world-place w CT))

(pl (place base still: #t)))

@@ -68,19 +73,19 @@

(sound-frame! now (if (= f 0) 0.0 (/ 1 30.0)) pl)

(mixer-pump! now)

(loop (+ f 1)))))

−71

(let ((s (mixer-find TONE-ID)))

+76

(let ((s (sound-voice-source TONE-ID)))

(list (sound-ears) (and s (source-gain s 3.0))))))

−74

(define OLD-STONE (listen-in 10 3))

+79

(define CLIMB-BACK (listen-in 10 4))

(define FEN-EDGE (listen-in 8 3))

(test-group "place: listening on the real world"

−78

(test "in Old Stone, still: the ears lean east and the tone sounds"

−79

(assert-equal 'right (car OLD-STONE))

−80

(assert-true (> (cadr OLD-STONE) 0.2)))

−81

(test "in Fen Edge, three rooms away: fainter, but there"

+83

(test "in the Climb Back, still: the ears lean west and the tone sounds"

+84

(assert-equal 'left (car CLIMB-BACK))

+85

(assert-true (> (cadr CLIMB-BACK) 0.2)))

+86

(test "in the Fen Edge, further: the ears lean east, fainter, but there"

(assert-equal 'right (car FEN-EDGE))

−83

(assert-true (< 0.0 (cadr FEN-EDGE) (cadr OLD-STONE)))))

+88

(assert-true (< 0.0 (cadr FEN-EDGE) (cadr CLIMB-BACK)))))

;; The ears' flick (David, 2026-09-24): down and back twice in the first

;; 0.36 s after they rise (0.09 s steps), again every 4 s, and up otherwise.

@@ -95,3 +100,33 @@

100

(assert-false (ears-flick? 2.0))

101

(assert-false (ears-flick? 3.95))

102

(assert-true (ears-flick? 4.05))))

+103

+104

;; The mute stone's hum survives leaving its range and coming straight back

+105

;; (the review's finding 2: the first fade's pending remove deleted the

+106

;; reopened hum's source, and it stayed silent for good).

+107

(define (hum-after steps)

+108

(mixer-open-headless! 32000 (lambda (id buf n gain) #f))

+109

(sound-reset!)

+110

(let* ((w (world-in 10 3))

+111

(base (world-place w CT))

+112

(st (car (place-stones base)))

+113

(near (place base px: (- (caddr st) 50.0) py: (cadddr st)))

+114

(far (place base px: (- (caddr st) 150.0) py: (cadddr st))))

+115

(let loop ((ps steps) (f 0))

+116

(if (null? ps)

+117

(let ((s (sound-voice-source HUM-ID)))

+118

(and s (source-gain s (/ f 30.0))))

+119

(begin

+120

(sound-frame! (/ f 30.0) (/ 1 30.0) (if (eq? (car ps) 'near) near far))

+121

(mixer-pump! (/ f 30.0))

+122

(loop (cdr ps) (+ f 1)))))))

+123

+124

(define (times n x) (if (= n 0) '() (cons x (times (- n 1) x))))

+125

+126

(test-group "place: the stone's hum"

+127

(test "near a mute stone, it hums"

+128

(assert-true (> (or (hum-after (times 60 'near)) 0.0) 0.05)))

+129

(test "out of range for one frame and straight back: it still hums 3 s later"

+130

(assert-true (> (or (hum-after (append (times 30 'near) (list 'far) (times 90 'near))) 0.0) 0.05)))

+131

(test "far from it: silent"

+132

(assert-false (let ((g (hum-after (times 60 'far)))) (and g (> g 0.01))))))

test/test-regions.sgladded

@@ -0,0 +1,111 @@

;;; A3's every-region gate (harkfell-design section 10, A3): carrying H2

;;; unmutes drone channel 4 in EVERY region's bed, not only the bed of the

;;; region where it was found.

;;;

;;; "Unmutes" is measured as A2's handoff asks: the notes of channel 4 are

;;; PRESENT in the bed as it is opened (a muted channel still synthesises, so

;;; the director drops the notes of an uncarried harmonic instead of muting

;;; them: topics/motif-muted-channel-still-synthesises).

;;;

+10

;;; On a fixture world of two regions (test/fixtures/worlds/two): testfen,

+11

;;; whose bed is Reedfen's and where H2 lies on the floor, and testhollow,

+12

;;; whose bed is the Hollow's. Driven end to end: the real world ticks, the

+13

;;; body takes H2 by touch, the real adapter ((harkfell audio) world-place)

+14

;;; hands the director its place, and the director opens each region's bed.

+15

;;; Every region is visited before the pickup (the control: no channel-4

+16

;;; notes anywhere) and after it.

+17

+18

(import (sigil test)

+19

(sigil list)

+20

(engine worldmap)

+21

(engine body)

+22

(engine reach)

+23

(engine mixer)

+24

(harkfell world)

+25

(harkfell content)

+26

(harkfell source)

+27

(harkfell check)

+28

(harkfell feel)

+29

(harkfell gates)

+30

(harkfell sound)

+31

(harkfell audio))

+32

+33

(define CT (load-content (read-world-source "test/fixtures/worlds/two")))

+34

(define TM (worldmap-tiles (content-map CT)))

+35

+36

(define (standing x y c r from)

+37

(let* ((rm (content-room CT x y))

+38

(g (local->global CT rm c r))

+39

(w (world-at (content-map CT) (cell-body TM HARKFELL-FEEL (car g) (cdr g)))))

+40

(if from

+41

(world-populate w (world-stones from) (world-pickups from) (world-carry from))

+42

(world-populate w (content-stones CT) (content-pickups CT) '()))))

+43

+44

;; The director in the world w for secs seconds; the notes of channel 4 in

+45

;; the bed it has open at the end, and the region it thinks it is in.

+46

(define *t* 0.0)

+47

(define (hear w secs)

+48

(let loop ((f 0) (w w))

+49

(if (> f (* 30 secs))

+50

(list (sound-bed-notes 4) (sound-region) w)

+51

(let* ((w (world-tick w NOTHING))

+52

(p (world-take-news w)))

+53

(set! *t* (+ *t* (/ 1 30.0)))

+54

(sound-frame! *t* (/ 1 30.0) (world-place (cdr p) CT (car p)))

+55

(mixer-pump! *t*)

+56

(loop (+ f 1) (cdr p))))))

+57

+58

(mixer-open-headless! 32000 (lambda (id buf n gain) #f))

+59

(sound-reset!)

+60

;; the director's cues, rendered at boot as in the game; what it says is kept

+61

(define *said* '())

+62

(sound-boot! '() (lambda parts (set! *said* (cons parts *said*))))

+63

(define (said? . parts) (and (member parts *said*) #t))

+64

+65

(define W0 (standing 0 0 3 9 #f)) ; testfen, away from H2

+66

(define FEN-BEFORE (hear W0 20)) ; long enough to render every cue

+67

(define SAID-BEFORE *said*)

+68

(define HOLLOW-BEFORE (hear (standing 2 0 5 9 (caddr FEN-BEFORE)) 1))

+69

(define TAKE (hear (standing 0 0 12 9 (caddr HOLLOW-BEFORE)) 1)) ; on H2: taken

+70

(define SAID-TAKE *said*)

+71

(define FEN-AFTER (hear (caddr TAKE) 5))

+72

(define HOLLOW-AFTER (hear (standing 2 0 5 9 (caddr FEN-AFTER)) 5))

+73

+74

(test-group "every region: before H2"

+75

(test "the fixture loads clean, with two regions"

+76

(assert-equal '() (content-problems CT))

+77

(assert-equal 2 (length (content-regions CT))))

+78

(test "testfen's bed: no channel-4 notes"

+79

(assert-equal 'testfen (cadr FEN-BEFORE))

+80

(assert-equal 0 (car FEN-BEFORE)))

+81

(test "testhollow's bed: no channel-4 notes"

+82

(assert-equal 'testhollow (cadr HOLLOW-BEFORE))

+83

(assert-equal 0 (car HOLLOW-BEFORE))))

+84

+85

(test-group "every region: after H2"

+86

(test "the body took H2 in testfen"

+87

(assert-equal '(2) (world-carry (caddr TAKE))))

+88

(test "and the director played its pickup cue (and had not before)"

+89

(assert-false (member (list "sound" "cue" "pickup-h2") SAID-BEFORE))

+90

(assert-true (member (list "sound" "cue" "pickup-h2") SAID-TAKE)))

+91

(test "testfen's bed, where it was found: channel 4 sounds"

+92

(assert-equal 'testfen (cadr FEN-AFTER))

+93

(assert-true (> (car FEN-AFTER) 0)))

+94

(test "testhollow's bed, another region: channel 4 sounds too"

+95

(assert-equal 'testhollow (cadr HOLLOW-AFTER))

+96

(assert-true (> (car HOLLOW-AFTER) 0))))

+97

+98

;; A door onto the harmonic takes it on the first frame, before the boot has

+99

;; rendered its cue (seen by A3's web probe: the pickup was silent). The cue

+100

;; waits, jumps the render queue, and plays late rather than never.

+101

(mixer-open-headless! 32000 (lambda (id buf n gain) #f))

+102

(sound-reset!)

+103

(set! *said* '())

+104

(sound-boot! '() (lambda parts (set! *said* (cons parts *said*))))

+105

(define ON-IT (hear (standing 0 0 12 9 #f) 3))

+106

+107

(test-group "every region: the pickup's cue on the first frame"

+108

(test "it was not ready, so it waited, and then it played"

+109

(assert-true (said? "sound" "cue-waiting" "pickup-h2"))

+110

(assert-true (said? "sound" "cue-late" "pickup-h2"))

+111

(assert-false (said? "sound" "cue-dropped" "pickup-h2"))))

test/test-tunes.sglmodified

@@ -16,6 +16,8 @@

(harkfell content)

(harkfell source)

(harkfell tunes)

+19

(harkfell sound)

+20

(harkfell gates)

(harkfell audio))

(define WORLD (read-world-source "world"))

@@ -74,3 +76,30 @@

WORLD))

(ps (tune-problems (load-content src))))

(assert-true (member "reedfen:9,3 moment: no assets/tunes/frog-choir.cts" ps)))))

+79

+80

;; A3: every cue the director renders, and for every harmonic placed in the

+81

;; world (a pickup or a ring-stone) its finding tone, its pickup cue, its

+82

;; ring and its near miss: each has a file that reads. The director plays

+83

;; nothing for a harmonic whose tune is missing, so a missing file would be

+84

;; silent in play.

+85

(define (a3-tunes ct)

+86

(append (sound-cue-tunes)

+87

(apply append

+88

(map (lambda (n)

+89

(map (lambda (base) (string-append base (number->string n)))

+90

(list "tone-h" "pickup-h" "ring-h" "miss-h")))

+91

(append (map pickup-overtone (content-pickups ct))

+92

(map stone-overtone (content-stones ct)))))))

+93

+94

(define (unreadable names)

+95

(filter (lambda (n) (not (and (tune-exists? n) (guard (x (#t #f)) (read-tune-string (tune-text n))))))

+96

names))

+97

+98

(test-group "tunes: the A3 cues and each placed harmonic's sounds"

+99

(test "the world places H2 (the check has a subject), and every cue and H2 tune reads"

+100

(let ((ct (load-content WORLD)))

+101

(assert-true (member "ring-h2" (a3-tunes ct)))

+102

(assert-true (member "croak-h2" (a3-tunes ct)))

+103

(assert-equal '() (unreadable (a3-tunes ct)))))

+104

(test "a harmonic with no tunes is red (H3 has none yet)"

+105

(assert-true (member "ring-h3" (unreadable (list "ring-h2" "ring-h3"))))))