module Sound.Tidal.Clock where

import Control.Concurrent (forkIO, threadDelay)
import Control.Concurrent.STM (TVar, atomically, modifyTVar', newTVar, readTVar, retry, swapTVar)
import Control.Monad (when)
import Control.Monad.Reader (ReaderT, ask, runReaderT)
import Control.Monad.State (StateT, evalStateT, get, liftIO, modify, put)
import Data.Coerce (coerce)
import Data.Int (Int64)
import Foreign.C.Types (CDouble (..))
import qualified Sound.Osc.Fd as O
import qualified Sound.Tidal.Link as Link
import System.IO (hPutStrLn, stderr)

type Time = Rational

-- | representation of a tick based clock
type Clock =
  ReaderT ClockMemory (StateT ClockState IO)

-- | internal read-only memory of the clock
data ClockMemory = ClockMemory
  { ClockMemory -> ClockConfig
clockConfig :: ClockConfig,
    ClockMemory -> ClockRef
clockRef :: ClockRef,
    ClockMemory -> TickAction
clockAction :: TickAction
  }

-- | internal mutable state of the clock
data ClockState = ClockState
  { ClockState -> Micros
ticks :: Int64,
    ClockState -> Micros
start :: Link.Micros,
    ClockState -> (Time, Time)
nowArc :: (Time, Time),
    ClockState -> Time
nudged :: Double
  }
  deriving (Int -> ClockState -> ShowS
[ClockState] -> ShowS
ClockState -> String
(Int -> ClockState -> ShowS)
-> (ClockState -> String)
-> ([ClockState] -> ShowS)
-> Show ClockState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ClockState -> ShowS
showsPrec :: Int -> ClockState -> ShowS
$cshow :: ClockState -> String
show :: ClockState -> String
$cshowList :: [ClockState] -> ShowS
showList :: [ClockState] -> ShowS
Show)

-- | reference to interact with the clock, while it is running
data ClockRef = ClockRef
  { ClockRef -> TVar ClockAction
rAction :: TVar ClockAction,
    ClockRef -> AbletonLink
rAbletonLink :: Link.AbletonLink
  }

-- | configuration of the clock
data ClockConfig = ClockConfig
  { ClockConfig -> BPM
clockQuantum :: CDouble,
    ClockConfig -> BPM
clockBeatsPerCycle :: CDouble,
    ClockConfig -> Time
clockFrameTimespan :: Double,
    ClockConfig -> Bool
clockEnableLink :: Bool,
    ClockConfig -> Micros
clockSkipTicks :: Int64,
    ClockConfig -> Time
clockProcessAhead :: Double
  }

-- | action to be executed on a tick,
-- | given the current timespan, nudge and reference to the clock
type TickAction =
  (Time, Time) -> Double -> ClockConfig -> ClockRef -> (Link.SessionState, Link.SessionState) -> IO ()

-- | possible actions for interacting with the clock
data ClockAction
  = NoAction
  | SetCycle Time
  | SetTempo Time
  | SetNudge Double

defaultCps :: Double
defaultCps :: Time
defaultCps = Time
0.575

defaultConfig :: ClockConfig
defaultConfig :: ClockConfig
defaultConfig =
  ClockConfig
    { clockFrameTimespan :: Time
clockFrameTimespan = Time
1 Time -> Time -> Time
forall a. Fractional a => a -> a -> a
/ Time
20,
      clockEnableLink :: Bool
clockEnableLink = Bool
False,
      clockProcessAhead :: Time
clockProcessAhead = Time
3 Time -> Time -> Time
forall a. Fractional a => a -> a -> a
/ Time
10,
      clockSkipTicks :: Micros
clockSkipTicks = Micros
10,
      clockQuantum :: BPM
clockQuantum = BPM
4,
      clockBeatsPerCycle :: BPM
clockBeatsPerCycle = BPM
4
    }

-- | creates a clock according to the config and runs it
-- | in a seperate thread
clocked :: ClockConfig -> TickAction -> IO ClockRef
clocked :: ClockConfig -> TickAction -> IO ClockRef
clocked ClockConfig
config TickAction
ac = ClockConfig -> TickAction -> Clock () -> IO ClockRef
runClock ClockConfig
config TickAction
ac Clock ()
clockCheck

-- | runs the clock on the initial state and memory as given
-- | by initClock, hands the ClockRef for interaction from outside
runClock :: ClockConfig -> TickAction -> Clock () -> IO ClockRef
runClock :: ClockConfig -> TickAction -> Clock () -> IO ClockRef
runClock ClockConfig
config TickAction
ac Clock ()
clock = do
  (ClockMemory
mem, ClockState
st) <- ClockConfig -> TickAction -> IO (ClockMemory, ClockState)
initClock ClockConfig
config TickAction
ac
  ThreadId
_ <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ StateT ClockState IO () -> ClockState -> IO ()
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (Clock () -> ClockMemory -> StateT ClockState IO ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Clock ()
clock ClockMemory
mem) ClockState
st
  ClockRef -> IO ClockRef
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClockMemory -> ClockRef
clockRef ClockMemory
mem)

-- | creates a ableton link instance and an MVar for interacting
-- | with the clock from outside and computes the initial clock state
initClock :: ClockConfig -> TickAction -> IO (ClockMemory, ClockState)
initClock :: ClockConfig -> TickAction -> IO (ClockMemory, ClockState)
initClock ClockConfig
config TickAction
ac = do
  AbletonLink
