extra/audio/engine/engine.factor

   1 ! Copyright (C) 2009 Joe Groff.
   2 ! See http://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 ;
   9 IN: audio.engine
  10
  11 TUPLE: audio-source
  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 } ;
  18
  19 TUPLE: audio-orientation-state
  20     { forward initial: { 0.0 0.0 -1.0 } }
  21     { up initial: { 0.0 1.0 0.0 } } ;
  22
  23 C: <audio-orientation-state> audio-orientation-state
  24
  25 : orientation>float-array ( orientation -- float-array )
  26     [ forward>> first3 ]
  27     [ up>> first3 ] bi 6 float-array{ } nsequence ; inline
  28
  29 TUPLE: audio-listener
  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 } } ;
  34
  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 )
  42
  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
  50
  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
  57
  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
  62
  63 GENERIC: generate-audio ( generator -- c-ptr size )
  64 GENERIC: generator-audio-format ( generator -- channels sample-bits sample-rate )
  65
  66 TUPLE: audio-engine < disposable
  67     { voice-count integer }
  68     { al-device c-ptr }
  69     { al-context c-ptr }
  70     al-sources
  71     listener
  72     { next-source integer }
  73     clips
  74     update-timer ;
  75
  76 TUPLE: audio-clip < disposable
  77     { audio-engine audio-engine }
  78     source
  79     { al-source integer } ;
  80
  81 TUPLE: static-audio-clip < audio-clip
  82     { al-buffer integer } ;
  83
  84 TUPLE: streaming-audio-clip < audio-clip
  85     generator
  86     { channels integer }
  87     { sample-bits integer }
  88     { sample-rate integer }
  89     { al-buffers uint-array }
  90     { done? boolean } ;
  91
  92 ERROR: audio-device-not-found device-name ;
  93 ERROR: audio-context-not-available device-name ;
  94
  95 :: <audio-engine> ( device-name voice-count -- engine )
  96     [
  97         device-name alcOpenDevice :> al-device
  98         al-device [ device-name audio-device-not-found ] unless
  99         al-device |alcCloseDevice* drop
 100
 101         al-device f alcCreateContext :> al-context
 102         al-context [ device-name audio-context-not-available ] unless
 103         al-context |alcDestroyContext drop
 104
 105         al-context alcSuspendContext
 106
 107         audio-engine new-disposable
 108             voice-count >>voice-count
 109             al-device >>al-device
 110             al-context >>al-context
 111     ] with-destructors ;
 112
 113 : <standard-audio-engine> ( -- engine )
 114     f 16 <audio-engine> ;
 115
 116 <PRIVATE
 117
 118 : make-engine-current ( audio-engine -- )
 119     al-context>> alcMakeContextCurrent drop ; inline
 120
 121 : allocate-sources ( audio-engine -- sources )
 122     voice-count>> dup c:uint (c-array) [ alGenSources ] keep ; inline
 123
 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
 129     ] times
 130     al-source AL_BUFFER 0 alSourcei ;
 131
 132 : free-sources ( sources -- )
 133     [ length ] keep alDeleteSources ; inline
 134
 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#
 138     al-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? ]
 142     } 1&&
 143     [ next-source# al-source ] [
 144         next-source# stop-source# =
 145         [ next-source# f ]
 146         [ sources next-source# stop-source# (get-available-source) ] if
 147     ] if ;
 148
 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
 153     al-source ;
 154
 155 :: queue-clip-buffer ( audio-clip al-buffer -- )
 156     audio-clip done?>> [
 157         audio-clip al-source>> :> al-source
 158         audio-clip generator>> :> generator
 159         generator generate-audio :> ( data size )
 160
 161         size { [ not ] [ zero? ] } 1|| [
 162             audio-clip t >>done? drop
 163         ] [
 164             al-buffer audio-clip openal-format data size audio-clip sample-rate>> alBufferData
 165             al-source 1 al-buffer c:uint <ref> alSourceQueueBuffers
 166         ] if
 167     ] unless ;
 168
 169 : update-listener ( audio-engine -- )
 170     listener>> {
 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 ]
 175     } cleave ;
 176
 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 ]
 185     } 2cleave ;
 186
 187 GENERIC: (update-audio-clip) ( audio-clip -- )
 188
 189 M: static-audio-clip (update-audio-clip)
 190     drop ;
 191
 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
 198     ] times ;
 199
 200 : update-audio-clip ( audio-clip -- )
 201     [ update-source ] [
 202         dup al-source>> AL_SOURCE_STATE get-source-param AL_STOPPED =
 203         [ dispose ] [ (update-audio-clip) ] if
 204     ] bi ;
 205
 206 : clip-al-sources ( clips -- length sources )
 207     [ length ] [ [ al-source>> ] uint-array{ } map-as ] bi ;
 208
 209 PRIVATE>
 210
 211 DEFER: update-audio
 212
 213 : start-audio* ( audio-engine -- )
 214     dup al-sources>> [ drop ] [
 215         {
 216             [ make-engine-current ]
 217             [ al-context>> alcProcessContext ]
 218             [
 219                 dup allocate-sources >>al-sources
 220                 0 >>next-source
 221                 V{ } clone >>clips
 222                 drop
 223             ]
 224             [ update-listener ]
 225         } cleave
 226     ] if ;
 227
 228 : start-audio ( audio-engine -- )
 229     dup start-audio*
 230     dup '[ _ update-audio ] 20 milliseconds every >>update-timer
 231     drop ;
 232
 233 : stop-audio ( audio-engine -- )
 234     dup al-sources>> [
 235         {
 236             [ make-engine-current ]
 237             [ update-timer>> [ stop-timer ] when* ]
 238             [ clips>> clone [ dispose ] each ]
 239             [ al-sources>> free-sources ]
 240             [
 241                 f >>al-sources
 242                 f >>clips
 243                 f >>update-timer
 244                 drop
 245             ]
 246             [ al-context>> alcSuspendContext ]
 247         } cleave
 248     ] [ drop ] if ;
 249
 250 M: audio-engine dispose*
 251     dup stop-audio
 252     [ [ alcDestroyContext ] when* f ] change-al-context
 253     [ [ alcCloseDevice*   ] when* f ] change-al-device
 254     drop ;
 255
 256 :: <static-audio-clip> ( audio-engine source audio loop? -- audio-clip/f )
 257     audio-engine get-available-source :> al-source
 258
 259     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
 262             alBufferData
 263
 264         al-source AL_BUFFER al-buffer alSourcei
 265         al-source AL_LOOPING loop? c:>c-bool alSourcei
 266
 267         static-audio-clip new-disposable
 268             audio-engine >>audio-engine
 269             source >>source
 270             al-source >>al-source
 271             al-buffer >>al-buffer
 272             :> clip
 273         clip audio-engine clips>> push
 274         clip
 275     ] [ f ] if ;
 276
 277 :: <streaming-audio-clip> ( audio-engine source generator buffer-count -- audio-clip/f )
 278     audio-engine get-available-source :> al-source
 279
 280     al-source [
 281         buffer-count dup c:uint (c-array) [ alGenBuffers ] keep :> al-buffers
 282         generator generator-audio-format :> ( channels sample-bits sample-rate )
 283
 284         streaming-audio-clip new-disposable
 285             audio-engine >>audio-engine
 286             source >>source
 287             al-source >>al-source
 288             generator >>generator
 289             channels >>channels
 290             sample-bits >>sample-bits
 291             sample-rate >>sample-rate
 292             al-buffers >>al-buffers
 293             :> clip
 294         al-buffers [ clip swap queue-clip-buffer ] each
 295         clip audio-engine clips>> push
 296         clip
 297     ] [ generator dispose f ] if ;
 298
 299 M: audio-clip dispose*
 300     [ dup audio-engine>> clips>> remove! drop ]
 301     [ al-source>> flush-source ] bi ;
 302
 303 M: static-audio-clip dispose*
 304     [ call-next-method ]
 305     [ [ 1 ] dip al-buffer>> c:uint <ref> alDeleteBuffers ] bi ;
 306
 307 M: streaming-audio-clip dispose*
 308     [ call-next-method ]
 309     [ generator>> dispose ]
 310     [ al-buffers>> [ length ] keep alDeleteBuffers ] tri ;
 311
 312 : play-clip ( audio-clip -- )
 313     [ update-source ]
 314     [ al-source>> alSourcePlay ] bi ;
 315
 316 : play-clips ( audio-clips -- )
 317     [ [ update-source ] each ]
 318     [ clip-al-sources alSourcePlayv ] bi ;
 319
 320 : play-static-audio-clip ( audio-engine source audio loop? -- audio-clip/f )
 321     <static-audio-clip> dup [ play-clip ] when* ;
 322
 323 : play-streaming-audio-clip ( audio-engine source generator buffer-count -- audio-clip/f )
 324     <streaming-audio-clip> dup [ play-clip ] when* ;
 325
 326 : pause-clip ( audio-clip -- )
 327     al-source>> alSourcePause ;
 328
 329 : pause-clips ( audio-clips -- )
 330     clip-al-sources alSourcePausev ;
 331
 332 : stop-clip ( audio-clip -- )
 333     dispose ;
 334
 335 : stop-clips ( audio-clips -- )
 336     [ clip-al-sources alSourceStopv ]
 337     [ [ dispose ] each ] bi ;
 338
 339 : update-audio ( audio-engine -- )
 340     {
 341         [ make-engine-current ]
 342         [ update-listener ]
 343         [ clips>> clone [ update-audio-clip ] each ]
 344     } cleave ;