1 ! (c)2009 Joe Groff bsd license
2 USING: accessors alien audio classes.struct fry calendar alarms
3 combinators combinators.short-circuit destructors generalizations
4 kernel literals locals math openal sequences specialized-arrays strings ;
5 QUALIFIED-WITH: alien.c-types c
6 SPECIALIZED-ARRAYS: c:float c:uchar c:uint ;
10 { position initial: { 0.0 0.0 0.0 } }
11 { gain float initial: 1.0 }
12 { velocity initial: { 0.0 0.0 0.0 } }
13 { relative? boolean initial: f }
14 { distance float initial: 1.0 }
15 { rolloff float initial: 1.0 } ;
17 TUPLE: audio-orientation
18 { forward initial: { 0.0 0.0 -1.0 } }
19 { up initial: { 0.0 1.0 0.0 } } ;
21 C: <audio-orientation> audio-orientation
23 : orientation>float-array ( orientation -- float-array )
25 [ up>> first3 ] bi 6 float-array{ } nsequence ; inline
28 { position initial: { 0.0 0.0 0.0 } }
29 { gain float initial: 1.0 }
30 { velocity initial: { 0.0 0.0 0.0 } }
31 { orientation initial: T{ audio-orientation } } ;
33 GENERIC: audio-position ( source/listener -- position )
34 GENERIC: audio-gain ( source/listener -- gain )
35 GENERIC: audio-velocity ( source/listener -- velocity )
36 GENERIC: audio-relative? ( source -- relative? )
37 GENERIC: audio-distance ( source -- distance )
38 GENERIC: audio-rolloff ( source -- rolloff )
39 GENERIC: audio-orientation ( listener -- orientation )
41 M: object audio-position drop { 0.0 0.0 0.0 } ; inline
42 M: object audio-gain drop 1.0 ; inline
43 M: object audio-velocity drop { 0.0 0.0 0.0 } ; inline
44 M: object audio-relative? drop f ; inline
45 M: object audio-distance drop 1.0 ; inline
46 M: object audio-rolloff drop 1.0 ; inline
47 M: object audio-orientation drop T{ audio-orientation } ; inline
49 M: audio-source audio-position position>> ; inline
50 M: audio-source audio-gain gain>> ; inline
51 M: audio-source audio-velocity velocity>> ; inline
52 M: audio-source audio-relative? relative?>> ; inline
53 M: audio-source audio-distance distance>> ; inline
54 M: audio-source audio-rolloff rolloff>> ; inline
56 M: audio-listener audio-position position>> ; inline
57 M: audio-listener audio-gain gain>> ; inline
58 M: audio-listener audio-velocity velocity>> ; inline
59 M: audio-listener audio-orientation orientation>> ; inline
61 GENERIC: generate-audio ( generator -- c-ptr size )
62 GENERIC: generator-audio-format ( generator -- channels sample-bits sample-rate )
64 TUPLE: audio-engine < disposable
65 { voice-count integer }
70 { next-source integer }
74 TUPLE: audio-clip < disposable
75 { audio-engine audio-engine }
77 { al-source integer } ;
79 TUPLE: static-audio-clip < audio-clip
80 { al-buffer integer } ;
82 TUPLE: streaming-audio-clip < audio-clip
85 { sample-bits integer }
86 { sample-rate integer }
87 { al-buffers uint-array }
90 ERROR: audio-device-not-found device-name ;
91 ERROR: audio-context-not-available device-name ;
93 :: <audio-engine> ( device-name voice-count -- engine )
95 device-name alcOpenDevice :> al-device
96 al-device [ device-name audio-device-not-found ] unless
97 al-device |alcCloseDevice* drop
99 al-device f alcCreateContext :> al-context
100 al-context [ device-name audio-context-not-available ] unless
101 al-context |alcDestroyContext drop
103 al-context alcSuspendContext
105 audio-engine new-disposable
106 voice-count >>voice-count
107 al-device >>al-device
108 al-context >>al-context
111 : <standard-audio-engine> ( -- engine )
112 f 16 <audio-engine> ;
116 : make-engine-current ( audio-engine -- )
117 al-context>> alcMakeContextCurrent drop ; inline
119 : allocate-sources ( audio-engine -- sources )
120 voice-count>> dup (uint-array) [ alGenSources ] keep ; inline
122 :: flush-source ( al-source -- )
123 al-source alSourceStop
124 0 c:<uint> :> dummy-buffer
125 al-source AL_BUFFERS_PROCESSED get-source-param [
126 al-source 1 dummy-buffer alSourceUnqueueBuffers
128 al-source AL_BUFFER 0 alSourcei ;
130 : free-sources ( sources -- )
131 [ length ] keep alDeleteSources ; inline
133 :: (get-available-source) ( sources source# stop-source# -- next-source# al-source/f )
134 source# sources nth :> al-source
135 source# 1 + sources length mod :> next-source#
137 [ AL_BUFFERS_PROCESSED get-source-param 0 = ]
138 [ AL_BUFFERS_QUEUED get-source-param 0 = ]
139 [ AL_SOURCE_STATE get-source-param { $ AL_INITIAL $ AL_STOPPED } member? ]
141 [ next-source# al-source ] [
142 next-source# stop-source# =
144 [ sources next-source# stop-source# (get-available-source) ] if
147 :: get-available-source ( audio-engine -- al-source/f )
148 audio-engine [ al-sources>> ] [ next-source>> ] bi dup (get-available-source)
149 :> ( next-source al-source )
150 audio-engine next-source >>next-source drop
153 :: queue-clip-buffer ( audio-clip al-buffer -- )
155 audio-clip al-source>> :> al-source
156 audio-clip generator>> :> generator
157 generator generate-audio :> ( data size )
159 size { [ not ] [ zero? ] } 1|| [
160 audio-clip t >>done? drop
162 al-buffer audio-clip openal-format data size audio-clip sample-rate>> alBufferData
163 al-source 1 al-buffer c:<uint> alSourceQueueBuffers
167 : update-listener ( audio-engine -- )
169 [ AL_POSITION swap audio-position first3 alListener3f ]
170 [ AL_GAIN swap audio-gain alListenerf ]
171 [ AL_VELOCITY swap audio-velocity first3 alListener3f ]
172 [ AL_ORIENTATION swap audio-orientation orientation>float-array alListenerfv ]
175 : update-source ( audio-clip -- )
176 [ al-source>> ] [ source>> ] bi {
177 [ AL_POSITION swap audio-position first3 alSource3f ]
178 [ AL_GAIN swap audio-gain alSourcef ]
179 [ AL_VELOCITY swap audio-velocity first3 alSource3f ]
180 [ AL_SOURCE_RELATIVE swap audio-relative? c:>c-bool alSourcei ]
181 [ AL_REFERENCE_DISTANCE swap audio-distance alSourcef ]
182 [ AL_ROLLOFF_FACTOR swap audio-rolloff alSourcef ]
185 GENERIC: (update-audio-clip) ( audio-clip -- )
187 M: static-audio-clip (update-audio-clip)
190 M:: streaming-audio-clip (update-audio-clip) ( audio-clip -- )
191 audio-clip al-source>> :> al-source
193 al-source AL_BUFFERS_PROCESSED get-source-param [
194 al-source 1 buffer alSourceUnqueueBuffers
195 audio-clip buffer c:*uint queue-clip-buffer
198 : update-audio-clip ( audio-clip -- )
200 dup al-source>> AL_SOURCE_STATE get-source-param AL_STOPPED =
201 [ dispose ] [ (update-audio-clip) ] if
204 : clip-al-sources ( clips -- length sources )
205 [ length ] [ [ al-source>> ] uint-array{ } map-as ] bi ;
211 : start-audio* ( audio-engine -- )
212 dup al-sources>> [ drop ] [
214 [ make-engine-current ]
215 [ al-context>> alcProcessContext ]
217 dup allocate-sources >>al-sources
226 : start-audio ( audio-engine -- )
228 dup '[ _ update-audio ] 20 milliseconds every >>update-alarm
231 : stop-audio ( audio-engine -- )
234 [ make-engine-current ]
235 [ update-alarm>> [ cancel-alarm ] when* ]
236 [ clips>> clone [ dispose ] each ]
237 [ al-sources>> free-sources ]
244 [ al-context>> alcSuspendContext ]
248 M: audio-engine dispose*
250 [ [ alcDestroyContext ] when* f ] change-al-context
251 [ [ alcCloseDevice* ] when* f ] change-al-device
254 :: <static-audio-clip> ( audio-engine source audio loop? -- audio-clip/f )
255 audio-engine get-available-source :> al-source
258 1 0 c:<uint> [ alGenBuffers ] keep c:*uint :> al-buffer
259 al-buffer audio { [ openal-format ] [ data>> ] [ size>> ] [ sample-rate>> ] } cleave
262 al-source AL_BUFFER al-buffer alSourcei
263 al-source AL_LOOPING loop? c:>c-bool alSourcei
265 static-audio-clip new-disposable
266 audio-engine >>audio-engine
268 al-source >>al-source
269 al-buffer >>al-buffer
271 clip audio-engine clips>> push
275 :: <streaming-audio-clip> ( audio-engine source generator buffer-count -- audio-clip/f )
276 audio-engine get-available-source :> al-source
279 buffer-count dup (uint-array) [ alGenBuffers ] keep :> al-buffers
280 generator generator-audio-format :> ( channels sample-bits sample-rate )
282 streaming-audio-clip new-disposable
283 audio-engine >>audio-engine
285 al-source >>al-source
286 generator >>generator
288 sample-bits >>sample-bits
289 sample-rate >>sample-rate
290 al-buffers >>al-buffers
292 al-buffers [ clip swap queue-clip-buffer ] each
293 clip audio-engine clips>> push
295 ] [ generator dispose f ] if ;
297 M: audio-clip dispose*
298 [ dup audio-engine>> clips>> remove! drop ]
299 [ al-source>> flush-source ] bi ;
301 M: static-audio-clip dispose*
303 [ [ 1 ] dip al-buffer>> c:<uint> alDeleteBuffers ] bi ;
305 M: streaming-audio-clip dispose*
307 [ generator>> dispose ]
308 [ al-buffers>> [ length ] keep alDeleteBuffers ] tri ;
310 : play-clip ( audio-clip -- )
312 [ al-source>> alSourcePlay ] bi ;
314 : play-clips ( audio-clips -- )
315 [ [ update-source ] each ]
316 [ clip-al-sources alSourcePlayv ] bi ;
318 : play-static-audio-clip ( audio-engine source audio loop? -- audio-clip/f )
319 <static-audio-clip> dup [ play-clip ] when* ;
321 : play-streaming-audio-clip ( audio-engine source generator buffer-count -- audio-clip/f )
322 <streaming-audio-clip> dup [ play-clip ] when* ;
324 : pause-clip ( audio-clip -- )
325 al-source>> alSourcePause ;
327 : pause-clips ( audio-clips -- )
328 clip-al-sources alSourcePausev ;
330 : stop-clip ( audio-clip -- )
333 : stop-clips ( audio-clips -- )
334 [ clip-al-sources alSourceStopv ]
335 [ [ dispose ] each ] bi ;
337 : update-audio ( audio-engine -- )
339 [ make-engine-current ]
341 [ clips>> clone [ update-audio-clip ] each ]