abletonLink <- BPM -> IO AbletonLink
Link.create BPM
bpm
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ClockConfig -> Bool
clockEnableLink ClockConfig
config) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ AbletonLink -> IO ()
Link.enable AbletonLink
abletonLink
  SessionState
sessionState <- AbletonLink -> IO SessionState
Link.createAndCaptureAppSessionState AbletonLink
abletonLink
  Micros
now <- AbletonLink -> IO Micros
Link.clock AbletonLink
abletonLink
  let startAt :: Micros
startAt = Micros
now Micros -> Micros -> Micros
forall a. Num a => a -> a -> a
+ Micros
processAhead
  SessionState -> BPM -> Micros -> BPM -> IO ()
Link.requestBeatAtTime SessionState
sessionState BPM
0 Micros
startAt (ClockConfig -> BPM
clockQuantum ClockConfig
config)
  AbletonLink -> SessionState -> IO ()
Link.commitAndDestroyAppSessionState AbletonLink
abletonLink SessionState
sessionState
  TVar ClockAction
clockMV <- STM (TVar ClockAction) -> IO (TVar ClockAction)
forall a. STM a -> IO a
atomically (STM (TVar ClockAction) -> IO (TVar ClockAction))
-> STM (TVar ClockAction) -> IO (TVar ClockAction)
forall a b. (a -> b) -> a -> b
$ ClockAction -> STM (TVar ClockAction)
forall a. a -> STM (TVar a)
newTVar ClockAction
NoAction
  let st :: ClockState
st =
        ClockState
          { ticks :: Micros
ticks = Micros
0,
            start :: Micros
start = Micros
now,
            nowArc :: (Time, Time)
nowArc = (Time
0, Time
0),
            nudged :: Time
nudged = Time
0
          }
  (ClockMemory, ClockState) -> IO (ClockMemory, ClockState)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClockConfig -> ClockRef -> TickAction -> ClockMemory
ClockMemory ClockConfig
config (TVar ClockAction -> AbletonLink -> ClockRef
ClockRef TVar ClockAction
clockMV AbletonLink
abletonLink) TickAction
ac, ClockState
st)
  where
    processAhead :: Micros
processAhead = Time -> Micros
forall b. Integral b => Time -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Time -> Micros) -> Time -> Micros
forall a b. (a -> b) -> a -> b
$ (ClockConfig -> Time
clockProcessAhead ClockConfig
config) Time -> Time -> Time
forall a. Num a => a -> a -> a
* Time
1000000
    bpm :: BPM
bpm = (Time -> BPM
forall a b. Coercible a b => a -> b
coerce Time
defaultCps) BPM -> BPM -> BPM
forall a. Num a => a -> a -> a
* BPM
60 BPM -> BPM -> BPM
forall a. Num a => a -> a -> a
* (ClockConfig -> BPM
clockBeatsPerCycle ClockConfig
config)

-- The reference time Link uses,
-- is the time the audio for a certain beat hits the speaker.
-- Processing of the nowArc should happen early enough for
-- all events in the nowArc to hit the speaker, but not too early.
-- Processing thus needs to happen a short while before the start
-- of nowArc. How far ahead is controlled by cProcessAhead.

-- previously called checkArc
clockCheck :: Clock ()
clockCheck :: Clock ()
clockCheck = do
  (ClockMemory ClockConfig
config (ClockRef TVar ClockAction
clockMV AbletonLink
abletonLink) TickAction
_) <- ReaderT ClockMemory (StateT ClockState IO) ClockMemory
forall r (m :: * -> *). MonadReader r m => m r
ask

  ClockAction
action <- IO ClockAction
-> ReaderT ClockMemory (StateT ClockState IO) ClockAction
forall a. IO a -> ReaderT ClockMemory (StateT ClockState IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ClockAction
 -> ReaderT ClockMemory (StateT ClockState IO) ClockAction)
-> IO ClockAction
-> ReaderT ClockMemory (StateT ClockState IO) ClockAction
forall a b. (a -> b) -> a -> b
$ STM ClockAction -> IO ClockAction
forall a. STM a -> IO a
atomically (STM ClockAction -> IO ClockAction)
-> STM ClockAction -> IO ClockAction
forall a b. (a -> b) -> a -> b
$ TVar ClockAction -> ClockAction -> STM ClockAction
forall a. TVar a -> a -> STM a
swapTVar TVar ClockAction
clockMV ClockAction
NoAction
  ClockAction -> Clock ()
processAction ClockAction
action

  ClockState
st <- ReaderT ClockMemory (StateT ClockState IO) ClockState
forall s (m :: * -> *). MonadState s m => m s
get

  let logicalEnd :: Micros
logicalEnd = ClockConfig -> Micros -> Micros -> Micros
logicalTime ClockConfig
config (ClockState -> Micros
start ClockState
st) (Micros -> Micros) -> Micros -> Micros
forall a b. (a -> b) -> a -> b
$ ClockState -> Micros
ticks ClockState
st Micros -> Micros -> Micros
forall a. Num a => a -> a -> a
+ Micros
1
      nextArcStartCycle :: Time
