module Synthesizer.ALSA.CausalIO.Process (
Events,
playFromEvents,
Output,
playFromEventsWithParams,
) where
import qualified Synthesizer.ALSA.EventList as MIDIEv
import qualified Synthesizer.ALSA.Storable.Play as Play
import Synthesizer.MIDI.EventList (StrictTime, )
import qualified Synthesizer.CausalIO.Process as PIO
import qualified Sound.ALSA.PCM as PCM
import qualified Sound.ALSA.Sequencer.Event as Event
import qualified Data.EventList.Relative.TimeTime as EventListTT
import qualified Algebra.RealField as RealField
import qualified Algebra.Additive as Additive
import qualified Data.StorableVector as SV
import Control.Exception (bracket, )
import NumericPrelude.Numeric
import NumericPrelude.Base
import Prelude ()
type Events = EventListTT.T StrictTime [Event.T]
playFromEvents ::
(RealField.C time, PCM.SampleFmt a, Additive.C a) =>
Play.Device -> MIDIEv.ClientName -> time -> time -> PCM.SampleFreq ->
PIO.T Events (SV.Vector a) ->
IO ()
playFromEvents :: Device
-> ClientName
-> time
-> time
-> SampleFreq
-> T Events (Vector a)
-> IO ()
playFromEvents Device
device ClientName
name time
latency time
beat SampleFreq
rate
(PIO.Cons Events -> state -> IO (Vector a, state)
next IO state
create state -> IO ()
delete) =
let sink :: SoundSink Pcm a
sink = Device -> time -> SampleFreq -> SoundSink Pcm a
forall y t.
(SampleFmt y, C t) =>
Device -> t -> SampleFreq -> SoundSink Pcm y
Play.makeSink Device
device time
beat SampleFreq
rate
rateFloat :: time
rateFloat = SampleFreq -> time
forall a b. (C a, C b) => a -> b
fromIntegral SampleFreq
rate
in ClientName -> time -> time -> ([IO Events] -> IO ()) -> IO ()
forall time a.
C time =>
ClientName -> time -> time -> ([IO Events] -> IO a) -> IO a
MIDIEv.withMIDIEventsChunked ClientName
name time
beat time
rateFloat (([IO Events] -> IO ()) -> IO ())
-> ([IO Events] -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \[IO Events]
getEventsList ->
SoundSink Pcm a -> (Pcm a -> IO ()) -> IO ()
forall (handle :: * -> *) y a.
SoundSink handle y -> (handle y -> IO a) -> IO a
PCM.withSoundSink SoundSink Pcm a
sink ((Pcm a -> IO ()) -> IO ()) -> (Pcm a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Pcm a
to ->
SoundSink Pcm a -> Pcm a -> Vector a -> IO ()
forall y (handle :: * -> *).
Storable y =>
SoundSink handle y -> handle y -> Vector y -> IO ()
Play.write SoundSink Pcm a
sink Pcm a
to
(SampleFreq -> a -> Vector a
forall a. Storable a => SampleFreq -> a -> Vector a
SV.replicate (time -> SampleFreq
forall a b. (C a, C b) => a -> b
round (time
latency time -> time -> time
forall a. C a => a -> a -> a
* time
rateFloat)) a
forall a. C a => a
zero) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
(IO state -> (state -> IO ()) -> (state -> IO ()) -> IO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO state
create state -> IO ()
delete ((state -> IO ()) -> IO ()) -> (state -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \state
state ->
let loop :: [IO Events] -> state -> IO ()
loop [IO Events]
getEvs0 state
s0 =
case [IO Events]
getEvs0 of
[] -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
IO Events
getEvents : [IO Events]
getEvs1 -> do
Events
evs <- IO Events
getEvents
(Vector a
pcm, state
s1) <- Events -> state -> IO (Vector a, state)
next Events
evs state
s0
SoundSink Pcm a -> Pcm a -> Vector a -> IO ()
forall y (handle :: * -> *).
Storable y =>
SoundSink handle y -> handle y -> Vector y -> IO ()
Play.write SoundSink Pcm a
sink Pcm a
to Vector a
pcm
[IO Events] -> state -> IO ()
loop [IO Events]
getEvs1 state
s1
in [IO Events] -> state -> IO ()
loop [IO Events]
getEventsList state
state)
type Output handle signal a =
(IO ((PCM.Size, PCM.SampleFreq), handle),
handle -> IO (),
handle -> signal -> IO a)
playFromEventsWithParams ::
Output handle signal () ->
MIDIEv.ClientName ->
((PCM.Size, PCM.SampleFreq) -> PIO.T Events signal) ->
IO ()
playFromEventsWithParams :: Output handle signal ()
-> ClientName
-> ((SampleFreq, SampleFreq) -> T Events signal)
-> IO ()
playFromEventsWithParams (IO ((SampleFreq, SampleFreq), handle)
open, handle -> IO ()
close, handle -> signal -> IO ()
write) ClientName
name (SampleFreq, SampleFreq) -> T Events signal
process =
IO ((SampleFreq, SampleFreq), handle)
-> (((SampleFreq, SampleFreq), handle) -> IO ())
-> (((SampleFreq, SampleFreq), handle) -> IO ())
-> IO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO ((SampleFreq, SampleFreq), handle)
open (handle -> IO ()
close (handle -> IO ())
-> (((SampleFreq, SampleFreq), handle) -> handle)
-> ((SampleFreq, SampleFreq), handle)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((SampleFreq, SampleFreq), handle) -> handle
forall a b. (a, b) -> b
snd) ((((SampleFreq, SampleFreq), handle) -> IO ()) -> IO ())
-> (((SampleFreq, SampleFreq), handle) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(p :: (SampleFreq, SampleFreq)
p@(SampleFreq
period,SampleFreq
rate),handle
h) ->
let rateFloat :: Double
rateFloat = SampleFreq -> Double
forall a b. (C a, C b) => a -> b
fromIntegral SampleFreq
rate :: Double
beat :: Double
beat = SampleFreq -> Double
forall a b. (C a, C b) => a -> b
fromIntegral SampleFreq
period Double -> Double -> Double
forall a. C a => a -> a -> a
/ Double
rateFloat
in ClientName -> Double -> Double -> ([IO Events] -> IO ()) -> IO ()
forall time a.
C time =>
ClientName -> time -> time -> ([IO Events] -> IO a) -> IO a
MIDIEv.withMIDIEventsChunked ClientName
name Double
beat Double
rateFloat (([IO Events] -> IO ()) -> IO ())
-> ([IO Events] -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \[IO Events]
getEventsList ->
case (SampleFreq, SampleFreq) -> T Events signal
process (SampleFreq, SampleFreq)
p of
PIO.Cons Events -> state -> IO (signal, state)
next IO state
create state -> IO ()
delete -> do
IO state -> (state -> IO ()) -> (state -> IO ()) -> IO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO state
create state -> IO ()
delete ((state -> IO ()) -> IO ()) -> (state -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \state
state ->
let loop :: [IO Events] -> state -> IO ()
loop [IO Events]
getEvs0 state
s0 =
case [IO Events]
getEvs0 of
[] -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
IO Events
getEvents : [IO Events]
getEvs1 -> do
Events
evs <- IO Events
getEvents
(signal
chunk, state
s1) <- Events -> state -> IO (signal, state)
next Events
evs state
s0
handle -> signal -> IO ()
write handle
h signal
chunk
[IO Events] -> state -> IO ()
loop [IO Events]
getEvs1 state
s1
in [IO Events] -> state -> IO ()
loop [IO Events]
getEventsList state
state