extra/audio/engine/engine.factor

   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 ;
   7 IN: audio.engine
   8
   9 TUPLE: audio-source
  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
  15 TUPLE: audio-orientation
  16     { forward initial: { 0.0 0.0 -1.0 } }
  17     { up initial: { 0.0 1.0 0.0 } } ;
  18
  19 : orientation>float-array ( orientation -- float-array )
  20     [ forward>> first3 ]
  21     [ up>> first3 ] bi 6 float-array{ } nsequence ; inline
  22
  23 TUPLE: audio-listener
  24     { position initial: { 0.0 0.0 0.0 } }
  25     { gain float initial: 1.0 }
  26     { velocity initial: { 0.0 0.0 0.0 } }
  27     { orientation initial: T{ audio-orientation } } ;
  28
  29 TUPLE: audio-engine < disposable
  30     { voice-count integer }
  31     { buffer-size integer }
  32     { buffer-count integer }
  33     { al-device c-ptr }
  34     { al-context c-ptr }
  35     al-sources
  36     { listener audio-listener }
  37     { next-source integer }
  38     clips
  39     update-alarm ;
  40
  41 TUPLE: audio-clip < disposable
  42     { audio-engine audio-engine }
  43     { audio audio }
  44     { source audio-source }
  45     { loop? boolean }
  46     { al-source integer }
  47     { al-buffers uint-array }
  48     { next-data-offset integer } ;
  49
  50 ERROR: audio-device-not-found device-name ;
  51 ERROR: audio-context-not-available device-name ;
  52
  53 :: <audio-engine> ( device-name voice-count buffer-size buffer-count -- engine )
  54     [
  55         device-name alcOpenDevice :> al-device
  56         al-device [ device-name audio-device-not-found ] unless
  57         al-device |alcCloseDevice* drop
  58
  59         al-device f alcCreateContext :> al-context
  60         al-context [ device-name audio-context-not-available ] unless
  61         al-context |alcDestroyContext drop
  62
  63         al-context alcSuspendContext
  64
  65         audio-engine new-disposable
  66             voice-count >>voice-count
  67             al-device >>al-device
  68             al-context >>al-context
  69             buffer-size >>buffer-size
  70             buffer-count >>buffer-count
  71     ] with-destructors ;
  72
  73 : <standard-audio-engine> ( -- engine )
  74     f 16 8192 2 <audio-engine> ;
  75
  76 <PRIVATE
  77
  78 : make-engine-current ( audio-engine -- )
  79     al-context>> alcMakeContextCurrent drop ; inline
  80
  81 : allocate-sources ( audio-engine -- sources )
  82     voice-count>> dup (uint-array) [ alGenSources ] keep ; inline
  83
  84 :: flush-source ( source -- )
  85     source alSourceStop
  86     0 c:<uint> :> dummy-buffer
  87     source AL_BUFFERS_PROCESSED get-source-param [
  88         source 1 dummy-buffer alSourceUnqueueBuffers
  89     ] times ;
  90
  91 : free-sources ( sources -- )
  92     [ length ] keep alDeleteSources ; inline
  93
  94 :: (get-available-source) ( sources source# stop-source# -- next-source# al-source/f )
  95     source# sources nth :> al-source
  96     source# 1 + sources length mod :> next-source#
  97     al-source {
  98         [ AL_BUFFERS_PROCESSED get-source-param 0 = ]
  99         [ AL_BUFFERS_QUEUED get-source-param 0 = ]
 100         [ AL_SOURCE_STATE get-source-param { $ AL_INITIAL $ AL_STOPPED } member? ]
 101     } 1&&
 102     [ next-source# al-source ] [
 103         next-source# stop-source# =
 104         [ next-source# f ]
 105         [ sources next-source# stop-source# (get-available-source) ] if
 106     ] if ;
 107
 108 :: get-available-source ( audio-engine -- al-source/f )
 109     audio-engine [ al-sources>> ] [ next-source>> ] bi dup (get-available-source)
 110         :> ( next-source al-source )
 111     audio-engine next-source >>next-source drop
 112     al-source ;
 113
 114 :: (queue-clip-buffer) ( audio-clip al-buffer audio data size -- )
 115     al-buffer audio openal-format data size audio sample-rate>> alBufferData
 116     audio-clip al-source>> 1 al-buffer c:<uint> alSourceQueueBuffers
 117
 118     audio-clip [ size + ] change-next-data-offset drop ; inline
 119
 120 :: queue-clip-buffer ( audio-clip al-buffer -- )
 121     audio-clip audio-engine>> :> audio-engine
 122     audio-engine buffer-size>> :> buffer-size
 123     audio-clip audio>> :> audio
 124     audio-clip next-data-offset>> :> next-data-offset
 125     audio size>> next-data-offset - :> remaining-audio
 126
 127     {
 128         { [ remaining-audio 0 <= ] [
 129             audio-clip loop?>> [
 130                 audio-clip 0 >>next-data-offset
 131                 al-buffer queue-clip-buffer
 132             ] when
 133         ] }
 134         { [ remaining-audio buffer-size < ] [
 135             audio-clip loop?>> [
 136                 audio data>>
 137                 [ next-data-offset swap <displaced-alien> remaining-audio <direct-uchar-array> ]
 138                 [ buffer-size remaining-audio - <direct-uchar-array> ] bi append :> data
 139                 audio-clip al-buffer audio data buffer-size (queue-clip-buffer)
 140
 141                 audio-clip [ audio size>> mod ] change-next-data-offset drop
 142             ] [
 143                 next-data-offset audio data>> <displaced-alien> :> data
 144                 audio-clip al-buffer audio data remaining-audio (queue-clip-buffer)
 145             ] if
 146         ] }
 147         [
 148             next-data-offset audio data>> <displaced-alien> :> data
 149             audio-clip al-buffer audio data buffer-size (queue-clip-buffer)
 150         ]
 151     } cond ;
 152
 153 : update-listener ( audio-engine -- )
 154     listener>> {
 155         [ AL_POSITION swap position>> first3 alListener3f ]
 156         [ AL_GAIN swap gain>> alListenerf ]
 157         [ AL_VELOCITY swap velocity>> first3 alListener3f ]
 158         [ AL_ORIENTATION swap orientation>> orientation>float-array alListenerfv ]
 159     } cleave ;
 160
 161 : update-source ( audio-clip -- )
 162     [ al-source>> ] [ source>> ] bi {
 163         [ AL_POSITION swap position>> first3 alSource3f ]
 164         [ AL_GAIN swap gain>> alSourcef ]
 165         [ AL_VELOCITY swap velocity>> first3 alSource3f ]
 166         [ AL_SOURCE_RELATIVE swap relative?>> c:>c-bool alSourcei ]
 167     } 2cleave ;
 168
 169 :: update-audio-clip ( audio-clip -- )
 170     audio-clip update-source
 171     audio-clip al-source>> :> al-source
 172     0 c:<uint> :> buffer*
 173
 174     al-source AL_SOURCE_STATE get-source-param AL_STOPPED =
 175     [ audio-clip dispose ] [
 176         al-source AL_BUFFERS_PROCESSED get-source-param [
 177             al-source 1 buffer* alSourceUnqueueBuffers
 178             audio-clip buffer* c:*uint queue-clip-buffer
 179         ] times
 180     ] if ;
 181
 182 PRIVATE>
 183
 184 DEFER: update-audio
 185
 186 : start-audio* ( audio-engine -- )
 187     dup al-sources>> [ drop ] [
 188         {
 189             [ make-engine-current ]
 190             [ al-context>> alcProcessContext ]
 191             [
 192                 dup allocate-sources >>al-sources
 193                 0 >>next-source
 194                 V{ } clone >>clips
 195                 drop
 196             ]
 197             [ update-listener ]
 198         } cleave
 199     ] if ;
 200
 201 : start-audio ( audio-engine -- )
 202     dup start-audio*
 203     dup '[ _ update-audio ] 20 milliseconds every >>update-alarm
 204     drop ;
 205
 206 : stop-audio ( audio-engine -- )
 207     dup al-sources>> [
 208         {
 209             [ make-engine-current ]
 210             [ update-alarm>> [ cancel-alarm ] when* ]
 211             [ clips>> clone [ dispose ] each ]
 212             [ al-sources>> free-sources ]
 213             [
 214                 f >>al-sources
 215                 f >>clips
 216                 f >>update-alarm
 217                 drop
 218             ]
 219             [ al-context>> alcSuspendContext ]
 220         } cleave
 221     ] [ drop ] if ;
 222
 223 M: audio-engine dispose*
 224     dup stop-audio
 225     [ [ alcDestroyContext ] when* f ] change-al-context
 226     [ [ alcCloseDevice*   ] when* f ] change-al-device
 227     drop ;
 228
 229 :: (audio-clip) ( audio-engine audio source loop? -- audio-clip/f )
 230     audio-engine get-available-source :> al-source
 231
 232     al-source [
 233         audio-engine buffer-count>> :> buffer-count
 234         buffer-count dup (uint-array) [ alGenBuffers ] keep :> al-buffers
 235
 236         audio-clip new-disposable
 237             audio-engine >>audio-engine
 238             audio >>audio
 239             source >>source
 240             loop? >>loop?
 241             al-source >>al-source
 242             al-buffers >>al-buffers
 243             0 >>next-data-offset :> clip
 244         al-buffers [ clip swap queue-clip-buffer ] each
 245         clip audio-engine clips>> push
 246
 247         clip
 248     ] [ f ] if ;
 249
 250 M: audio-clip dispose*
 251     {
 252         [ al-source>> flush-source ]
 253         [ al-buffers>> [ length ] keep alDeleteBuffers ]
 254         [ dup audio-engine>> clips>> remove! drop ]
 255     } cleave ;
 256
 257 : play-clip ( audio-clip -- )
 258     [ update-source ]
 259     [ al-source>> alSourcePlay ] bi ;
 260
 261 : <audio-clip> ( audio-engine audio source loop? -- audio-clip/f )
 262     (audio-clip) dup play-clip ;
 263
 264 : pause-clip ( audio-clip -- )
 265     al-source>> alSourcePause ;
 266
 267 : stop-clip ( audio-clip -- )
 268     dispose ;
 269
 270 : update-audio ( audio-engine -- )
 271     {
 272         [ make-engine-current ]
 273         [ update-listener ]
 274         [ clips>> [ update-audio-clip ] each ]
 275     } cleave ;
 276