nextArcStartCycle = (Time, Time) -> Time
arcEnd ((Time, Time) -> Time) -> (Time, Time) -> Time
forall a b. (a -> b) -> a -> b
$ ClockState -> (Time, Time)
nowArc ClockState
st

  SessionState
ss <- IO SessionState
-> ReaderT ClockMemory (StateT ClockState IO) SessionState
forall a. IO a -> ReaderT ClockMemory (StateT ClockState IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SessionState
 -> ReaderT ClockMemory (StateT ClockState IO) SessionState)
-> IO SessionState
-> ReaderT ClockMemory (StateT ClockState IO) SessionState
forall a b. (a -> b) -> a -> b
$ AbletonLink -> IO SessionState
Link.createAndCaptureAppSessionState AbletonLink
abletonLink
  Micros
arcStartTime <- IO Micros -> ReaderT ClockMemory (StateT ClockState IO) Micros
forall a. IO a -> ReaderT ClockMemory (StateT ClockState IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Micros -> ReaderT ClockMemory (StateT ClockState IO) Micros)
-> IO Micros -> ReaderT ClockMemory (StateT ClockState IO) Micros
forall a b. (a -> b) -> a -> b
$ ClockConfig -> SessionState -> Time -> IO Micros
cyclesToTime ClockConfig
config SessionState
ss Time
nextArcStartCycle
  IO () -> Clock ()
forall a. IO a -> ReaderT ClockMemory (StateT ClockState IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Clock ()) -> IO () -> Clock ()
forall a b. (a -> b) -> a -> b
$ SessionState -> IO ()
Link.destroySessionState SessionState
ss

  if (Micros
arcStartTime Micros -> Micros -> Bool
forall a. Ord a => a -> a -> Bool
< Micros
logicalEnd)
    then Clock ()
clockProcess
    else Clock ()
tick

-- tick moves the logical time forward or recalculates the ticks in case
-- the logical time is out of sync with Link time.
-- tick delays the thread when logical time is ahead of Link time.
tick :: Clock ()
tick :: Clock ()
tick = do
  (ClockMemory ClockConfig
config (ClockRef TVar ClockAction
_ AbletonLink
abletonLink) TickAction
_) <- ReaderT ClockMemory (StateT ClockState IO) ClockMemory
forall r (m :: * -> *). MonadReader r m => m r
ask
  ClockState
st <- ReaderT ClockMemory (StateT ClockState IO) ClockState
forall s (m :: * -> *). MonadState s m => m s
get
  Micros
now <- IO Micros -> ReaderT ClockMemory (StateT ClockState IO) Micros
forall a. IO a -> ReaderT ClockMemory (StateT ClockState IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Micros -> ReaderT ClockMemory (StateT ClockState IO) Micros)
-> IO Micros -> ReaderT ClockMemory (StateT ClockState IO) Micros
forall a b. (a -> b) -> a -> b
$ AbletonLink -> IO Micros
Link.clock AbletonLink
abletonLink
  let processAhead :: Micros
processAhead = Time -> Micros
forall b. Integral b => Time -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Time -> Micros) -> Time -> Micros
forall a b. (a -> b) -> a -> b
$ (ClockConfig -> Time
clockProcessAhead ClockConfig
config) Time -> Time -> Time
forall a. Num a => a -> a -> a
* Time
1000000
      frameTimespan :: Micros
frameTimespan = Time -> Micros
forall b. Integral b => Time -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Time -> Micros) -> Time -> Micros
forall a b. (a -> b) -> a -> b
$ (ClockConfig -> Time
clockFrameTimespan ClockConfig
config) Time -> Time -> Time
forall a. Num a => a -> a -> a
* Time
1000000
      preferredNewTick :: Micros
preferredNewTick = ClockState -> Micros
ticks ClockState
st Micros -> Micros -> Micros
forall a. Num a => a -> a -> a
+ Micros
1
      logicalNow :: Micros
logicalNow = ClockConfig -> Micros -> Micros -> Micros
logicalTime ClockConfig
config (ClockState -> Micros
start ClockState
st) Micros
preferredNewTick
      aheadOfNow :: Micros
aheadOfNow = Micros
now Micros -> Micros -> Micros
forall a. Num a => a -> a -> a
+ Micros
processAhead
      actualTick :: Micros
actualTick = (Micros
aheadOfNow Micros -> Micros -> Micros
forall a. Num a => a -> a -> a
- ClockState -> Micros
start ClockState
st) Micros -> Micros -> Micros
forall a. Integral a => a -> a -> a
`div` Micros
frameTimespan
      drifted :: Bool
drifted = Micros -> Micros
forall a. Num a => a -> a
abs (Micros
actualTick Micros -> Micros -> Micros
forall a. Num a => a -> a -> a
- Micros
preferredNewTick) Micros -> Micros -> Bool
forall a. Ord a => a -> a -> Bool
> (ClockConfig -> Micros
clockSkipTicks ClockConfig
config)
      newTick :: Micros
newTick
        | Bool
drifted = Micros
actualTick
        | Bool
otherwise = Micros
preferredNewTick
      delta :: Micros
delta = Micros -> Micros -> Micros
forall a. Ord a => a -> a -> a
min Micros
frameTimespan (Micros
logicalNow Micros -> Micros -> Micros
forall a. Num a => a -> a -> a
- Micros
aheadOfNow)

  ClockState -> Clock ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (ClockState -> Clock ()) -> ClockState -> Clock ()
