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