1 ! (c)2009 Joe Groff bsd license
2 USING: accessors alien alien.data audio classes.struct fry
3 calendar timers combinators combinators.short-circuit
4 destructors generalizations kernel literals locals math openal
5 sequences sequences.generalizations specialized-arrays strings ;
6 QUALIFIED-WITH: alien.c-types c
7 SPECIALIZED-ARRAYS: c:float c:uchar c:uint ;
11 { position initial: { 0.0 0.0 0.0 } }
12 { gain float initial: 1.0 }
13 { velocity initial: { 0.0 0.0 0.0 } }
14 { relative? boolean initial: f }
15 { distance float initial: 1.0 }
16 { rolloff float initial: 1.0 } ;
18 TUPLE: audio-orientation
19 { forward initial: { 0.0 0.0 -1.0 } }
20 { up initial: { 0.0 1.0 0.0 } } ;
22 C: <audio-orientation> audio-orientation
24 : orientation>float-array ( orientation -- float-array )
26 [ up>> first3 ] bi 6 float-array{ } nsequence ; inline
29 { position initial: { 0.0 0.0 0.0 } }
30 { gain float initial: 1.0 }
31 { velocity initial: { 0.0 0.0 0.0 } }
32 { orientation initial: T{ audio-orientation } } ;
34 GENERIC: audio-position ( source/listener -- position )
35 GENERIC: audio-gain ( source/listener -- gain )
36 GENERIC: audio-velocity ( source/listener -- velocity )
37 GENERIC: audio-relative? ( source -- relative? )
38 GENERIC: audio-distance ( source -- distance )
39 GENERIC: audio-rolloff ( source -- rolloff )
40 GENERIC: audio-orientation ( listener -- orientation )
42 M: object audio-position drop { 0.0 0.0 0.0 } ; inline
43 M: object audio-gain drop 1.0 ; inline
44 M: object audio-velocity drop { 0.0 0.0 0.0 } ; inline
45 M: object audio-relative? drop f ; inline
46 M: object audio-distance drop 1.0 ; inline
47 M: object audio-rolloff drop 1.0 ; inline
48 M: object audio-orientation drop T{ audio-orientation } ; inline
50 M: audio-source audio-position position>> ; inline
51 M: audio-source audio-gain gain>> ; inline
52 M: audio-source audio-velocity velocity>> ; inline
53 M: audio-source audio-relative? relative?>> ; inline
54 M: audio-source audio-distance distance>> ; inline
55 M: audio-source audio-rolloff rolloff>> ; inline
57 M: audio-listener audio-position position>> ; inline
58 M: audio-listener audio-gain gain>> ; inline
59 M: audio-listener audio-velocity velocity>> ; inline
60 M: audio-listener audio-orientation orientation>> ; inline
62 GENERIC: generate-audio ( generator -- c-ptr size )
63 GENERIC: generator-audio-format ( generator -- channels sample-bits sample-rate )
65 TUPLE: audio-engine < disposable
66 { voice-count integer }
71 { next-source integer }
75 TUPLE: audio-clip < disposable
76 { audio-engine audio-engine }
78 { al-source integer } ;
80 TUPLE: static-audio-clip < audio-clip
81 { al-buffer integer } ;
83 TUPLE: streaming-audio-clip < audio-clip
86 { sample-bits integer }
87 { sample-rate integer }
88 { al-buffers uint-array }
91 ERROR: audio-device-not-found device-name ;
92 ERROR: audio-context-not-available device-name ;
94 :: <audio-engine> ( device-name voice-count -- engine )
96 device-name alcOpenDevice :> al-device
97 al-device [ device-name audio-device-not-found ] unless
98 al-device |alcCloseDevice* drop
100 al-device f alcCreateContext :> al-context
101 al-context [ device-name audio-context-not-available ] unless
102 al-context |alcDestroyContext drop
104 al-context alcSuspendContext
106 audio-engine new-disposable
107 voice-count >>voice-count
108 al-device >>al-device
109 al-context >>al-context
112 : <standard-audio-engine> ( -- engine )
113 f 16 <audio-engine> ;
117 : make-engine-current ( audio-engine -- )
118 al-context>> alcMakeContextCurrent drop ; inline
120 : allocate-sources ( audio-engine -- sources )
121 voice-count>> dup c:uint (c-array) [ alGenSources ] keep ; inline
123 :: flush-source ( al-source -- )
124 al-source alSourceStop
125 0 c:uint <ref> :> dummy-buffer
126 al-source AL_BUFFERS_PROCESSED get-source-param [
127 al-source 1 dummy-buffer alSourceUnqueueBuffers
129 al-source AL_BUFFER 0 alSourcei ;
131 : free-sources ( sources -- )
132 [ length ] keep alDeleteSources ; inline
134 :: (get-available-source) ( sources source# stop-source# -- next-source# al-source/f )
135 source# sources nth :> al-source
136 source# 1 + sources length mod :> next-source#
138 [ AL_BUFFERS_PROCESSED get-source-param 0 = ]
139 [ AL_BUFFERS_QUEUED get-source-param 0 = ]
140 [ AL_SOURCE_STATE get-source-param { $ AL_INITIAL $ AL_STOPPED } member? ]
142 [ next-source# al-source ] [
143 next-source# stop-source# =
145 [ sources next-source# stop-source# (get-available-source) ] if
148 :: get-available-source ( audio-engine -- al-source/f )
149 audio-engine [ al-sources>> ] [ next-source>> ] bi dup (get-available-source)
150 :> ( next-source al-source )
151 audio-engine next-source >>next-source drop
154 :: queue-clip-buffer ( audio-clip al-buffer -- )
156 audio-clip al-source>> :> al-source
157 audio-clip generator>> :> generator
158 generator generate-audio :> ( data size )
160 size { [ not ] [ zero? ] } 1|| [
161 audio-clip t >>done? drop
163 al-buffer audio-clip openal-format data size audio-clip sample-rate>> alBufferData
164 al-source 1 al-buffer c:uint <ref> alSourceQueueBuffers
168 : update-listener ( audio-engine -- )
170 [ AL_POSITION swap audio-position first3 alListener3f ]
171 [ AL_GAIN swap audio-gain alListenerf ]
172 [ AL_VELOCITY swap audio-velocity first3 alListener3f ]
173 [ AL_ORIENTATION swap audio-orientation orientation>float-array alListenerfv ]
176 : update-source ( audio-clip -- )
177 [ al-source>> ] [ source>> ] bi {
178 [ AL_POSITION swap audio-position first3 alSource3f ]
179 [ AL_GAIN swap audio-gain alSourcef ]
180 [ AL_VELOCITY swap audio-velocity first3 alSource3f ]
181 [ AL_SOURCE_RELATIVE swap audio-relative? c:>c-bool alSourcei ]
182 [ AL_REFERENCE_DISTANCE swap audio-distance alSourcef ]
183 [ AL_ROLLOFF_FACTOR swap audio-rolloff alSourcef ]
186 GENERIC: (update-audio-clip) ( audio-clip -- )
188 M: static-audio-clip (update-audio-clip)
191 M:: streaming-audio-clip (update-audio-clip) ( audio-clip -- )
192 audio-clip al-source>> :> al-source
193 0 c:uint <ref> :> buffer
194 al-source AL_BUFFERS_PROCESSED get-source-param [
195 al-source 1 buffer alSourceUnqueueBuffers
196 audio-clip buffer c:uint deref queue-clip-buffer
199 : update-audio-clip ( audio-clip -- )
201 dup al-source>> AL_SOURCE_STATE get-source-param AL_STOPPED =
202 [ dispose ] [ (update-audio-clip) ] if
205 : clip-al-sources ( clips -- length sources )
206 [ length ] [ [ al-source>> ] uint-array{ } map-as ] bi ;
212 : start-audio* ( audio-engine -- )
213 dup al-sources>> [ drop ] [
215 [ make-engine-current ]
216 [ al-context>> alcProcessContext ]
218 dup allocate-sources >>al-sources
227 : start-audio ( audio-engine -- )
229 dup '[ _ update-audio ] 20 milliseconds every >>update-timer
232 : stop-audio ( audio-engine -- )
235 [ make-engine-current ]
236 [ update-timer>> [ stop-timer ] when* ]
237 [ clips>> clone [ dispose ] each ]
238 [ al-sources>> free-sources ]
245 [ al-context>> alcSuspendContext ]
249 M: audio-engine dispose*
251 [ [ alcDestroyContext ] when* f ] change-al-context
252 [ [ alcCloseDevice* ] when* f ] change-al-device
255 :: <static-audio-clip> ( audio-engine source audio loop? -- audio-clip/f )
256 audio-engine get-available-source :> al-source
259 1 0 c:uint <ref> [ alGenBuffers ] keep c:uint deref :> al-buffer
260 al-buffer audio { [ openal-format ] [ data>> ] [ size>> ] [ sample-rate>> ] } cleave
263 al-source AL_BUFFER al-buffer alSourcei
264 al-source AL_LOOPING loop? c:>c-bool alSourcei
266 static-audio-clip new-disposable
267 audio-engine >>audio-engine
269 al-source >>al-source
270 al-buffer >>al-buffer
272 clip audio-engine clips>> push
276 :: <streaming-audio-clip> ( audio-engine source generator buffer-count -- audio-clip/f )
277 audio-engine get-available-source :> al-source
280 buffer-count dup c:uint (c-array) [ alGenBuffers ] keep :> al-buffers
281 generator generator-audio-format :> ( channels sample-bits sample-rate )
283 streaming-audio-clip new-disposable
284 audio-engine >>audio-engine
286 al-source >>al-source
287 generator >>generator
289 sample-bits >>sample-bits
290 sample-rate >>sample-rate
291 al-buffers >>al-buffers
293 al-buffers [ clip swap queue-clip-buffer ] each
294 clip audio-engine clips>> push
296 ] [ generator dispose f ] if ;
298 M: audio-clip dispose*
299 [ dup audio-engine>> clips>> remove! drop ]
300 [ al-source>> flush-source ] bi ;
302 M: static-audio-clip dispose*
304 [ [ 1 ] dip al-buffer>> c:uint <ref> alDeleteBuffers ] bi ;
306 M: streaming-audio-clip dispose*
308 [ generator>> dispose ]
309 [ al-buffers>> [ length ] keep alDeleteBuffers ] tri ;
311 : play-clip ( audio-clip -- )
313 [ al-source>> alSourcePlay ] bi ;
315 : play-clips ( audio-clips -- )
316 [ [ update-source ] each ]
317 [ clip-al-sources alSourcePlayv ] bi ;
319 : play-static-audio-clip ( audio-engine source audio loop? -- audio-clip/f )
320 <static-audio-clip> dup [ play-clip ] when* ;
322 : play-streaming-audio-clip ( audio-engine source generator buffer-count -- audio-clip/f )
323 <streaming-audio-clip> dup [ play-clip ] when* ;
325 : pause-clip ( audio-clip -- )
326 al-source>> alSourcePause ;
328 : pause-clips ( audio-clips -- )
329 clip-al-sources alSourcePausev ;
331 : stop-clip ( audio-clip -- )
334 : stop-clips ( audio-clips -- )
335 [ clip-al-sources alSourceStopv ]
336 [ [ dispose ] each ] bi ;
338 : update-audio ( audio-engine -- )
340 [ make-engine-current ]
342 [ clips>> clone [ update-audio-clip ] each ]