forall a b. (a -> b) -> a -> b
$ ClockState
st {ticks = newTick}

  if Bool
drifted
    then IO () -> Clock ()
forall a. IO a -> ReaderT ClockMemory (StateT ClockState IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Clock ()) -> IO () -> Clock ()
forall a b. (a -> b) -> a -> b
$ Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"skip: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Micros -> String
forall a. Show a => a -> String
show (Micros
actualTick Micros -> Micros -> Micros
forall a. Num a => a -> a -> a
- ClockState -> Micros
ticks ClockState
st))
    else Bool -> Clock () -> Clock ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Micros
delta Micros -> Micros -> Bool
forall a. Ord a => a -> a -> Bool
> Micros
0) (Clock () -> Clock ()) -> Clock () -> Clock ()
forall a b. (a -> b) -> a -> b
$ IO () -> Clock ()
forall a. IO a -> ReaderT ClockMemory (StateT ClockState IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Clock ()) -> IO () -> Clock ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Micros -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Micros
delta

  Clock ()
clockCheck

-- previously called processArc
-- hands the current link operations to the TickAction
clockProcess :: Clock ()
clockProcess :: Clock ()
clockProcess = do
  (ClockMemory ClockConfig
config ref :: ClockRef
ref@(ClockRef TVar ClockAction
_ AbletonLink
abletonLink) TickAction
action) <- ReaderT ClockMemory (StateT ClockState IO) ClockMemory
forall r (m :: * -> *). MonadReader r m => m r
ask
  ClockState
st <- ReaderT ClockMemory (StateT ClockState IO) ClockState
forall s (m :: * -> *). MonadState s m => m s
get
  let logicalEnd :: Micros
logicalEnd = ClockConfig -> Micros -> Micros -> Micros
logicalTime ClockConfig
config (ClockState -> Micros
start ClockState
st) (Micros -> Micros) -> Micros -> Micros
forall a b. (a -> b) -> a -> b
$ ClockState -> Micros
ticks ClockState
st Micros -> Micros -> Micros
forall a. Num a => a -> a -> a
+ Micros
1
      startCycle :: Time
startCycle = (Time, Time) -> Time
arcEnd ((Time, Time) -> Time) -> (Time, Time) -> Time
forall a b. (a -> b) -> a -> b
$ ClockState -> (Time, Time)
nowArc ClockState
st

  SessionState
sessionState <- IO SessionState
-> ReaderT ClockMemory (StateT ClockState IO) SessionState
forall a. IO a -> ReaderT ClockMemory (StateT ClockState IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SessionState
 -> ReaderT ClockMemory (StateT ClockState IO) SessionState)
-> IO SessionState
-> ReaderT ClockMemory (StateT ClockState IO) SessionState
forall a b. (a -> b) -> a -> b
$ AbletonLink -> IO SessionState
Link.createAndCaptureAppSessionState AbletonLink
abletonLink
  Time
endCycle <- IO Time -> ReaderT ClockMemory (StateT ClockState IO) Time
forall a. IO a -> ReaderT ClockMemory (StateT ClockState IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Time -> ReaderT ClockMemory (StateT ClockState IO) Time)
-> IO Time -> ReaderT ClockMemory (StateT ClockState IO) Time
forall a b. (a -> b) -> a -> b
$ ClockConfig -> SessionState -> Micros -> IO Time
timeToCycles ClockConfig
config SessionState
sessionState Micros
logicalEnd

  IO () -> Clock ()
forall a. IO a -> ReaderT ClockMemory (StateT ClockState IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Clock ()) -> IO () -> Clock ()
forall a b. (a -> b) -> a -> b
$ TickAction
action (Time
startCycle, Time
endCycle) (ClockState -> Time
nudged ClockState
st) ClockConfig
config ClockRef
ref (SessionState
sessionState, SessionState
sessionState)

  IO () -> Clock ()
forall a. IO a -> ReaderT ClockMemory (StateT ClockState IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Clock ()) -> IO () -> Clock ()
forall a b. (a -> b) -> a -> b
$ AbletonLink -> SessionState -> IO ()
Link.commitAndDestroyAppSessionState AbletonLink
abletonLink SessionState
sessionState

  ClockState -> Clock ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (ClockState
st {nowArc = (startCycle, endCycle)})
  Clock ()
tick

processAction :: ClockAction -> Clock ()
processAction :: ClockAction -> Clock ()
processAction ClockAction
NoAction = () -> Clock ()
forall a. a -> ReaderT ClockMemory (StateT ClockState IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
processAction (SetNudge Time
n) = (ClockState -> ClockState) -> Clock ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\ClockState
st -> ClockState
st {nudged = n})
processAction (SetTempo Time
bpm) = do
  (ClockMemory ClockConfig
_ (ClockRef TVar ClockAction
_ AbletonLink
abletonLink) TickAction
_) <- ReaderT ClockMemory (StateT ClockState IO) ClockMemory
forall r (m :: * -> *). MonadReader r m => m r
ask
  SessionState
sessionState <- IO SessionState
-> ReaderT ClockMemory (StateT ClockState IO) SessionState
forall a. IO a -> ReaderT ClockMemory (StateT ClockState IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SessionState
 -> ReaderT ClockMemory (StateT ClockState IO) SessionState)
