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 ->
{-
       Play.writeLazy sink to
          (SVL.replicate
              (SVL.chunkSize $ round (beat * rateFloat))
              (round (latency * rateFloat))
              (zero::Float))
-}
       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
{-
                   write
                      (SV.replicate (round (latency * rateFloat)) zero)
-}
                   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