1 ! Copyright (C) 2009 Joe Groff.
2 ! See https://factorcode.org/license.txt for BSD license.
3 USING: accessors alien alien.data audio calendar
4 combinators combinators.short-circuit destructors kernel
5 literals math openal sequences sequences.generalizations
6 specialized-arrays timers ;
7 QUALIFIED-WITH: alien.c-types c
8 SPECIALIZED-ARRAYS: c:float c:uchar c:uint ;
12 { position initial: { 0.0 0.0 0.0 } }
13 { gain float initial: 1.0 }
14 { velocity initial: { 0.0 0.0 0.0 } }
15 { relative? boolean initial: f }
16 { distance float initial: 1.0 }
17 { rolloff float initial: 1.0 } ;
19 TUPLE: audio-orientation-state
20 { forward initial: { 0.0 0.0 -1.0 } }
21 { up initial: { 0.0 1.0 0.0 } } ;
23 C: <audio-orientation-state> audio-orientation-state
25 : orientation>float-array ( orientation -- float-array )
27 [ up>> first3 ] bi 6 float-array{ } nsequence ; inline
30 { position initial: { 0.0 0.0 0.0 } }
31 { gain float initial: 1.0 }
32 { velocity initial: { 0.0 0.0 0.0 } }
33 { orientation initial: T{ audio-orientation-state } } ;
35 GENERIC: audio-position ( source/listener -- position )
36 GENERIC: audio-gain ( source/listener -- gain )
37 GENERIC: audio-velocity ( source/listener -- velocity )
38 GENERIC: audio-relative? ( source -- relative? )
39 GENERIC: audio-distance ( source -- distance )
40 GENERIC: audio-rolloff ( source -- rolloff )
41 GENERIC: audio-orientation ( listener -- orientation )
43 M: object audio-position drop { 0.0 0.0 0.0 } ; inline
44 M: object audio-gain drop 1.0 ; inline
45 M: object audio-velocity drop { 0.0 0.0 0.0 } ; inline
46 M: object audio-relative? drop f ; inline
47 M: object audio-distance drop 1.0 ; inline
48 M: object audio-rolloff drop 1.0 ; inline
49 M: object audio-orientation drop T{ audio-orientation-state } ; inline
51 M: audio-source audio-position position>> ; inline
52 M: audio-source audio-gain gain>> ; inline
53 M: audio-source audio-velocity velocity>> ; inline
54 M: audio-source audio-relative? relative?>> ; inline
55 M: audio-source audio-distance distance>> ; inline
56 M: audio-source audio-rolloff rolloff>> ; inline
58 M: audio-listener audio-position position>> ; inline
59 M: audio-listener audio-gain gain>> ; inline
60 M: audio-listener audio-velocity velocity>> ; inline
61 M: audio-listener audio-orientation orientation>> ; inline
63 GENERIC: generate-audio ( generator -- c-ptr size )
64 GENERIC: generator-audio-format ( generator -- channels sample-bits sample-rate )
66 TUPLE: audio-engine < disposable
67 { voice-count integer }
72 { next-source integer }
76 TUPLE: audio-clip < disposable
77 { audio-engine audio-engine }
79 { al-source integer } ;
81 TUPLE: static-audio-clip < audio-clip
82 { al-buffer integer } ;
84 TUPLE: streaming-audio-clip < audio-clip
87 { sample-bits integer }
88 { sample-rate integer }
89 { al-buffers uint-array }
92 ERROR: audio-device-not-found device-name ;
93 ERROR: audio-context-not-available device-name ;
95 :: <audio-engine> ( device-name voice-count -- engine )
97 device-name alcOpenDevice :> al-device
98 al-device [ device-name audio-device-not-found ] unless
99 al-device |alcCloseDevice* drop
101 al-device f alcCreateContext :> al-context
102 al-context [ device-name audio-context-not-available ] unless
103 al-context |alcDestroyContext drop
105 al-context alcSuspendContext
107 audio-engine new-disposable
108 voice-count >>voice-count
109 al-device >>al-device
110 al-context >>al-context
113 : <standard-audio-engine> ( -- engine )
114 f 16 <audio-engine> ;
118 : make-engine-current ( audio-engine -- )
119 al-context>> alcMakeContextCurrent drop ; inline
121 : allocate-sources ( audio-engine -- sources )
122 voice-count>> dup c:uint (c-array) [ alGenSources ] keep ; inline
124 :: flush-source ( al-source -- )
125 al-source alSourceStop
126 0 c:uint <ref> :> dummy-buffer
127 al-source AL_BUFFERS_PROCESSED get-source-param [
128 al-source 1 dummy-buffer alSourceUnqueueBuffers
130 al-source AL_BUFFER 0 alSourcei ;
132 : free-sources ( sources -- )
133 [ length ] keep alDeleteSources ; inline
135 :: (get-available-source) ( sources source# stop-source# -- next-source# al-source/f )
136 source# sources nth :> al-source
137 source# 1 + sources length mod :> next-source#
139 [ AL_BUFFERS_PROCESSED get-source-param 0 = ]
140 [ AL_BUFFERS_QUEUED get-source-param 0 = ]
141 [ AL_SOURCE_STATE get-source-param { $ AL_INITIAL $ AL_STOPPED } member? ]
143 [ next-source# al-source ] [
144 next-source# stop-source# =
146 [ sources next-source# stop-source# (get-available-source) ] if
149 :: get-available-source ( audio-engine -- al-source/f )
150 audio-engine [ al-sources>> ] [ next-source>> ] bi dup (get-available-source)
151 :> ( next-source al-source )
152 audio-engine next-source >>next-source drop
155 :: queue-clip-buffer ( audio-clip al-buffer -- )
157 audio-clip al-source>> :> al-source
158 audio-clip generator>> :> generator
159 generator generate-audio :> ( data size )
161 size { [ not ] [ zero? ] } 1|| [
162 audio-clip t >>done? drop
164 al-buffer audio-clip openal-format data size audio-clip sample-rate>> alBufferData
165 al-source 1 al-buffer c:uint <ref> alSourceQueueBuffers
169 : update-listener ( audio-engine -- )
171 [ AL_POSITION swap audio-position first3 alListener3f ]
172 [ AL_GAIN swap audio-gain alListenerf ]
173 [ AL_VELOCITY swap audio-velocity first3 alListener3f ]
174 [ AL_ORIENTATION swap audio-orientation orientation>float-array alListenerfv ]
177 : update-source ( audio-clip -- )
178 [ al-source>> ] [ source>> ] bi {
179 [ AL_POSITION swap audio-position first3 alSource3f ]
180 [ AL_GAIN swap audio-gain alSourcef ]
181 [ AL_VELOCITY swap audio-velocity first3 alSource3f ]
182 [ AL_SOURCE_RELATIVE swap audio-relative? c:>c-bool alSourcei ]
183 [ AL_REFERENCE_DISTANCE swap audio-distance alSourcef ]
184 [ AL_ROLLOFF_FACTOR swap audio-rolloff alSourcef ]
187 GENERIC: (update-audio-clip) ( audio-clip -- )
189 M: static-audio-clip (update-audio-clip)
192 M:: streaming-audio-clip (update-audio-clip) ( audio-clip -- )
193 audio-clip al-source>> :> al-source
194 0 c:uint <ref> :> buffer
195 al-source AL_BUFFERS_PROCESSED get-source-param [
196 al-source 1 buffer alSourceUnqueueBuffers
197 audio-clip buffer c:uint deref queue-clip-buffer
200 : update-audio-clip ( audio-clip -- )
202 dup al-source>> AL_SOURCE_STATE get-source-param AL_STOPPED =
203 [ dispose ] [ (update-audio-clip) ] if
206 : clip-al-sources ( clips -- length sources )
207 [ length ] [ [ al-source>> ] uint-array{ } map-as ] bi ;
213 : start-audio* ( audio-engine -- )
214 dup al-sources>> [ drop ] [
216 [ make-engine-current ]
217 [ al-context>> alcProcessContext ]
219 dup allocate-sources >>al-sources
228 : start-audio ( audio-engine -- )
230 dup '[ _ update-audio ] 20 milliseconds every >>update-timer
233 : stop-audio ( audio-engine -- )
236 [ make-engine-current ]
237 [ update-timer>> [ stop-timer ] when* ]
238 [ clips>> clone [ dispose ] each ]
239 [ al-sources>> free-sources ]
246 [ al-context>> alcSuspendContext ]
250 M: audio-engine dispose*
252 [ [ alcDestroyContext ] when* f ] change-al-context
253 [ [ alcCloseDevice* ] when* f ] change-al-device
256 :: <static-audio-clip> ( audio-engine source audio loop? -- audio-clip/f )
257 audio-engine get-available-source :> al-source
260 1 0 c:uint <ref> [ alGenBuffers ] keep c:uint deref :> al-buffer
261 al-buffer audio { [ openal-format ] [ data>> ] [ size>> ] [ sample-rate>> ] } cleave
264 al-source AL_BUFFER al-buffer alSourcei
265 al-source AL_LOOPING loop? c:>c-bool alSourcei
267 static-audio-clip new-disposable
268 audio-engine >>audio-engine
270 al-source >>al-source
271 al-buffer >>al-buffer
273 clip audio-engine clips>> push
277 :: <streaming-audio-clip> ( audio-engine source generator buffer-count -- audio-clip/f )
278 audio-engine get-available-source :> al-source
281 buffer-count dup c:uint (c-array) [ alGenBuffers ] keep :> al-buffers
282 generator generator-audio-format :> ( channels sample-bits sample-rate )
284 streaming-audio-clip new-disposable
285 audio-engine >>audio-engine
287 al-source >>al-source
288 generator >>generator
290 sample-bits >>sample-bits
291 sample-rate >>sample-rate
292 al-buffers >>al-buffers
294 al-buffers [ clip swap queue-clip-buffer ] each
295 clip audio-engine clips>> push
297 ] [ generator dispose f ] if ;
299 M: audio-clip dispose*
300 [ dup audio-engine>> clips>> remove! drop ]
301 [ al-source>> flush-source ] bi ;
303 M: static-audio-clip dispose*
305 [ [ 1 ] dip al-buffer>> c:uint <ref> alDeleteBuffers ] bi ;
307 M: streaming-audio-clip dispose*
309 [ generator>> dispose ]
310 [ al-buffers>> [ length ] keep alDeleteBuffers ] tri ;
312 : play-clip ( audio-clip -- )
314 [ al-source>> alSourcePlay ] bi ;
316 : play-clips ( audio-clips -- )
317 [ [ update-source ] each ]
318 [ clip-al-sources alSourcePlayv ] bi ;
320 : play-static-audio-clip ( audio-engine source audio loop? -- audio-clip/f )
321 <static-audio-clip> dup [ play-clip ] when* ;
323 : play-streaming-audio-clip ( audio-engine source generator buffer-count -- audio-clip/f )
324 <streaming-audio-clip> dup [ play-clip ] when* ;
326 : pause-clip ( audio-clip -- )
327 al-source>> alSourcePause ;
329 : pause-clips ( audio-clips -- )
330 clip-al-sources alSourcePausev ;
332 : stop-clip ( audio-clip -- )
335 : stop-clips ( audio-clips -- )
336 [ clip-al-sources alSourceStopv ]
337 [ [ dispose ] each ] bi ;
339 : update-audio ( audio-engine -- )
341 [ make-engine-current ]
343 [ clips>> clone [ update-audio-clip ] each ]