-> IO SessionState
-> ReaderT ClockMemory (StateT ClockState IO) SessionState
forall a b. (a -> b) -> a -> b
$ AbletonLink -> IO SessionState
Link.createAndCaptureAppSessionState AbletonLink
abletonLink
  Micros
now <- IO Micros -> ReaderT ClockMemory (StateT ClockState IO) Micros
forall a. IO a -> ReaderT ClockMemory (StateT ClockState IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Micros -> ReaderT ClockMemory (StateT ClockState IO) Micros)
-> IO Micros -> ReaderT ClockMemory (StateT ClockState IO) Micros
forall a b. (a -> b) -> a -> b
$ AbletonLink -> IO Micros
Link.clock AbletonLink
abletonLink
  IO () -> Clock ()
forall a. IO a -> ReaderT ClockMemory (StateT ClockState IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Clock ()) -> IO () -> Clock ()
forall a b. (a -> b) -> a -> b
$ SessionState -> BPM -> Micros -> IO ()
Link.setTempo SessionState
sessionState (Time -> BPM
forall a. Fractional a => Time -> a
fromRational Time
bpm) Micros
now
  IO () -> Clock ()
forall a. IO a -> ReaderT ClockMemory (StateT ClockState IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Clock ()) -> IO () -> Clock ()
forall a b. (a -> b) -> a -> b
$ AbletonLink -> SessionState -> IO ()
Link.commitAndDestroyAppSessionState AbletonLink
abletonLink SessionState
sessionState
processAction (SetCycle Time
cyc) = do
  (ClockMemory ClockConfig
config (ClockRef TVar ClockAction
_ AbletonLink
abletonLink) TickAction
_) <- ReaderT ClockMemory (StateT ClockState IO) ClockMemory
forall r (m :: * -> *). MonadReader r m => m r
ask
  SessionState
sessionState <- IO SessionState
-> ReaderT ClockMemory (StateT ClockState IO) SessionState
forall a. IO a -> ReaderT ClockMemory (StateT ClockState IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SessionState
 -> ReaderT ClockMemory (StateT ClockState IO) SessionState)
-> IO SessionState
-> ReaderT ClockMemory (StateT ClockState IO) SessionState
forall a b. (a -> b) -> a -> b
$ AbletonLink -> IO SessionState
Link.createAndCaptureAppSessionState AbletonLink
abletonLink

  Micros
now <- IO Micros -> ReaderT ClockMemory (StateT ClockState IO) Micros
forall a. IO a -> ReaderT ClockMemory (StateT ClockState IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Micros -> ReaderT ClockMemory (StateT ClockState IO) Micros)
-> IO Micros -> ReaderT ClockMemory (StateT ClockState IO) Micros
forall a b. (a -> b) -> a -> b
$ AbletonLink -> IO Micros
Link.clock AbletonLink
abletonLink
  let processAhead :: Micros
processAhead = Time -> Micros
forall b. Integral b => Time -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Time -> Micros) -> Time -> Micros
forall a b. (a -> b) -> a -> b
$ (ClockConfig -> Time
clockProcessAhead ClockConfig
config) Time -> Time -> Time
forall a. Num a => a -> a -> a
* Time
1000000
      startAt :: Micros
startAt = Micros
now Micros -> Micros -> Micros
forall a. Num a => a -> a -> a
+ Micros
processAhead
      beat :: BPM
beat = (Time -> BPM
forall a. Fractional a => Time -> a
fromRational Time
cyc) BPM -> BPM -> BPM
forall a. Num a => a -> a -> a
* (ClockConfig -> BPM
clockBeatsPerCycle ClockConfig
config)
  IO () -> Clock ()
forall a. IO a -> ReaderT ClockMemory (StateT ClockState IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Clock ()) -> IO () -> Clock ()
forall a b. (a -> b) -> a -> b
$ SessionState -> BPM -> Micros -> BPM -> IO ()
Link.requestBeatAtTime SessionState
sessionState BPM
beat Micros
startAt (ClockConfig -> BPM
clockQuantum ClockConfig
config)
  IO () -> Clock ()
forall a. IO a -> ReaderT ClockMemory (StateT ClockState IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Clock ()) -> IO () -> Clock ()
forall a b. (a -> b) -> a -> b
$ AbletonLink -> SessionState -> IO ()
Link.commitAndDestroyAppSessionState AbletonLink
abletonLink SessionState
sessionState

  (ClockState -> ClockState) -> Clock ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\ClockState
st -> ClockState
st {ticks = 0, start = now, nowArc = (cyc, cyc)})

---------------------------------------------------------------
----------- functions representing link operations ------------
---------------------------------------------------------------

arcStart :: (Time, Time) -> Time
arcStart :: (Time, Time) -> Time
arcStart = (Time, Time) -> Time
forall a b. (a, b) -> a
fst

arcEnd :: (Time, Time) -> Time
arcEnd :: (Time, Time) -> Time
arcEnd = (Time, Time) -> Time
forall a b. (a, b) -> b
snd

beatToCycles :: ClockConfig -> Double -> Double
beatToCycles :: ClockConfig -> Time -> Time
beatToCycles ClockConfig
config Time
beat = Time
beat Time -> Time -> Time
forall a. Fractional a => a -> a -> a
/ (BPM -> Time
forall a b. Coercible a b => a -> b
coerce (BPM -> Time) -> BPM -> Time
forall a b. (a -> b) -> a -> b
$ ClockConfig -> BPM
clockBeatsPerCycle ClockConfig
config)

