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