! (c)2009 Joe Groff bsd license
USING: accessors alien audio classes.struct fry calendar timers
combinators combinators.short-circuit destructors generalizations
kernel literals locals math openal sequences
sequences.generalizations specialized-arrays strings ;
QUALIFIED-WITH: alien.c-types c
SPECIALIZED-ARRAYS: c:float c:uchar c:uint ;
IN: audio.engine

TUPLE: audio-source
    { position initial: { 0.0 0.0 0.0 } }
    { gain float initial: 1.0 }
    { velocity initial: { 0.0 0.0 0.0 } }
    { relative? boolean initial: f }
    { distance float initial: 1.0 }
    { rolloff float initial: 1.0 } ;

TUPLE: audio-orientation
    { forward initial: { 0.0 0.0 -1.0 } }
    { up initial: { 0.0 1.0 0.0 } } ;

C: <audio-orientation> audio-orientation

: orientation>float-array ( orientation -- float-array )
    [ forward>> first3 ]
    [ up>> first3 ] bi 6 float-array{ } nsequence ; inline

TUPLE: audio-listener
    { position initial: { 0.0 0.0 0.0 } }
    { gain float initial: 1.0 }
    { velocity initial: { 0.0 0.0 0.0 } }
    { orientation initial: T{ audio-orientation } } ;

GENERIC: audio-position ( source/listener -- position )
GENERIC: audio-gain ( source/listener -- gain )
GENERIC: audio-velocity ( source/listener -- velocity )
GENERIC: audio-relative? ( source -- relative? )
GENERIC: audio-distance ( source -- distance )
GENERIC: audio-rolloff ( source -- rolloff )
GENERIC: audio-orientation ( listener -- orientation )

M: object audio-position drop { 0.0 0.0 0.0 } ; inline
M: object audio-gain drop 1.0 ; inline
M: object audio-velocity drop { 0.0 0.0 0.0 } ; inline
M: object audio-relative? drop f ; inline
M: object audio-distance drop 1.0 ; inline
M: object audio-rolloff drop 1.0 ; inline
M: object audio-orientation drop T{ audio-orientation } ; inline

M: audio-source audio-position position>> ; inline
M: audio-source audio-gain gain>> ; inline
M: audio-source audio-velocity velocity>> ; inline
M: audio-source audio-relative? relative?>> ; inline
M: audio-source audio-distance distance>> ; inline
M: audio-source audio-rolloff rolloff>> ; inline

M: audio-listener audio-position position>> ; inline
M: audio-listener audio-gain gain>> ; inline
M: audio-listener audio-velocity velocity>> ; inline
M: audio-listener audio-orientation orientation>> ; inline

GENERIC: generate-audio ( generator -- c-ptr size )
GENERIC: generator-audio-format ( generator -- channels sample-bits sample-rate )

TUPLE: audio-engine < disposable
    { voice-count integer }
    { al-device c-ptr }
    { al-context c-ptr }
    al-sources
    listener
    { next-source integer }
    clips
    update-timer ;

TUPLE: audio-clip < disposable
    { audio-engine audio-engine }
    source
    { al-source integer } ;

TUPLE: static-audio-clip < audio-clip
    { al-buffer integer } ;

TUPLE: streaming-audio-clip < audio-clip
    generator
    { channels integer }
    { sample-bits integer }
    { sample-rate integer }
    { al-buffers uint-array }
    { done? boolean } ;

ERROR: audio-device-not-found device-name ;
ERROR: audio-context-not-available device-name ;

:: <audio-engine> ( device-name voice-count -- engine )
    [
        device-name alcOpenDevice :> al-device
        al-device [ device-name audio-device-not-found ] unless
        al-device |alcCloseDevice* drop

        al-device f alcCreateContext :> al-context
        al-context [ device-name audio-context-not-available ] unless
        al-context |alcDestroyContext drop

        al-context alcSuspendContext

        audio-engine new-disposable
            voice-count >>voice-count
            al-device >>al-device
            al-context >>al-context
    ] with-destructors ;

: <standard-audio-engine> ( -- engine )
    f 16 <audio-engine> ;