cyclesToBeat :: ClockConfig -> Double -> Double
cyclesToBeat :: ClockConfig -> Time -> Time
cyclesToBeat ClockConfig
config Time
cyc = Time
cyc Time -> Time -> Time
forall a. Num a => a -> a -> a
* (BPM -> Time
forall a b. Coercible a b => a -> b
coerce (BPM -> Time) -> BPM -> Time
forall a b. (a -> b) -> a -> b
$ ClockConfig -> BPM
clockBeatsPerCycle ClockConfig
config)

getSessionState :: ClockRef -> IO Link.SessionState
getSessionState :: ClockRef -> IO SessionState
getSessionState (ClockRef TVar ClockAction
_ AbletonLink
abletonLink) = AbletonLink -> IO SessionState
Link.createAndCaptureAppSessionState AbletonLink
abletonLink

-- onSingleTick assumes it runs at beat 0.
-- The best way to achieve that is to use forceBeatAtTime.
-- But using forceBeatAtTime means we can not commit its session state.
getZeroedSessionState :: ClockConfig -> ClockRef -> IO Link.SessionState
getZeroedSessionState :: ClockConfig -> ClockRef -> IO SessionState
getZeroedSessionState ClockConfig
config (ClockRef TVar ClockAction
_ AbletonLink
abletonLink) = do
  SessionState
ss <- AbletonLink -> IO SessionState
Link.createAndCaptureAppSessionState AbletonLink
abletonLink
  Micros
nowLink <- IO Micros -> IO Micros
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Micros -> IO Micros) -> IO Micros -> IO Micros
forall a b. (a -> b) -> a -> b
$ AbletonLink -> IO Micros
Link.clock AbletonLink
abletonLink
  SessionState -> BPM -> Micros -> BPM -> IO ()
Link.forceBeatAtTime SessionState
ss BPM
0 (Micros
nowLink Micros -> Micros -> Micros
forall a. Num a => a -> a -> a
+ Micros
processAhead) (ClockConfig -> BPM
clockQuantum ClockConfig
config)
  SessionState -> IO SessionState
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SessionState
ss
  where
    processAhead :: Micros
processAhead = Time -> Micros
forall b. Integral b => Time -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Time -> Micros) -> Time -> Micros
forall a b. (a -> b) -> a -> b
$ (ClockConfig -> Time
clockProcessAhead ClockConfig
config) Time -> Time -> Time
forall a. Num a => a -> a -> a
* Time
1000000

getTempo :: Link.SessionState -> IO Time
getTempo :: SessionState -> IO Time
getTempo SessionState
ss = (BPM -> Time) -> IO BPM -> IO Time
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BPM -> Time
forall a. Real a => a -> Time
toRational (IO BPM -> IO Time) -> IO BPM -> IO Time
forall a b. (a -> b) -> a -> b
$ SessionState -> IO BPM
Link.getTempo SessionState
ss

setTempoCPS :: Time -> Link.Micros -> ClockConfig -> Link.SessionState -> IO ()
setTempoCPS :: Time -> Micros -> ClockConfig -> SessionState -> IO ()
setTempoCPS Time
cps Micros
now ClockConfig
conf SessionState
ss = SessionState -> BPM -> Micros -> IO ()
Link.setTempo SessionState
ss (Time -> BPM
forall a b. Coercible a b => a -> b
coerce (Time -> BPM) -> Time -> BPM
forall a b. (a -> b) -> a -> b
$ ClockConfig -> Time -> Time
cyclesToBeat ClockConfig
conf ((Time -> Time
forall a. Fractional a => Time -> a
fromRational Time
cps) Time -> Time -> Time
forall a. Num a => a -> a -> a
* Time
60)) Micros
now

timeAtBeat :: ClockConfig -> Link.SessionState -> Double -> IO Link.Micros
timeAtBeat :: ClockConfig -> SessionState -> Time -> IO Micros
timeAtBeat ClockConfig
config SessionState
ss Time
beat = SessionState -> BPM -> BPM -> IO Micros
Link.timeAtBeat SessionState
ss (Time -> BPM
forall a b. Coercible a b => a -> b
coerce Time
beat) (ClockConfig -> BPM
clockQuantum ClockConfig
config)

timeToCycles :: ClockConfig -> Link.SessionState -> Link.Micros -> IO Time
timeToCycles :: ClockConfig -> SessionState -> Micros -> IO Time
timeToCycles ClockConfig
config SessionState
ss Micros
time = do
  BPM
beat <- SessionState -> Micros -> BPM -> IO BPM
Link.beatAtTime SessionState
ss Micros
time (ClockConfig -> BPM
clockQuantum ClockConfig
config)
  Time -> IO Time
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Time -> IO Time) -> Time -> IO Time
forall a b. (a -> b) -> a -> b
$! (BPM -> Time
forall a. Real a => a -> Time
toRational BPM
beat) Time -> Time -> Time
forall a. Fractional a => a -> a -> a
/ (BPM -> Time
forall a. Real a => a -> Time
toRational (ClockConfig -> BPM
clockBeatsPerCycle ClockConfig
config))

-- At what time does the cycle occur according to Link?
cyclesToTime :: ClockConfig -> Link.SessionState -> Time -> IO Link.Micros
cyclesToTime :: ClockConfig -> SessionState -> Time -> IO Micros
cyclesToTime ClockConfig
config SessionState
ss Time
cyc = do
  let beat :: BPM
