{-# LANGUAGE RebindableSyntax #-}
module Synthesizer.ALSA.EventList where
import qualified Sound.ALSA.Sequencer.Address as Addr
import qualified Sound.ALSA.Sequencer.Client as Client
import qualified Sound.ALSA.Sequencer.Port as Port
import qualified Sound.ALSA.Sequencer.Port.InfoMonad as PortInfo
import qualified Sound.ALSA.Sequencer.Event as Event
import qualified Sound.ALSA.Sequencer.Queue as Queue
import qualified Sound.ALSA.Sequencer.Time as Time
import qualified Sound.ALSA.Sequencer.RealTime as RealTime
import qualified Sound.ALSA.Sequencer as SndSeq
import qualified Sound.ALSA.Exception as AlsaExc
import qualified Data.EventList.Relative.TimeBody as EventList
import qualified Data.EventList.Relative.TimeTime as EventListTT
import qualified Data.EventList.Relative.MixedBody as EventListMB
import qualified Data.EventList.Relative.TimeMixed as EventListTM
import qualified Data.EventList.Absolute.TimeBody as AbsEventList
import Sound.MIDI.ALSA.Construct ()
import Sound.MIDI.ALSA.Check ()
import Sound.MIDI.ALSA.Query ()
import System.IO.Unsafe (unsafeInterleaveIO, )
import Control.Concurrent (threadDelay)
import System.Time (ClockTime(TOD), getClockTime, )
import Control.Monad.Trans.State
(evalState, modify, get, )
import qualified Numeric.NonNegative.Class as NonNeg
import qualified Numeric.NonNegative.Wrapper as NonNegW
import qualified Algebra.RealField as RealField
import qualified Algebra.Field as Field
import Data.Tuple.HT (mapPair, mapSnd, )
import Data.Ord.HT (limit, )
import Control.Monad (liftM, liftM2, )
import NumericPrelude.Numeric
import NumericPrelude.Base
getTimeSeconds :: Field.C time => IO time
getTimeSeconds :: IO time
getTimeSeconds =
(ClockTime -> time) -> IO ClockTime -> IO time
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ClockTime -> time
forall time. C time => ClockTime -> time
clockTimeToSeconds IO ClockTime
getClockTime
clockTimeToSeconds :: Field.C time => ClockTime -> time
clockTimeToSeconds :: ClockTime -> time
clockTimeToSeconds (TOD Integer
secs Integer
picos) =
Integer -> time
forall a. C a => Integer -> a
fromInteger Integer
secs time -> time -> time
forall a. C a => a -> a -> a
+ Integer -> time
forall a. C a => Integer -> a
fromInteger Integer
picos time -> time -> time
forall a. C a => a -> a -> a
* time
1e-12
wait :: RealField.C time => time -> IO ()
wait :: time -> IO ()
wait time
t1 =
do time
t0 <- IO time
forall time. C time => IO time
getTimeSeconds
Int -> IO ()
threadDelay (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ time -> Int
forall a b. (C a, C b) => a -> b
floor (time -> Int) -> time -> Int
forall a b. (a -> b) -> a -> b
$ time
1e6time -> time -> time
forall a. C a => a -> a -> a
*(time
t1time -> time -> time
forall a. C a => a -> a -> a
-time
t0)
type StampedEvent time = (time, Event.T)
getStampedEvent ::
(Field.C time, SndSeq.AllowInput mode) =>
SndSeq.T mode -> IO (StampedEvent time)
getStampedEvent :: T mode -> IO (StampedEvent time)
getStampedEvent T mode
h =
(time -> T -> StampedEvent time)
-> IO time -> IO T -> IO (StampedEvent time)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,)
IO time
forall time. C time => IO time
getTimeSeconds
(T mode -> IO T
forall mode. AllowInput mode => T mode -> IO T
Event.input T mode
h)
getWaitingStampedEvents ::
(Field.C time, SndSeq.AllowInput mode) =>
SndSeq.T mode -> IO [StampedEvent time]
getWaitingStampedEvents :: T mode -> IO [StampedEvent time]
getWaitingStampedEvents T mode
h =
let loop :: IO [StampedEvent time]
loop =
IO [StampedEvent time]
-> (T -> IO [StampedEvent time]) -> IO [StampedEvent time]
forall a. IO a -> (T -> IO a) -> IO a
AlsaExc.catch
((StampedEvent time -> [StampedEvent time] -> [StampedEvent time])
-> IO (StampedEvent time)
-> IO [StampedEvent time]
-> IO [StampedEvent time]
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (:) (T mode -> IO (StampedEvent time)
forall time mode.
(C time, AllowInput mode) =>
T mode -> IO (StampedEvent time)
getStampedEvent T mode
h) IO [StampedEvent time]
loop)
(IO [StampedEvent time] -> T -> IO [StampedEvent time]
forall a b. a -> b -> a
const (IO [StampedEvent time] -> T -> IO [StampedEvent time])
-> IO [StampedEvent time] -> T -> IO [StampedEvent time]
forall a b. (a -> b) -> a -> b
$ [StampedEvent time] -> IO [StampedEvent time]
forall (m :: * -> *) a. Monad m => a -> m a
return [])
in IO [StampedEvent time]
loop
realTimeToField :: (Field.C a) => RealTime.T -> a
realTimeToField :: T -> a
realTimeToField (RealTime.Cons Word32
s Word32
n) =
Word32 -> a
forall a b. (C a, C b) => a -> b
fromIntegral Word32
s a -> a -> a
forall a. C a => a -> a -> a
+ Word32 -> a
forall a b. (C a, C b) => a -> b
fromIntegral Word32
n a -> a -> a
forall a. C a => a -> a -> a
/ (a
10a -> Integer -> a
forall a. C a => a -> Integer -> a
^Integer
9)
addStamp ::
(RealField.C time) =>
Event.T -> StampedEvent time
addStamp :: T -> StampedEvent time
addStamp T
ev =
(case T -> T
Event.time T
ev of
Time.Cons Mode
Time.Absolute (Time.Real T
t) -> T -> time
forall a. C a => T -> a
realTimeToField T
t
T
_ -> [Char] -> time
forall a. HasCallStack => [Char] -> a
error [Char]
"unsupported time stamp type",
T
ev)
getStampedEventsUntilTime ::
(RealField.C time,
SndSeq.AllowInput mode, SndSeq.AllowOutput mode) =>
SndSeq.T mode ->
Queue.T -> Port.T -> time ->
IO [StampedEvent time]
getStampedEventsUntilTime :: T mode -> T -> T -> time -> IO [StampedEvent time]
getStampedEventsUntilTime T mode
h T
q T
p time
t =
([T] -> [StampedEvent time]) -> IO [T] -> IO [StampedEvent time]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((T -> StampedEvent time) -> [T] -> [StampedEvent time]
forall a b. (a -> b) -> [a] -> [b]
map T -> StampedEvent time
forall time. C time => T -> StampedEvent time
addStamp) (IO [T] -> IO [StampedEvent time])
-> IO [T] -> IO [StampedEvent time]
forall a b. (a -> b) -> a -> b
$ T mode -> T -> T -> time -> IO [T]
forall time mode.
(C time, AllowInput mode, AllowOutput mode) =>
T mode -> T -> T -> time -> IO [T]
getEventsUntilTime T mode
h T
q T
p time
t
getEventsUntilEcho ::
(SndSeq.AllowInput mode) =>
Client.T -> SndSeq.T mode -> IO [Event.T]
getEventsUntilEcho :: T -> T mode -> IO [T]
getEventsUntilEcho T
c T mode
h =
let loop :: IO [T]
loop = do
T
ev <- T mode -> IO T
forall mode. AllowInput mode => T mode -> IO T
Event.input T mode
h
let abort :: Bool
abort =
case T -> Data
Event.body T
ev of
Event.CustomEv CustomEv
Event.Echo Custom
_ ->
T
c T -> T -> Bool
forall a. Eq a => a -> a -> Bool
== T -> T
Addr.client (T -> T
Event.source T
ev)
Data
_ -> Bool
False
if Bool
abort
then [T] -> IO [T]
forall (m :: * -> *) a. Monad m => a -> m a
return []
else ([T] -> [T]) -> IO [T] -> IO [T]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (T
evT -> [T] -> [T]
forall a. a -> [a] -> [a]
:) IO [T]
loop
in IO [T]
loop
getEventsUntilTime ::
(RealField.C time,
SndSeq.AllowInput mode, SndSeq.AllowOutput mode) =>
SndSeq.T mode ->
Queue.T -> Port.T -> time ->
IO [Event.T]
getEventsUntilTime :: T mode -> T -> T -> time -> IO [T]
getEventsUntilTime T mode
h T
q T
p time
t = do
T
c <- T mode -> IO T
forall mode. T mode -> IO T
Client.getId T mode
h
Word
_ <- T mode -> T -> IO Word
forall mode. AllowOutput mode => T mode -> T -> IO Word
Event.output T mode
h (T -> IO Word) -> T -> IO Word
forall a b. (a -> b) -> a -> b
$
T -> T -> T -> time -> Custom -> T
forall time. C time => T -> T -> T -> time -> Custom -> T
makeEcho T
c T
q T
p time
t (Word32 -> Word32 -> Word32 -> Custom
Event.Custom Word32
0 Word32
0 Word32
0)
Word
_ <- T mode -> IO Word
forall mode. AllowOutput mode => T mode -> IO Word
Event.drainOutput T mode
h
T -> T mode -> IO [T]
forall mode. AllowInput mode => T -> T mode -> IO [T]
getEventsUntilEcho T
c T mode
h
getWaitingEvents ::
(SndSeq.AllowInput mode) =>
SndSeq.T mode -> IO [Event.T]
getWaitingEvents :: T mode -> IO [T]
getWaitingEvents T mode
h =
let loop :: IO [T]
loop =
IO [T] -> (T -> IO [T]) -> IO [T]
forall a. IO a -> (T -> IO a) -> IO a
AlsaExc.catch
((T -> [T] -> [T]) -> IO T -> IO [T] -> IO [T]
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (:) (T mode -> IO T
forall mode. AllowInput mode => T mode -> IO T
Event.input T mode
h) IO [T]
loop)
(IO [T] -> T -> IO [T]
forall a b. a -> b -> a
const (IO [T] -> T -> IO [T]) -> IO [T] -> T -> IO [T]
forall a b. (a -> b) -> a -> b
$ [T] -> IO [T]
forall (m :: * -> *) a. Monad m => a -> m a
return [])
in IO [T]
loop
type StrictTime = NonNegW.Integer
newtype ClientName = ClientName String
deriving (Int -> ClientName -> ShowS
[ClientName] -> ShowS
ClientName -> [Char]
(Int -> ClientName -> ShowS)
-> (ClientName -> [Char])
-> ([ClientName] -> ShowS)
-> Show ClientName
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ClientName] -> ShowS
$cshowList :: [ClientName] -> ShowS
show :: ClientName -> [Char]
$cshow :: ClientName -> [Char]
showsPrec :: Int -> ClientName -> ShowS
$cshowsPrec :: Int -> ClientName -> ShowS
Show)
withMIDIEvents :: (RealField.C time) =>
ClientName -> time -> time ->
(EventList.T StrictTime [Event.T] -> IO a) -> IO a
withMIDIEvents :: ClientName -> time -> time -> (T StrictTime [T] -> IO a) -> IO a
withMIDIEvents =
ClientName -> time -> time -> (T StrictTime [T] -> IO a) -> IO a
forall time a.
C time =>
ClientName -> time -> time -> (T StrictTime [T] -> IO a) -> IO a
withMIDIEventsBlockEcho
withMIDIEventsNonblockWaitGrouped :: (RealField.C time) =>
ClientName -> time -> time ->
(EventList.T StrictTime [Event.T] -> IO a) -> IO a
withMIDIEventsNonblockWaitGrouped :: ClientName -> time -> time -> (T StrictTime [T] -> IO a) -> IO a
withMIDIEventsNonblockWaitGrouped ClientName
name time
beat time
rate T StrictTime [T] -> IO a
proc =
ClientName -> BlockMode -> (T DuplexMode -> T -> IO a) -> IO a
forall t.
ClientName -> BlockMode -> (T DuplexMode -> T -> IO t) -> IO t
withInPort ClientName
name BlockMode
SndSeq.Nonblock ((T DuplexMode -> T -> IO a) -> IO a)
-> (T DuplexMode -> T -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \ T DuplexMode
h T
_p ->
do time
start <- IO time
forall time. C time => IO time
getTimeSeconds
[(time, [T])]
l <- [IO (time, [T])] -> IO [(time, [T])]
forall a. [IO a] -> IO [a]
lazySequence ([IO (time, [T])] -> IO [(time, [T])])
-> [IO (time, [T])] -> IO [(time, [T])]
forall a b. (a -> b) -> a -> b
$
((time -> IO (time, [T])) -> [time] -> [IO (time, [T])])
-> [time] -> (time -> IO (time, [T])) -> [IO (time, [T])]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (time -> IO (time, [T])) -> [time] -> [IO (time, [T])]
forall a b. (a -> b) -> [a] -> [b]
map ((time -> time) -> time -> [time]
forall a. (a -> a) -> a -> [a]
iterate (time
beattime -> time -> time
forall a. C a => a -> a -> a
+) time
start) ((time -> IO (time, [T])) -> [IO (time, [T])])
-> (time -> IO (time, [T])) -> [IO (time, [T])]
forall a b. (a -> b) -> a -> b
$ \time
t ->
time -> IO ()
forall time. C time => time -> IO ()
wait time
t IO () -> IO (time, [T]) -> IO (time, [T])
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
([T] -> (time, [T])) -> IO [T] -> IO (time, [T])
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
(\[T]
evs -> (time
t, [T]
evs))
(T DuplexMode -> IO [T]
forall mode. AllowInput mode => T mode -> IO [T]
getWaitingEvents T DuplexMode
h)
T StrictTime [T] -> IO a
proc (T StrictTime [T] -> IO a) -> T StrictTime [T] -> IO a
forall a b. (a -> b) -> a -> b
$
time -> T time [T] -> T StrictTime [T]
forall time a. C time => time -> T time a -> T StrictTime a
discretizeTime time
rate (T time [T] -> T StrictTime [T]) -> T time [T] -> T StrictTime [T]
forall a b. (a -> b) -> a -> b
$
[(time, [T])] -> T time [T]
forall a b. [(a, b)] -> T a b
AbsEventList.fromPairList [(time, [T])]
l
withMIDIEventsNonblockWaitDefer :: (RealField.C time) =>
ClientName -> time -> time ->
(EventList.T StrictTime (Maybe Event.T) -> IO a) -> IO a
withMIDIEventsNonblockWaitDefer :: ClientName
-> time -> time -> (T StrictTime (Maybe T) -> IO a) -> IO a
withMIDIEventsNonblockWaitDefer ClientName
name time
beat time
rate T StrictTime (Maybe T) -> IO a
proc =
ClientName -> BlockMode -> (T DuplexMode -> T -> IO a) -> IO a
forall t.
ClientName -> BlockMode -> (T DuplexMode -> T -> IO t) -> IO t
withInPort ClientName
name BlockMode
SndSeq.Nonblock ((T DuplexMode -> T -> IO a) -> IO a)
-> (T DuplexMode -> T -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \ T DuplexMode
h T
_p ->
do time
start <- IO time
forall time. C time => IO time
getTimeSeconds
[[(time, Maybe T)]]
l <- [IO [(time, Maybe T)]] -> IO [[(time, Maybe T)]]
forall a. [IO a] -> IO [a]
lazySequence ([IO [(time, Maybe T)]] -> IO [[(time, Maybe T)]])
-> [IO [(time, Maybe T)]] -> IO [[(time, Maybe T)]]
forall a b. (a -> b) -> a -> b
$
((time -> IO [(time, Maybe T)])
-> [time] -> [IO [(time, Maybe T)]])
-> [time]
-> (time -> IO [(time, Maybe T)])
-> [IO [(time, Maybe T)]]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (time -> IO [(time, Maybe T)]) -> [time] -> [IO [(time, Maybe T)]]
forall a b. (a -> b) -> [a] -> [b]
map ((time -> time) -> time -> [time]
forall a. (a -> a) -> a -> [a]
iterate (time
beattime -> time -> time
forall a. C a => a -> a -> a
+) time
start) ((time -> IO [(time, Maybe T)]) -> [IO [(time, Maybe T)]])
-> (time -> IO [(time, Maybe T)]) -> [IO [(time, Maybe T)]]
forall a b. (a -> b) -> a -> b
$ \time
t ->
time -> IO ()
forall time. C time => time -> IO ()
wait time
t IO () -> IO [(time, Maybe T)] -> IO [(time, Maybe T)]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
([(time, T)] -> [(time, Maybe T)])
-> IO [(time, T)] -> IO [(time, Maybe T)]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
(\ [(time, T)]
es -> (time
t, Maybe T
forall a. Maybe a
Nothing) (time, Maybe T) -> [(time, Maybe T)] -> [(time, Maybe T)]
forall a. a -> [a] -> [a]
: ((time, T) -> (time, Maybe T)) -> [(time, T)] -> [(time, Maybe T)]
forall a b. (a -> b) -> [a] -> [b]
map ((T -> Maybe T) -> (time, T) -> (time, Maybe T)
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd T -> Maybe T
forall a. a -> Maybe a
Just) [(time, T)]
es)
(T DuplexMode -> IO [(time, T)]
forall time mode.
(C time, AllowInput mode) =>
T mode -> IO [StampedEvent time]
getWaitingStampedEvents T DuplexMode
h)
T StrictTime (Maybe T) -> IO a
proc (T StrictTime (Maybe T) -> IO a) -> T StrictTime (Maybe T) -> IO a
forall a b. (a -> b) -> a -> b
$
time -> T time (Maybe T) -> T StrictTime (Maybe T)
forall time a. C time => time -> T time a -> T StrictTime a
discretizeTime time
rate (T time (Maybe T) -> T StrictTime (Maybe T))
-> T time (Maybe T) -> T StrictTime (Maybe T)
forall a b. (a -> b) -> a -> b
$
(State time (T time (Maybe T)) -> time -> T time (Maybe T))
-> time -> State time (T time (Maybe T)) -> T time (Maybe T)
forall a b c. (a -> b -> c) -> b -> a -> c
flip State time (T time (Maybe T)) -> time -> T time (Maybe T)
forall s a. State s a -> s -> a
evalState time
start (State time (T time (Maybe T)) -> T time (Maybe T))
-> State time (T time (Maybe T)) -> T time (Maybe T)
forall a b. (a -> b) -> a -> b
$
(time -> StateT time Identity time)
-> T time (Maybe T) -> State time (T time (Maybe T))
forall (m :: * -> *) time0 time1 body.
Monad m =>
(time0 -> m time1) -> T time0 body -> m (T time1 body)
AbsEventList.mapTimeM (\time
t -> (time -> time) -> StateT time Identity ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify (time -> time -> time
forall a. Ord a => a -> a -> a
max time
t) StateT time Identity ()
-> StateT time Identity time -> StateT time Identity time
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT time Identity time
forall (m :: * -> *) s. Monad m => StateT s m s
get) (T time (Maybe T) -> State time (T time (Maybe T)))
-> T time (Maybe T) -> State time (T time (Maybe T))
forall a b. (a -> b) -> a -> b
$
[(time, Maybe T)] -> T time (Maybe T)
forall a b. [(a, b)] -> T a b
AbsEventList.fromPairList ([(time, Maybe T)] -> T time (Maybe T))
-> [(time, Maybe T)] -> T time (Maybe T)
forall a b. (a -> b) -> a -> b
$ [[(time, Maybe T)]] -> [(time, Maybe T)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(time, Maybe T)]]
l
withMIDIEventsNonblockWaitSkip :: (RealField.C time) =>
ClientName -> time -> time ->
(EventList.T StrictTime (Maybe Event.T) -> IO a) -> IO a
withMIDIEventsNonblockWaitSkip :: ClientName
-> time -> time -> (T StrictTime (Maybe T) -> IO a) -> IO a
withMIDIEventsNonblockWaitSkip ClientName
name time
beat time
rate T StrictTime (Maybe T) -> IO a
proc =
ClientName -> BlockMode -> (T DuplexMode -> T -> IO a) -> IO a
forall t.
ClientName -> BlockMode -> (T DuplexMode -> T -> IO t) -> IO t
withInPort ClientName
name BlockMode
SndSeq.Nonblock ((T DuplexMode -> T -> IO a) -> IO a)
-> (T DuplexMode -> T -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \ T DuplexMode
h T
_p ->
do time
start <- IO time
forall time. C time => IO time
getTimeSeconds
[[(time, Maybe T)]]
l <- [IO [(time, Maybe T)]] -> IO [[(time, Maybe T)]]
forall a. [IO a] -> IO [a]
lazySequence ([IO [(time, Maybe T)]] -> IO [[(time, Maybe T)]])
-> [IO [(time, Maybe T)]] -> IO [[(time, Maybe T)]]
forall a b. (a -> b) -> a -> b
$
((time -> IO [(time, Maybe T)])
-> [time] -> [IO [(time, Maybe T)]])
-> [time]
-> (time -> IO [(time, Maybe T)])
-> [IO [(time, Maybe T)]]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (time -> IO [(time, Maybe T)]) -> [time] -> [IO [(time, Maybe T)]]
forall a b. (a -> b) -> [a] -> [b]
map ((time -> time) -> time -> [time]
forall a. (a -> a) -> a -> [a]
iterate (time
beattime -> time -> time
forall a. C a => a -> a -> a
+) time
start) ((time -> IO [(time, Maybe T)]) -> [IO [(time, Maybe T)]])
-> (time -> IO [(time, Maybe T)]) -> [IO [(time, Maybe T)]]
forall a b. (a -> b) -> a -> b
$ \time
t ->
do time -> IO ()
forall time. C time => time -> IO ()
wait time
t
time
t0 <- IO time
forall time. C time => IO time
getTimeSeconds
[StampedEvent time]
es <-
if time
t0time -> time -> Bool
forall a. Ord a => a -> a -> Bool
>=time
ttime -> time -> time
forall a. C a => a -> a -> a
+time
beat
then [StampedEvent time] -> IO [StampedEvent time]
forall (m :: * -> *) a. Monad m => a -> m a
return []
else T DuplexMode -> IO [StampedEvent time]
forall time mode.
(C time, AllowInput mode) =>
T mode -> IO [StampedEvent time]
getWaitingStampedEvents T DuplexMode
h
[(time, Maybe T)] -> IO [(time, Maybe T)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(time, Maybe T)] -> IO [(time, Maybe T)])
-> [(time, Maybe T)] -> IO [(time, Maybe T)]
forall a b. (a -> b) -> a -> b
$
(time
t0, Maybe T
forall a. Maybe a
Nothing) (time, Maybe T) -> [(time, Maybe T)] -> [(time, Maybe T)]
forall a. a -> [a] -> [a]
:
(StampedEvent time -> (time, Maybe T))
-> [StampedEvent time] -> [(time, Maybe T)]
forall a b. (a -> b) -> [a] -> [b]
map ((T -> Maybe T) -> StampedEvent time -> (time, Maybe T)
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd T -> Maybe T
forall a. a -> Maybe a
Just) [StampedEvent time]
es
T StrictTime (Maybe T) -> IO a
proc (T StrictTime (Maybe T) -> IO a) -> T StrictTime (Maybe T) -> IO a
forall a b. (a -> b) -> a -> b
$
time -> T time (Maybe T) -> T StrictTime (Maybe T)
forall time a. C time => time -> T time a -> T StrictTime a
discretizeTime time
rate (T time (Maybe T) -> T StrictTime (Maybe T))
-> T time (Maybe T) -> T StrictTime (Maybe T)
forall a b. (a -> b) -> a -> b
$
[(time, Maybe T)] -> T time (Maybe T)
forall a b. [(a, b)] -> T a b
AbsEventList.fromPairList ([(time, Maybe T)] -> T time (Maybe T))
-> [(time, Maybe T)] -> T time (Maybe T)
forall a b. (a -> b) -> a -> b
$ [[(time, Maybe T)]] -> [(time, Maybe T)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(time, Maybe T)]]
l
withMIDIEventsNonblockWaitMin :: (RealField.C time) =>
ClientName -> time -> time ->
(EventList.T StrictTime (Maybe Event.T) -> IO a) -> IO a
withMIDIEventsNonblockWaitMin :: ClientName
-> time -> time -> (T StrictTime (Maybe T) -> IO a) -> IO a
withMIDIEventsNonblockWaitMin ClientName
name time
beat time
rate T StrictTime (Maybe T) -> IO a
proc =
ClientName -> BlockMode -> (T DuplexMode -> T -> IO a) -> IO a
forall t.
ClientName -> BlockMode -> (T DuplexMode -> T -> IO t) -> IO t
withInPort ClientName
name BlockMode
SndSeq.Nonblock ((T DuplexMode -> T -> IO a) -> IO a)
-> (T DuplexMode -> T -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \ T DuplexMode
h T
_p ->
do time
start <- IO time
forall time. C time => IO time
getTimeSeconds
[[(time, Maybe T)]]
l <- [IO [(time, Maybe T)]] -> IO [[(time, Maybe T)]]
forall a. [IO a] -> IO [a]
lazySequence ([IO [(time, Maybe T)]] -> IO [[(time, Maybe T)]])
-> [IO [(time, Maybe T)]] -> IO [[(time, Maybe T)]]
forall a b. (a -> b) -> a -> b
$
((time -> IO [(time, Maybe T)])
-> [time] -> [IO [(time, Maybe T)]])
-> [time]
-> (time -> IO [(time, Maybe T)])
-> [IO [(time, Maybe T)]]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (time -> IO [(time, Maybe T)]) -> [time] -> [IO [(time, Maybe T)]]
forall a b. (a -> b) -> [a] -> [b]
map ((time -> time) -> time -> [time]
forall a. (a -> a) -> a -> [a]
iterate (time
beattime -> time -> time
forall a. C a => a -> a -> a
+) time
start) ((time -> IO [(time, Maybe T)]) -> [IO [(time, Maybe T)]])
-> (time -> IO [(time, Maybe T)]) -> [IO [(time, Maybe T)]]
forall a b. (a -> b) -> a -> b
$ \time
t ->
time -> IO ()
forall time. C time => time -> IO ()
wait time
t IO () -> IO [(time, Maybe T)] -> IO [(time, Maybe T)]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
([(time, T)] -> [(time, Maybe T)])
-> IO [(time, T)] -> IO [(time, Maybe T)]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
(\ [(time, T)]
es ->
([time] -> time
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([time] -> time) -> [time] -> time
forall a b. (a -> b) -> a -> b
$ time
t time -> [time] -> [time]
forall a. a -> [a] -> [a]
: ((time, T) -> time) -> [(time, T)] -> [time]
forall a b. (a -> b) -> [a] -> [b]
map (time, T) -> time
forall a b. (a, b) -> a
fst [(time, T)]
es, Maybe T
forall a. Maybe a
Nothing) (time, Maybe T) -> [(time, Maybe T)] -> [(time, Maybe T)]
forall a. a -> [a] -> [a]
:
((time, T) -> (time, Maybe T)) -> [(time, T)] -> [(time, Maybe T)]
forall a b. (a -> b) -> [a] -> [b]
map ((T -> Maybe T) -> (time, T) -> (time, Maybe T)
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd T -> Maybe T
forall a. a -> Maybe a
Just) [(time, T)]
es)
(T DuplexMode -> IO [(time, T)]
forall time mode.
(C time, AllowInput mode) =>
T mode -> IO [StampedEvent time]
getWaitingStampedEvents T DuplexMode
h)
T StrictTime (Maybe T) -> IO a
proc (T StrictTime (Maybe T) -> IO a) -> T StrictTime (Maybe T) -> IO a
forall a b. (a -> b) -> a -> b
$
time -> T time (Maybe T) -> T StrictTime (Maybe T)
forall time a. C time => time -> T time a -> T StrictTime a
discretizeTime time
rate (T time (Maybe T) -> T StrictTime (Maybe T))
-> T time (Maybe T) -> T StrictTime (Maybe T)
forall a b. (a -> b) -> a -> b
$
[(time, Maybe T)] -> T time (Maybe T)
forall a b. [(a, b)] -> T a b
AbsEventList.fromPairList ([(time, Maybe T)] -> T time (Maybe T))
-> [(time, Maybe T)] -> T time (Maybe T)
forall a b. (a -> b) -> a -> b
$ [[(time, Maybe T)]] -> [(time, Maybe T)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(time, Maybe T)]]
l
withMIDIEventsNonblockConstantPause :: (RealField.C time) =>
ClientName -> time -> time ->
(EventList.T StrictTime (Maybe Event.T) -> IO a) -> IO a
withMIDIEventsNonblockConstantPause :: ClientName
-> time -> time -> (T StrictTime (Maybe T) -> IO a) -> IO a
withMIDIEventsNonblockConstantPause ClientName
name time
beat time
rate T StrictTime (Maybe T) -> IO a
proc =
ClientName -> BlockMode -> (T DuplexMode -> T -> IO a) -> IO a
forall t.
ClientName -> BlockMode -> (T DuplexMode -> T -> IO t) -> IO t
withInPort ClientName
name BlockMode
SndSeq.Nonblock ((T DuplexMode -> T -> IO a) -> IO a)
-> (T DuplexMode -> T -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \ T DuplexMode
h T
_p ->
do [[(time, Maybe T)]]
l <- IO [(time, Maybe T)] -> IO [[(time, Maybe T)]]
forall a. IO a -> IO [a]
ioToLazyList (IO [(time, Maybe T)] -> IO [[(time, Maybe T)]])
-> IO [(time, Maybe T)] -> IO [[(time, Maybe T)]]
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay (time -> Int
forall a b. (C a, C b) => a -> b
round (time -> Int) -> time -> Int
forall a b. (a -> b) -> a -> b
$ (time -> time -> time) -> time -> time -> time
forall a b c. (a -> b -> c) -> b -> a -> c
flip time -> time -> time
forall a. a -> a -> a
asTypeOf time
rate (time -> time) -> time -> time
forall a b. (a -> b) -> a -> b
$ time
beattime -> time -> time
forall a. C a => a -> a -> a
*time
1e6) IO () -> IO [(time, Maybe T)] -> IO [(time, Maybe T)]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
((time, Maybe T) -> [(time, Maybe T)] -> [(time, Maybe T)])
-> IO (time, Maybe T)
-> IO [(time, Maybe T)]
-> IO [(time, Maybe T)]
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (:)
((time -> (time, Maybe T)) -> IO time -> IO (time, Maybe T)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (\time
t->(time
t,Maybe T
forall a. Maybe a
Nothing)) IO time
forall time. C time => IO time
getTimeSeconds)
(([(time, T)] -> [(time, Maybe T)])
-> IO [(time, T)] -> IO [(time, Maybe T)]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (((time, T) -> (time, Maybe T)) -> [(time, T)] -> [(time, Maybe T)]
forall a b. (a -> b) -> [a] -> [b]
map ((T -> Maybe T) -> (time, T) -> (time, Maybe T)
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd T -> Maybe T
forall a. a -> Maybe a
Just)) (T DuplexMode -> IO [(time, T)]
forall time mode.
(C time, AllowInput mode) =>
T mode -> IO [StampedEvent time]
getWaitingStampedEvents T DuplexMode
h))
T StrictTime (Maybe T) -> IO a
proc (T StrictTime (Maybe T) -> IO a) -> T StrictTime (Maybe T) -> IO a
forall a b. (a -> b) -> a -> b
$
time -> T time (Maybe T) -> T StrictTime (Maybe T)
forall time a. C time => time -> T time a -> T StrictTime a
discretizeTime time
rate (T time (Maybe T) -> T StrictTime (Maybe T))
-> T time (Maybe T) -> T StrictTime (Maybe T)
forall a b. (a -> b) -> a -> b
$
[(time, Maybe T)] -> T time (Maybe T)
forall a b. [(a, b)] -> T a b
AbsEventList.fromPairList ([(time, Maybe T)] -> T time (Maybe T))
-> [(time, Maybe T)] -> T time (Maybe T)
forall a b. (a -> b) -> a -> b
$ [[(time, Maybe T)]] -> [(time, Maybe T)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(time, Maybe T)]]
l
withMIDIEventsNonblockSimple :: (RealField.C time) =>
ClientName -> time -> time ->
(EventList.T StrictTime Event.T -> IO a) -> IO a
withMIDIEventsNonblockSimple :: ClientName -> time -> time -> (T StrictTime T -> IO a) -> IO a
withMIDIEventsNonblockSimple ClientName
name time
beat time
rate T StrictTime T -> IO a
proc =
ClientName -> BlockMode -> (T DuplexMode -> T -> IO a) -> IO a
forall t.
ClientName -> BlockMode -> (T DuplexMode -> T -> IO t) -> IO t
withInPort ClientName
name BlockMode
SndSeq.Nonblock ((T DuplexMode -> T -> IO a) -> IO a)
-> (T DuplexMode -> T -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \ T DuplexMode
h T
_p ->
do [[StampedEvent time]]
l <- IO [StampedEvent time] -> IO [[StampedEvent time]]
forall a. IO a -> IO [a]
ioToLazyList (IO [StampedEvent time] -> IO [[StampedEvent time]])
-> IO [StampedEvent time] -> IO [[StampedEvent time]]
forall a b. (a -> b) -> a -> b
$
Int -> IO ()
threadDelay (time -> Int
forall a b. (C a, C b) => a -> b
round (time -> Int) -> time -> Int
forall a b. (a -> b) -> a -> b
$ (time -> time -> time) -> time -> time -> time
forall a b c. (a -> b -> c) -> b -> a -> c
flip time -> time -> time
forall a. a -> a -> a
asTypeOf time
rate (time -> time) -> time -> time
forall a b. (a -> b) -> a -> b
$ time
beattime -> time -> time
forall a. C a => a -> a -> a
*time
1e6) IO () -> IO [StampedEvent time] -> IO [StampedEvent time]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
T DuplexMode -> IO [StampedEvent time]
forall time mode.
(C time, AllowInput mode) =>
T mode -> IO [StampedEvent time]
getWaitingStampedEvents T DuplexMode
h
T StrictTime T -> IO a
proc (T StrictTime T -> IO a) -> T StrictTime T -> IO a
forall a b. (a -> b) -> a -> b
$
time -> T time T -> T StrictTime T
forall time a. C time => time -> T time a -> T StrictTime a
discretizeTime time
rate (T time T -> T StrictTime T) -> T time T -> T StrictTime T
forall a b. (a -> b) -> a -> b
$
[StampedEvent time] -> T time T
forall a b. [(a, b)] -> T a b
AbsEventList.fromPairList ([StampedEvent time] -> T time T)
-> [StampedEvent time] -> T time T
forall a b. (a -> b) -> a -> b
$ [[StampedEvent time]] -> [StampedEvent time]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[StampedEvent time]]
l
setTimestamping ::
SndSeq.T mode -> Port.T -> Queue.T -> IO ()
setTimestamping :: T mode -> T -> T -> IO ()
setTimestamping T mode
h T
p T
q =
T mode -> T -> T () -> IO ()
forall mode a. T mode -> T -> T a -> IO a
PortInfo.modify T mode
h T
p (T () -> IO ()) -> T () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Bool -> T ()
PortInfo.setTimestamping Bool
True
Bool -> T ()
PortInfo.setTimestampReal Bool
True
T -> T ()
PortInfo.setTimestampQueue T
q
withMIDIEventsBlockEcho :: (RealField.C time) =>
ClientName -> time -> time ->
(EventList.T StrictTime [Event.T] -> IO a) -> IO a
withMIDIEventsBlockEcho :: ClientName -> time -> time -> (T StrictTime [T] -> IO a) -> IO a
withMIDIEventsBlockEcho ClientName
name time
beat time
rate T StrictTime [T] -> IO a
proc =
ClientName -> BlockMode -> (T DuplexMode -> T -> IO a) -> IO a
forall t.
ClientName -> BlockMode -> (T DuplexMode -> T -> IO t) -> IO t
withInPort ClientName
name BlockMode
SndSeq.Block ((T DuplexMode -> T -> IO a) -> IO a)
-> (T DuplexMode -> T -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \ T DuplexMode
h T
p ->
T DuplexMode -> (T -> IO a) -> IO a
forall mode a. T mode -> (T -> IO a) -> IO a
Queue.with T DuplexMode
h ((T -> IO a) -> IO a) -> (T -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \ T
q ->
do T DuplexMode -> T -> T -> IO ()
forall mode. T mode -> T -> T -> IO ()
setTimestamping T DuplexMode
h T
p T
q
T DuplexMode -> T -> QueueEv -> Maybe T -> IO ()
forall mode. T mode -> T -> QueueEv -> Maybe T -> IO ()
Queue.control T DuplexMode
h T
q QueueEv
Event.QueueStart Maybe T
forall a. Maybe a
Nothing
Word
_ <- T DuplexMode -> IO Word
forall mode. AllowOutput mode => T mode -> IO Word
Event.drainOutput T DuplexMode
h
T StrictTime [T] -> IO a
proc (T StrictTime [T] -> IO a)
-> ([[(time, [T])]] -> T StrictTime [T]) -> [[(time, [T])]] -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
time -> T time [T] -> T StrictTime [T]
forall time a. C time => time -> T time a -> T StrictTime a
discretizeTime time
rate (T time [T] -> T StrictTime [T])
-> ([[(time, [T])]] -> T time [T])
-> [[(time, [T])]]
-> T StrictTime [T]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[(time, [T])] -> T time [T]
forall a b. [(a, b)] -> T a b
AbsEventList.fromPairList ([(time, [T])] -> T time [T])
-> ([[(time, [T])]] -> [(time, [T])])
-> [[(time, [T])]]
-> T time [T]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[[(time, [T])]] -> [(time, [T])]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(time, [T])]] -> IO a) -> IO [[(time, [T])]] -> IO a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
([IO [(time, [T])]] -> IO [[(time, [T])]]
forall a. [IO a] -> IO [a]
lazySequence ([IO [(time, [T])]] -> IO [[(time, [T])]])
-> [IO [(time, [T])]] -> IO [[(time, [T])]]
forall a b. (a -> b) -> a -> b
$
((time -> IO [(time, [T])]) -> [time] -> [IO [(time, [T])]])
-> [time] -> (time -> IO [(time, [T])]) -> [IO [(time, [T])]]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (time -> IO [(time, [T])]) -> [time] -> [IO [(time, [T])]]
forall a b. (a -> b) -> [a] -> [b]
map ((time -> time) -> time -> [time]
forall a. (a -> a) -> a -> [a]
iterate (time
beattime -> time -> time
forall a. C a => a -> a -> a
+) time
0) ((time -> IO [(time, [T])]) -> [IO [(time, [T])]])
-> (time -> IO [(time, [T])]) -> [IO [(time, [T])]]
forall a b. (a -> b) -> a -> b
$ \time
t ->
let end :: time
end = time
ttime -> time -> time
forall a. C a => a -> a -> a
+time
beat
in
([(time, [T])] -> [(time, [T])])
-> IO [(time, [T])] -> IO [(time, [T])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((time
t,[]) (time, [T]) -> [(time, [T])] -> [(time, [T])]
forall a. a -> [a] -> [a]
:) (IO [(time, [T])] -> IO [(time, [T])])
-> IO [(time, [T])] -> IO [(time, [T])]
forall a b. (a -> b) -> a -> b
$
([(time, T)] -> [(time, [T])])
-> IO [(time, T)] -> IO [(time, [T])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((time, T) -> (time, [T])) -> [(time, T)] -> [(time, [T])]
forall a b. (a -> b) -> [a] -> [b]
map ((time -> time, T -> [T]) -> (time, T) -> (time, [T])
forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair ((time, time) -> time -> time
forall a. Ord a => (a, a) -> a -> a
limit (time
t,time
end), (T -> [T] -> [T]
forall a. a -> [a] -> [a]
:[])))) (IO [(time, T)] -> IO [(time, [T])])
-> IO [(time, T)] -> IO [(time, [T])]
forall a b. (a -> b) -> a -> b
$
T DuplexMode -> T -> T -> time -> IO [(time, T)]
forall time mode.
(C time, AllowInput mode, AllowOutput mode) =>
T mode -> T -> T -> time -> IO [StampedEvent time]
getStampedEventsUntilTime T DuplexMode
h T
q T
p time
end)
withMIDIEventsBlockEchoQuantised :: (RealField.C time) =>
ClientName -> time -> time ->
(EventList.T StrictTime [Event.T] -> IO a) -> IO a
withMIDIEventsBlockEchoQuantised :: ClientName -> time -> time -> (T StrictTime [T] -> IO a) -> IO a
withMIDIEventsBlockEchoQuantised ClientName
name time
beat time
rate T StrictTime [T] -> IO a
proc =
ClientName -> BlockMode -> (T DuplexMode -> T -> IO a) -> IO a
forall t.
ClientName -> BlockMode -> (T DuplexMode -> T -> IO t) -> IO t
withInPort ClientName
name BlockMode
SndSeq.Block ((T DuplexMode -> T -> IO a) -> IO a)
-> (T DuplexMode -> T -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \ T DuplexMode
h T
p ->
T DuplexMode -> (T -> IO a) -> IO a
forall mode a. T mode -> (T -> IO a) -> IO a
Queue.with T DuplexMode
h ((T -> IO a) -> IO a) -> (T -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \ T
q ->
do T DuplexMode -> T -> QueueEv -> Maybe T -> IO ()
forall mode. T mode -> T -> QueueEv -> Maybe T -> IO ()
Queue.control T DuplexMode
h T
q QueueEv
Event.QueueStart Maybe T
forall a. Maybe a
Nothing
Word
_ <- T DuplexMode -> IO Word
forall mode. AllowOutput mode => T mode -> IO Word
Event.drainOutput T DuplexMode
h
T StrictTime [T] -> IO a
proc (T StrictTime [T] -> IO a)
-> ([(time, [T])] -> T StrictTime [T]) -> [(time, [T])] -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
time -> T time [T] -> T StrictTime [T]
forall time a. C time => time -> T time a -> T StrictTime a
discretizeTime time
rate (T time [T] -> T StrictTime [T])
-> ([(time, [T])] -> T time [T])
-> [(time, [T])]
-> T StrictTime [T]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[(time, [T])] -> T time [T]
forall a b. [(a, b)] -> T a b
AbsEventList.fromPairList ([(time, [T])] -> IO a) -> IO [(time, [T])] -> IO a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
([IO (time, [T])] -> IO [(time, [T])]
forall a. [IO a] -> IO [a]
lazySequence ([IO (time, [T])] -> IO [(time, [T])])
-> [IO (time, [T])] -> IO [(time, [T])]
forall a b. (a -> b) -> a -> b
$
((time -> IO (time, [T])) -> [time] -> [IO (time, [T])])
-> [time] -> (time -> IO (time, [T])) -> [IO (time, [T])]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (time -> IO (time, [T])) -> [time] -> [IO (time, [T])]
forall a b. (a -> b) -> [a] -> [b]
map ((time -> time) -> time -> [time]
forall a. (a -> a) -> a -> [a]
iterate (time
beattime -> time -> time
forall a. C a => a -> a -> a
+) time
0) ((time -> IO (time, [T])) -> [IO (time, [T])])
-> (time -> IO (time, [T])) -> [IO (time, [T])]
forall a b. (a -> b) -> a -> b
$ \time
t ->
([T] -> (time, [T])) -> IO [T] -> IO (time, [T])
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
(\[T]
evs -> (time
t, [T]
evs))
(T DuplexMode -> T -> T -> time -> IO [T]
forall time mode.
(C time, AllowInput mode, AllowOutput mode) =>
T mode -> T -> T -> time -> IO [T]
getEventsUntilTime T DuplexMode
h T
q T
p (time
ttime -> time -> time
forall a. C a => a -> a -> a
+time
beat)))
withMIDIEventsChunked ::
(RealField.C time) =>
ClientName -> time -> time ->
([IO (EventListTT.T StrictTime [Event.T])] -> IO a) ->
IO a
withMIDIEventsChunked :: ClientName
-> time -> time -> ([IO (T StrictTime [T])] -> IO a) -> IO a
withMIDIEventsChunked ClientName
name time
beat time
rate [IO (T StrictTime [T])] -> IO a
proc =
ClientName -> BlockMode -> (T DuplexMode -> T -> IO a) -> IO a
forall t.
ClientName -> BlockMode -> (T DuplexMode -> T -> IO t) -> IO t
withInPort ClientName
name BlockMode
SndSeq.Block ((T DuplexMode -> T -> IO a) -> IO a)
-> (T DuplexMode -> T -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \ T DuplexMode
h T
p ->
T DuplexMode -> (T -> IO a) -> IO a
forall mode a. T mode -> (T -> IO a) -> IO a
Queue.with T DuplexMode
h ((T -> IO a) -> IO a) -> (T -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \ T
q ->
do T DuplexMode -> T -> T -> IO ()
forall mode. T mode -> T -> T -> IO ()
setTimestamping T DuplexMode
h T
p T
q
T DuplexMode -> T -> QueueEv -> Maybe T -> IO ()
forall mode. T mode -> T -> QueueEv -> Maybe T -> IO ()
Queue.control T DuplexMode
h T
q QueueEv
Event.QueueStart Maybe T
forall a. Maybe a
Nothing
Word
_ <- T DuplexMode -> IO Word
forall mode. AllowOutput mode => T mode -> IO Word
Event.drainOutput T DuplexMode
h
[IO (T StrictTime [T])] -> IO a
proc ([IO (T StrictTime [T])] -> IO a)
-> [IO (T StrictTime [T])] -> IO a
forall a b. (a -> b) -> a -> b
$
(time -> IO (T StrictTime [T]))
-> [time] -> [IO (T StrictTime [T])]
forall a b. (a -> b) -> [a] -> [b]
map
(\time
t ->
let end :: time
end = time
ttime -> time -> time
forall a. C a => a -> a -> a
+time
beat
in ([(time, T)] -> T StrictTime [T])
-> IO [(time, T)] -> IO (T StrictTime [T])
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
(\[(time, T)]
evs ->
T StrictTime [T]
-> (T StrictTime [T] -> [T] -> T StrictTime [T])
-> T StrictTime [T]
-> T StrictTime [T]
forall a time body.
a -> (T time body -> body -> a) -> T time body -> a
EventListTM.switchBodyR
([Char] -> T StrictTime [T]
forall a. HasCallStack => [Char] -> a
error [Char]
"withMIDIEventsChunked: empty list, but there must be at least the end event")
T StrictTime [T] -> [T] -> T StrictTime [T]
forall a b. a -> b -> a
const (T StrictTime [T] -> T StrictTime [T])
-> T StrictTime [T] -> T StrictTime [T]
forall a b. (a -> b) -> a -> b
$
time -> T time [T] -> T StrictTime [T]
forall time a. C time => time -> T time a -> T StrictTime a
discretizeTime time
rate (T time [T] -> T StrictTime [T]) -> T time [T] -> T StrictTime [T]
forall a b. (a -> b) -> a -> b
$
[(time, [T])] -> T time [T]
forall a b. [(a, b)] -> T a b
AbsEventList.fromPairList ([(time, [T])] -> T time [T]) -> [(time, [T])] -> T time [T]
forall a b. (a -> b) -> a -> b
$
(time
t,[]) (time, [T]) -> [(time, [T])] -> [(time, [T])]
forall a. a -> [a] -> [a]
:
((time, T) -> (time, [T])) -> [(time, T)] -> [(time, [T])]
forall a b. (a -> b) -> [a] -> [b]
map ((time -> time, T -> [T]) -> (time, T) -> (time, [T])
forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair ((time, time) -> time -> time
forall a. Ord a => (a, a) -> a -> a
limit (time
t , time
end time -> time -> time
forall a. C a => a -> a -> a
- time -> time
forall a. C a => a -> a
recip time
rate), (T -> [T] -> [T]
forall a. a -> [a] -> [a]
:[]))) [(time, T)]
evs [(time, [T])] -> [(time, [T])] -> [(time, [T])]
forall a. [a] -> [a] -> [a]
++
(time
end, []) (time, [T]) -> [(time, [T])] -> [(time, [T])]
forall a. a -> [a] -> [a]
:
[])
(T DuplexMode -> T -> T -> time -> IO [(time, T)]
forall time mode.
(C time, AllowInput mode, AllowOutput mode) =>
T mode -> T -> T -> time -> IO [StampedEvent time]
getStampedEventsUntilTime T DuplexMode
h T
q T
p time
end))
((time -> time) -> time -> [time]
forall a. (a -> a) -> a -> [a]
iterate (time
beattime -> time -> time
forall a. C a => a -> a -> a
+) time
0)
withMIDIEventsChunkedQuantised ::
(RealField.C time) =>
ClientName -> time -> time ->
([IO (EventList.T StrictTime [Event.T])] -> IO a) ->
IO a
withMIDIEventsChunkedQuantised :: ClientName
-> time -> time -> ([IO (T StrictTime [T])] -> IO a) -> IO a
withMIDIEventsChunkedQuantised ClientName
name time
beat time
rate [IO (T StrictTime [T])] -> IO a
proc =
ClientName -> BlockMode -> (T DuplexMode -> T -> IO a) -> IO a
forall t.
ClientName -> BlockMode -> (T DuplexMode -> T -> IO t) -> IO t
withInPort ClientName
name BlockMode
SndSeq.Block ((T DuplexMode -> T -> IO a) -> IO a)
-> (T DuplexMode -> T -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \ T DuplexMode
h T
p ->
T DuplexMode -> (T -> IO a) -> IO a
forall mode a. T mode -> (T -> IO a) -> IO a
Queue.with T DuplexMode
h ((T -> IO a) -> IO a) -> (T -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \ T
q ->
do T DuplexMode -> T -> QueueEv -> Maybe T -> IO ()
forall mode. T mode -> T -> QueueEv -> Maybe T -> IO ()
Queue.control T DuplexMode
h T
q QueueEv
Event.QueueStart Maybe T
forall a. Maybe a
Nothing
Word
_ <- T DuplexMode -> IO Word
forall mode. AllowOutput mode => T mode -> IO Word
Event.drainOutput T DuplexMode
h
[IO (T StrictTime [T])] -> IO a
proc ([IO (T StrictTime [T])] -> IO a)
-> [IO (T StrictTime [T])] -> IO a
forall a b. (a -> b) -> a -> b
$
(time -> IO (T StrictTime [T]))
-> [time] -> [IO (T StrictTime [T])]
forall a b. (a -> b) -> [a] -> [b]
map
(\time
t ->
([T] -> T StrictTime [T]) -> IO [T] -> IO (T StrictTime [T])
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
(\[T]
evs ->
StrictTime -> [T] -> T StrictTime [T] -> T StrictTime [T]
forall time body. time -> body -> T time body -> T time body
EventList.cons StrictTime
forall a. C a => a
NonNeg.zero [T]
evs (T StrictTime [T] -> T StrictTime [T])
-> T StrictTime [T] -> T StrictTime [T]
forall a b. (a -> b) -> a -> b
$
StrictTime -> [T] -> T StrictTime [T]
forall time body. time -> body -> T time body
EventList.singleton
([Char] -> Integer -> StrictTime
forall a. (Ord a, Num a) => [Char] -> a -> T a
NonNegW.fromNumberMsg [Char]
"chunked time conversion" (Integer -> StrictTime) -> Integer -> StrictTime
forall a b. (a -> b) -> a -> b
$
time -> Integer
forall a b. (C a, C b) => a -> b
round (time
beattime -> time -> time
forall a. C a => a -> a -> a
*time
rate)) [])
(T DuplexMode -> T -> T -> time -> IO [T]
forall time mode.
(C time, AllowInput mode, AllowOutput mode) =>
T mode -> T -> T -> time -> IO [T]
getEventsUntilTime T DuplexMode
h T
q T
p (time
ttime -> time -> time
forall a. C a => a -> a -> a
+time
beat)))
((time -> time) -> time -> [time]
forall a. (a -> a) -> a -> [a]
iterate (time
beattime -> time -> time
forall a. C a => a -> a -> a
+) time
0)
makeEcho ::
RealField.C time =>
Client.T -> Queue.T -> Port.T ->
time -> Event.Custom -> Event.T
makeEcho :: T -> T -> T -> time -> Custom -> T
makeEcho T
c T
q T
p time
t Custom
dat =
(T -> Data -> T
Event.simple
(Cons :: T -> T -> T
Addr.Cons {
client :: T
Addr.client = T
c,
port :: T
Addr.port = T
Port.unknown
})
(CustomEv -> Custom -> Data
Event.CustomEv CustomEv
Event.Echo Custom
dat))
{ queue :: T
Event.queue = T
q
, time :: T
Event.time =
Stamp -> T
Time.consAbs (Stamp -> T) -> Stamp -> T
forall a b. (a -> b) -> a -> b
$ T -> Stamp
Time.Real (T -> Stamp) -> T -> Stamp
forall a b. (a -> b) -> a -> b
$ Integer -> T
RealTime.fromInteger (Integer -> T) -> Integer -> T
forall a b. (a -> b) -> a -> b
$
time -> Integer
forall a b. (C a, C b) => a -> b
floor (time
10time -> Integer -> time
forall a. C a => a -> Integer -> a
^Integer
9 time -> time -> time
forall a. C a => a -> a -> a
* time
t)
, dest :: T
Event.dest = Cons :: T -> T -> T
Addr.Cons {
client :: T
Addr.client = T
c,
port :: T
Addr.port = T
p
}
}
withMIDIEventsBlock :: (RealField.C time) =>
ClientName -> time ->
(EventList.T StrictTime Event.T -> IO a) -> IO a
withMIDIEventsBlock :: ClientName -> time -> (T StrictTime T -> IO a) -> IO a
withMIDIEventsBlock ClientName
name time
rate T StrictTime T -> IO a
proc =
ClientName -> BlockMode -> (T DuplexMode -> T -> IO a) -> IO a
forall t.
ClientName -> BlockMode -> (T DuplexMode -> T -> IO t) -> IO t
withInPort ClientName
name BlockMode
SndSeq.Block ((T DuplexMode -> T -> IO a) -> IO a)
-> (T DuplexMode -> T -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \ T DuplexMode
h T
_p ->
do [StampedEvent time]
l <- IO (StampedEvent time) -> IO [StampedEvent time]
forall a. IO a -> IO [a]
ioToLazyList (IO (StampedEvent time) -> IO [StampedEvent time])
-> IO (StampedEvent time) -> IO [StampedEvent time]
forall a b. (a -> b) -> a -> b
$ T DuplexMode -> IO (StampedEvent time)
forall time mode.
(C time, AllowInput mode) =>
T mode -> IO (StampedEvent time)
getStampedEvent T DuplexMode
h
T StrictTime T -> IO a
proc (T StrictTime T -> IO a) -> T StrictTime T -> IO a
forall a b. (a -> b) -> a -> b
$
time -> T time T -> T StrictTime T
forall time a. C time => time -> T time a -> T StrictTime a
discretizeTime time
rate (T time T -> T StrictTime T) -> T time T -> T StrictTime T
forall a b. (a -> b) -> a -> b
$
[StampedEvent time] -> T time T
forall a b. [(a, b)] -> T a b
AbsEventList.fromPairList [StampedEvent time]
l
withInPort ::
ClientName ->
SndSeq.BlockMode ->
(SndSeq.T SndSeq.DuplexMode -> Port.T -> IO t) -> IO t
withInPort :: ClientName -> BlockMode -> (T DuplexMode -> T -> IO t) -> IO t
withInPort (ClientName [Char]
name) BlockMode
blockMode T DuplexMode -> T -> IO t
act =
[Char] -> BlockMode -> (T DuplexMode -> IO t) -> IO t
forall mode a.
OpenMode mode =>
[Char] -> BlockMode -> (T mode -> IO a) -> IO a
SndSeq.with [Char]
SndSeq.defaultName BlockMode
blockMode ((T DuplexMode -> IO t) -> IO t) -> (T DuplexMode -> IO t) -> IO t
forall a b. (a -> b) -> a -> b
$ \T DuplexMode
h ->
T DuplexMode -> [Char] -> IO ()
forall mode. T mode -> [Char] -> IO ()
Client.setName T DuplexMode
h [Char]
name IO () -> IO t -> IO t
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
T DuplexMode -> [Char] -> Cap -> Type -> (T -> IO t) -> IO t
forall mode a.
T mode -> [Char] -> Cap -> Type -> (T -> IO a) -> IO a
Port.withSimple T DuplexMode
h [Char]
"input"
([Cap] -> Cap
Port.caps [Cap
Port.capWrite, Cap
Port.capSubsWrite])
Type
Port.typeMidiGeneric
(T DuplexMode -> T -> IO t
act T DuplexMode
h)
discretizeTime :: (RealField.C time) =>
time -> AbsEventList.T time a -> EventList.T StrictTime a
discretizeTime :: time -> T time a -> T StrictTime a
discretizeTime time
sampleRate =
(StrictTime -> StrictTime) -> T StrictTime a -> T StrictTime a
forall time body. (time -> time) -> T time body -> T time body
EventListMB.mapTimeHead (StrictTime -> StrictTime -> StrictTime
forall a b. a -> b -> a
const (StrictTime -> StrictTime -> StrictTime)
-> StrictTime -> StrictTime -> StrictTime
forall a b. (a -> b) -> a -> b
$ Integer -> StrictTime
forall a. (Ord a, Num a) => a -> T a
NonNegW.fromNumber Integer
forall a. C a => a
zero) (T StrictTime a -> T StrictTime a)
-> (T time a -> T StrictTime a) -> T time a -> T StrictTime a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
T StrictTime a -> T StrictTime a
forall time body. Num time => T time body -> T time body
EventList.fromAbsoluteEventList (T StrictTime a -> T StrictTime a)
-> (T time a -> T StrictTime a) -> T time a -> T StrictTime a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(time -> StrictTime) -> T time a -> T StrictTime a
forall time0 time1 body.
(time0 -> time1) -> T time0 body -> T time1 body
AbsEventList.mapTime
([Char] -> Integer -> StrictTime
forall a. (Ord a, Num a) => [Char] -> a -> T a
NonNegW.fromNumberMsg [Char]
"time conversion" (Integer -> StrictTime) -> (time -> Integer) -> time -> StrictTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. time -> Integer
forall a b. (C a, C b) => a -> b
round (time -> Integer) -> (time -> time) -> time -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (time
sampleRatetime -> time -> time
forall a. C a => a -> a -> a
*))
ioToLazyList :: IO a -> IO [a]
ioToLazyList :: IO a -> IO [a]
ioToLazyList IO a
m =
let go :: IO [a]
go = IO [a] -> IO [a]
forall a. IO a -> IO a
unsafeInterleaveIO (IO [a] -> IO [a]) -> IO [a] -> IO [a]
forall a b. (a -> b) -> a -> b
$ (a -> [a] -> [a]) -> IO a -> IO [a] -> IO [a]
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (:) IO a
m IO [a]
go
in IO [a]
go
lazySequence :: [IO a] -> IO [a]
lazySequence :: [IO a] -> IO [a]
lazySequence [] = [a] -> IO [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
lazySequence (IO a
m:[IO a]
ms) =
IO [a] -> IO [a]
forall a. IO a -> IO a
unsafeInterleaveIO (IO [a] -> IO [a]) -> IO [a] -> IO [a]
forall a b. (a -> b) -> a -> b
$ (a -> [a] -> [a]) -> IO a -> IO [a] -> IO [a]
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (:) IO a
m (IO [a] -> IO [a]) -> IO [a] -> IO [a]
forall a b. (a -> b) -> a -> b
$ [IO a] -> IO [a]
forall a. [IO a] -> IO [a]
lazySequence [IO a]
ms