<PRIVATE

: make-engine-current ( audio-engine -- )
    al-context>> alcMakeContextCurrent drop ; inline

: allocate-sources ( audio-engine -- sources )
    voice-count>> dup (uint-array) [ alGenSources ] keep ; inline

:: flush-source ( al-source -- )
    al-source alSourceStop
    0 c:<uint> :> dummy-buffer
    al-source AL_BUFFERS_PROCESSED get-source-param [
        al-source 1 dummy-buffer alSourceUnqueueBuffers
    ] times
    al-source AL_BUFFER 0 alSourcei ;

: free-sources ( sources -- )
    [ length ] keep alDeleteSources ; inline

:: (get-available-source) ( sources source# stop-source# -- next-source# al-source/f )
    source# sources nth :> al-source
    source# 1 + sources length mod :> next-source#
    al-source {
        [ AL_BUFFERS_PROCESSED get-source-param 0 = ]
        [ AL_BUFFERS_QUEUED get-source-param 0 = ]
        [ AL_SOURCE_STATE get-source-param { $ AL_INITIAL $ AL_STOPPED } member? ]
    } 1&&
    [ next-source# al-source ] [
        next-source# stop-source# =
        [ next-source# f ]
        [ sources next-source# stop-source# (get-available-source) ] if
    ] if ;

:: get-available-source ( audio-engine -- al-source/f )
    audio-engine [ al-sources>> ] [ next-source>> ] bi dup (get-available-source)
        :> ( next-source al-source )
    audio-engine next-source >>next-source drop
    al-source ;

:: queue-clip-buffer ( audio-clip al-buffer -- )
    audio-clip done?>> [
        audio-clip al-source>> :> al-source
        audio-clip generator>> :> generator
        generator generate-audio :> ( data size )

        size { [ not ] [ zero? ] } 1|| [
            audio-clip t >>done? drop
        ] [
            al-buffer audio-clip openal-format data size audio-clip sample-rate>> alBufferData
            al-source 1 al-buffer c:<uint> alSourceQueueBuffers
        ] if
    ] unless ;

: update-listener ( audio-engine -- )
    listener>> {
        [ AL_POSITION swap audio-position first3 alListener3f ]
        [ AL_GAIN swap audio-gain alListenerf ]
        [ AL_VELOCITY swap audio-velocity first3 alListener3f ]
        [ AL_ORIENTATION swap audio-orientation orientation>float-array alListenerfv ]
    } cleave ;

: update-source ( audio-clip -- )
    [ al-source>> ] [ source>> ] bi {
        [ AL_POSITION swap audio-position first3 alSource3f ]
        [ AL_GAIN swap audio-gain alSourcef ]
        [ AL_VELOCITY swap audio-velocity first3 alSource3f ]
        [ AL_SOURCE_RELATIVE swap audio-relative? c:>c-bool alSourcei ]
        [ AL_REFERENCE_DISTANCE swap audio-distance alSourcef ]
        [ AL_ROLLOFF_FACTOR swap audio-rolloff alSourcef ]
    } 2cleave ;

GENERIC: (update-audio-clip) ( audio-clip -- )

M: static-audio-clip (update-audio-clip)
    drop ;

M:: streaming-audio-clip (update-audio-clip) ( audio-clip -- )
    audio-clip al-source>> :> al-source
    0 c:<uint> :> buffer
    al-source AL_BUFFERS_PROCESSED get-source-param [
        al-source 1 buffer alSourceUnqueueBuffers
        audio-clip buffer c:*uint queue-clip-buffer
    ] times ;

: update-audio-clip ( audio-clip -- )
    [ update-source ] [
        dup al-source>> AL_SOURCE_STATE get-source-param AL_STOPPED = 
        [ dispose ] [ (update-audio-clip) ] if
    ] bi ;

: clip-al-sources ( clips -- length sources )
    [ length ] [ [ al-source>> ] uint-array{ } map-as ] bi ;

PRIVATE>

DEFER: update-audio

: start-audio* ( audio-engine -- )
    dup al-sources>> [ drop ] [
        {
            [ make-engine-current ]
            [ al-context>> alcProcessContext ]
            [
                dup allocate-sources >>al-sources
                0 >>next-source
                V{ } clone >>clips
                drop
            ]
            [ update-listener ]
        } cleave
    ] if ;

: start-audio ( audio-engine -- )
    dup start-audio*
    dup '[ _ update-audio ] 20 milliseconds every >>update-timer
    drop ;

: stop-audio ( audio-engine -- )
    dup al-sources>> [
        {
            [ make-engine-current ]
            [ update-timer>> [ stop-timer ] when* ]
            [ clips>> clone [ dispose ] each ]
            [ al-sources>> free-sources ]
            [
                f >>al-sources
                f >>clips
                f >>update-timer
                drop
            ]
            [ al-context>> alcSuspendContext ]
        } cleave
    ] [ drop ] if ;

M: audio-engine dispose*
    dup stop-audio
    [ [ alcDestroyContext ] when* f ] change-al-context
    [ [ alcCloseDevice*   ] when* f ] change-al-device
    drop ;

:: <static-audio-clip> ( audio-engine source audio loop? -- audio-clip/f )
    audio-engine get-available-source :> al-source

    al-source [
        1 0 c:<uint> [ alGenBuffers ] keep c:*uint :> al-buffer
        al-buffer audio { [ openal-format ] [ data>> ] [ size>> ] [ sample-rate>> ] } cleave
            alBufferData

        al-source AL_BUFFER al-buffer alSourcei
        al-source AL_LOOPING loop? c:>c-bool alSourcei

        static-audio-clip new-disposable
            audio-engine >>audio-engine
            source >>source
            al-source >>al-source
            al-buffer >>al-buffer
            :> clip
        clip audio-engine clips>> push
        clip
    ] [ f ] if ;

:: <streaming-audio-clip> ( audio-engine source generator buffer-count -- audio-clip/f )
    audio-engine get-available-source :> al-source

    al-source [
        buffer-count dup (uint-array) [ alGenBuffers ] keep :> al-buffers
        generator generator-audio-format :> ( channels sample-bits sample-rate )

        streaming-audio-clip new-disposable
            audio-engine >>audio-engine
            source >>source
            al-source >>al-source
            generator >>generator
            channels >>channels
            sample-bits >>sample-bits
            sample-rate >>sample-rate
            al-buffers >>al-buffers
            :> clip
        al-buffers [ clip swap queue-clip-buffer ] each
        clip audio-engine clips>> push
        clip
    ] [ generator dispose f ] if ;

M: audio-clip dispose*
    [ dup audio-engine>> clips>> remove! drop ]
    [ al-source>> flush-source ] bi ;

M: static-audio-clip dispose*
    [ call-next-method ]
    [ [ 1 ] dip al-buffer>> c:<uint> alDeleteBuffers ] bi ;

M: streaming-audio-clip dispose*
    [ call-next-method ]
    [ generator>> dispose ]
    [ al-buffers>> [ length ] keep alDeleteBuffers ] tri ;

: play-clip ( audio-clip -- )
    [ update-source ]
    [ al-source>> alSourcePlay ] bi ;

: play-clips ( audio-clips -- )
    [ [ update-source ] each ]
    [ clip-al-sources alSourcePlayv ] bi ;

: play-static-audio-clip ( audio-engine source audio loop? -- audio-clip/f )
    <static-audio-clip> dup [ play-clip ] when* ;

: play-streaming-audio-clip ( audio-engine source generator buffer-count -- audio-clip/f ) 
    <streaming-audio-clip> dup [ play-clip ] when* ;

: pause-clip ( audio-clip -- )
    al-source>> alSourcePause ;

: pause-clips ( audio-clips -- )
    clip-al-sources alSourcePausev ;

: stop-clip ( audio-clip -- )
    dispose ;

: stop-clips ( audio-clips -- )
    [ clip-al-sources alSourceStopv ]
    [ [ dispose ] each ] bi ;

: update-audio ( audio-engine -- )
    {
        [ make-engine-current ]
        [ update-listener ]
        [ clips>> clone [ update-audio-clip ] each ]
    } cleave ;