beat = (Time -> BPM
forall a. Fractional a => Time -> a
fromRational Time
cyc) BPM -> BPM -> BPM
forall a. Num a => a -> a -> a
* (ClockConfig -> BPM
clockBeatsPerCycle ClockConfig
config)
  SessionState -> BPM -> BPM -> IO Micros
Link.timeAtBeat SessionState
ss BPM
beat (ClockConfig -> BPM
clockQuantum ClockConfig
config)

linkToOscTime :: ClockRef -> Link.Micros -> IO O.Time
linkToOscTime :: ClockRef -> Micros -> IO Time
linkToOscTime (ClockRef TVar ClockAction
_ AbletonLink
abletonLink) Micros
lt = do
  Time
nowOsc <- IO Time
forall (m :: * -> *). MonadIO m => m Time
O.time
  Micros
nowLink <- IO Micros -> IO Micros
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Micros -> IO Micros) -> IO Micros -> IO Micros
forall a b. (a -> b) -> a -> b
$ AbletonLink -> IO Micros
Link.clock AbletonLink
abletonLink
  Time -> IO Time
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Time -> IO Time) -> Time -> IO Time
forall a b. (a -> b) -> a -> b
$ Micros -> Time -> Time
addMicrosToOsc (Micros
lt Micros -> Micros -> Micros
forall a. Num a => a -> a -> a
- Micros
nowLink) Time
nowOsc

addMicrosToOsc :: Link.Micros -> O.Time -> O.Time
addMicrosToOsc :: Micros -> Time -> Time
addMicrosToOsc Micros
m Time
t = ((Micros -> Time
forall a b. (Integral a, Num b) => a -> b
fromIntegral Micros
m) Time -> Time -> Time
forall a. Fractional a => a -> a -> a
/ Time
1000000) Time -> Time -> Time
forall a. Num a => a -> a -> a
+ Time
t

-- Time is processed at a fixed rate according to configuration
-- logicalTime gives the time when a tick starts based on when
-- processing first started.
logicalTime :: ClockConfig -> Link.Micros -> Int64 -> Link.Micros
logicalTime :: ClockConfig -> Micros -> Micros -> Micros
logicalTime ClockConfig
config Micros
startTime Micros
ticks' = Micros
startTime Micros -> Micros -> Micros
forall a. Num a => a -> a -> a
+ Micros
ticks' Micros -> Micros -> Micros
forall a. Num a => a -> a -> a
* Micros
frameTimespan
  where
    frameTimespan :: Micros
frameTimespan = Time -> Micros
forall b. Integral b => Time -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Time -> Micros) -> Time -> Micros
forall a b. (a -> b) -> a -> b
$ (ClockConfig -> Time
clockFrameTimespan ClockConfig
config) Time -> Time -> Time
forall a. Num a => a -> a -> a
* Time
1000000

---------------------------------------------------------------
----------- functions for interacting with the clock ----------
---------------------------------------------------------------

getBPM :: ClockRef -> IO Time
getBPM :: ClockRef -> IO Time
getBPM (ClockRef TVar ClockAction
_ AbletonLink
abletonLink) = do
  SessionState
ss <- AbletonLink -> IO SessionState
Link.createAndCaptureAppSessionState AbletonLink
abletonLink
  BPM
bpm <- SessionState -> IO BPM
Link.getTempo SessionState
ss
  SessionState -> IO ()
Link.destroySessionState SessionState
ss
  Time -> IO Time
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Time -> IO Time) -> Time -> IO Time
forall a b. (a -> b) -> a -> b
$! BPM -> Time
forall a. Real a => a -> Time
toRational BPM
bpm

getCPS :: ClockConfig -> ClockRef -> IO Time
getCPS :: ClockConfig -> ClockRef -> IO Time
getCPS ClockConfig
config ClockRef
ref = (Time -> Time) -> IO Time -> IO Time
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Time
bpm -> Time
bpm Time -> Time -> Time
forall a. Fractional a => a -> a -> a
/ (BPM -> Time
forall a. Real a => a -> Time
toRational (BPM -> Time) -> BPM -> Time
forall a b. (a -> b) -> a -> b
$ ClockConfig -> BPM
clockBeatsPerCycle ClockConfig
config) Time -> Time -> Time
forall a. Fractional a => a -> a -> a
/ Time
60) (ClockRef -> IO Time
getBPM ClockRef
ref)

getCycleTime :: ClockConfig -> ClockRef -> IO Time
getCycleTime :: ClockConfig -> ClockRef -> IO Time
getCycleTime ClockConfig
config (ClockRef TVar ClockAction
_ AbletonLink
abletonLink) = do
  Micros
now <- AbletonLink -> IO Micros
Link.clock AbletonLink
abletonLink
  SessionState
ss <- AbletonLink -> IO SessionState
Link.createAndCaptureAppSessionState AbletonLink
abletonLink
  Time
c <- ClockConfig -> SessionState -> Micros -> IO Time
timeToCycles ClockConfig
config SessionState
ss Micros
now
  SessionState -> IO ()
Link.destroySessionState SessionState
ss
  Time -> IO Time
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Time -> IO Time) -> Time -> IO Time
forall a b. (a -> b) -> a -> b
$! Time
c

resetClock :: ClockRef -> IO ()
resetClock :: ClockRef -> IO ()
resetClock ClockRef
clock = ClockRef -> Time -> IO ()
setClock ClockRef
clock Time
0

setClock :: ClockRef -> Time -> IO ()
setClock :: ClockRef -> Time -> IO ()
setClock (ClockRef TVar ClockAction
clock AbletonLink
_) Time
t = STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  ClockAction
action <- TVar ClockAction -> STM ClockAction
forall a. TVar a -> STM a
readTVar TVar ClockAction
clock
  case ClockAction
action of
    ClockAction
NoAction -> TVar ClockAction -> (ClockAction -> ClockAction) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar ClockAction
clock (ClockAction -> ClockAction -> ClockAction
forall a b. a -> b -> a
const (ClockAction -> ClockAction -> ClockAction)
-> ClockAction -> ClockAction -> ClockAction
forall a b. (a -> b) -> a -> b
$ Time -> ClockAction
SetCycle Time
t)
    ClockAction
_ -> STM ()
forall a. STM a
retry

setBPM :: ClockRef -> Time -> IO ()
setBPM :: ClockRef -> Time -> IO ()
setBPM (ClockRef TVar ClockAction
clock AbletonLink
_) Time
t = STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  ClockAction
action <- TVar ClockAction -> STM ClockAction
forall a. TVar a -> STM a
readTVar TVar ClockAction
clock
  case ClockAction
action of
    ClockAction
NoAction -> TVar ClockAction -> (ClockAction -> ClockAction) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar ClockAction
clock (ClockAction -> ClockAction -> ClockAction
forall a b. a -> b -> a
const (ClockAction -> ClockAction -> ClockAction)
-> ClockAction -> ClockAction -> ClockAction
forall a b. (a -> b) -> a -> b
$ Time -> ClockAction
SetTempo Time
t)
    ClockAction
_ -> STM ()
forall a. STM a
retry

setCPS :: ClockConfig -> ClockRef -> Time -> IO ()
setCPS :: ClockConfig -> ClockRef -> Time -> IO ()
setCPS ClockConfig
config ClockRef
ref Time
cps = ClockRef -> Time -> IO ()
setBPM ClockRef
ref Time
bpm
  where
    bpm :: Time
bpm = Time
cps Time -> Time -> Time
forall a. Num a => a -> a -> a
* Time
60 Time -> Time -> Time
forall a. Num a => a -> a -> a
* (BPM -> Time
forall a. Real a => a -> Time
toRational (BPM -> Time) -> BPM -> Time
forall a b. (a -> b) -> a -> b
$ ClockConfig -> BPM
clockBeatsPerCycle ClockConfig
config)

setNudge :: ClockRef -> Double -> IO ()
setNudge :: ClockRef -> Time -> IO ()
setNudge (ClockRef TVar ClockAction
clock AbletonLink
_) Time
n = STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  ClockAction
action <- TVar ClockAction -> STM ClockAction
forall a. TVar a -> STM a
readTVar TVar ClockAction
clock
  case ClockAction
action of
    ClockAction
NoAction -> TVar ClockAction -> (ClockAction -> ClockAction) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar ClockAction
clock (ClockAction -> ClockAction -> ClockAction
forall a b. a -> b -> a
const (ClockAction -> ClockAction -> ClockAction)
-> ClockAction -> ClockAction -> ClockAction
forall a b. (a -> b) -> a -> b
$ Time -> ClockAction
SetNudge Time
n)
    ClockAction
_ -> STM ()
forall a. STM a
retry

-- Used for Tempo callback
-- Tempo changes will be applied.
-- However, since the full arc is processed at once and since Link does not support
-- scheduling, tempo change may affect scheduling of events that happen earlier
-- in the normal stream (the one handled by onTick).
clockOnce :: TickAction -> ClockConfig -> ClockRef -> IO ()
clockOnce :: TickAction -> ClockConfig -> ClockRef -> IO ()
clockOnce TickAction
action ClockConfig
config ref :: ClockRef
ref@(ClockRef TVar ClockAction
_ AbletonLink
abletonLink) = do
  SessionState
ss <- ClockConfig -> ClockRef -> IO SessionState
getZeroedSessionState ClockConfig
config ClockRef
ref
  SessionState
temposs <- AbletonLink -> IO SessionState
Link.createAndCaptureAppSessionState AbletonLink
abletonLink
  -- The nowArc is a full cycle
  TickAction
action (Time
0, Time
1) Time
0 ClockConfig
config ClockRef
ref (SessionState
ss, SessionState
temposs)
  SessionState -> IO ()
Link.destroySessionState SessionState
ss
  AbletonLink -> SessionState -> IO ()
Link.commitAndDestroyAppSessionState AbletonLink
abletonLink SessionState
temposs

disableLink :: ClockRef -> IO ()
disableLink :: ClockRef -> IO ()
disableLink (ClockRef TVar ClockAction
_ AbletonLink
abletonLink) = AbletonLink -> IO ()
Link.disable AbletonLink
abletonLink

enableLink :: ClockRef -> IO ()
enableLink :: ClockRef -> IO ()
enableLink (ClockRef TVar ClockAction
_ AbletonLink
abletonLink) = AbletonLink -> IO ()
Link.enable AbletonLink
abletonLink