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
  (mem, st) <- ClockConfig -> TickAction -> IO (ClockMemory, ClockState)
initClock ClockConfig
config TickAction
ac
  _ <- forkIO $ evalStateT (runReaderT clock mem) st
  pure (clockRef 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 <- BPM -> IO AbletonLink
Link.create BPM
bpm
  when (clockEnableLink config) $ Link.enable abletonLink
  sessionState <- Link.createAndCaptureAppSessionState abletonLink
  now <- Link.clock abletonLink
  let startAt = Micros
now Micros -> Micros -> Micros
forall a. Num a => a -> a -> a
+ Micros
processAhead
  Link.requestBeatAtTime sessionState 0 startAt (clockQuantum config)
  Link.commitAndDestroyAppSessionState abletonLink sessionState
  clockMV <- atomically $ newTVar NoAction
  let 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
          }
  pure (ClockMemory config (ClockRef clockMV abletonLink) ac, 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 config (ClockRef clockMV abletonLink) _) <- ReaderT ClockMemory (StateT ClockState IO) ClockMemory
forall r (m :: * -> *). MonadReader r m => m r
ask

  action <- liftIO $ atomically $ swapTVar clockMV NoAction
  processAction action

  st <- get

  let 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, Time) -> Time
arcEnd ((Time, Time) -> Time) -> (Time, Time) -> Time
forall a b. (a -> b) -> a -> b
$ ClockState -> (Time, Time)
nowArc ClockState
st

  ss <- liftIO $ Link.createAndCaptureAppSessionState abletonLink
  arcStartTime <- liftIO $ cyclesToTime config ss nextArcStartCycle
  liftIO $ Link.destroySessionState ss

  if (arcStartTime < logicalEnd)
    then clockProcess
    else 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 config (ClockRef _ abletonLink) _) <- ReaderT ClockMemory (StateT ClockState IO) ClockMemory
forall r (m :: * -> *). MonadReader r m => m r
ask
  st <- get
  now <- liftIO $ Link.clock abletonLink
  let 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 = 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 = ClockState -> Micros
ticks ClockState
st Micros -> Micros -> Micros
forall a. Num a => a -> a -> a
+ Micros
1
      logicalNow = ClockConfig -> Micros -> Micros -> Micros
logicalTime ClockConfig
config (ClockState -> Micros
start ClockState
st) Micros
preferredNewTick
      aheadOfNow = Micros
now Micros -> Micros -> Micros
forall a. Num a => a -> a -> a
+ Micros
processAhead
      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 = 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
        | Bool
drifted = Micros
actualTick
        | Bool
otherwise = Micros
preferredNewTick
      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)

  put $ st {ticks = newTick}

  if drifted
    then liftIO $ hPutStrLn stderr $ "skip: " ++ (show (actualTick - ticks st))
    else when (delta > 0) $ liftIO $ threadDelay $ fromIntegral delta

  clockCheck

-- previously called processArc
-- hands the current link operations to the TickAction
clockProcess :: Clock ()
clockProcess :: Clock ()
clockProcess = do
  (ClockMemory config ref@(ClockRef _ abletonLink) action) <- ReaderT ClockMemory (StateT ClockState IO) ClockMemory
forall r (m :: * -> *). MonadReader r m => m r
ask
  st <- get
  let 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, Time) -> Time
arcEnd ((Time, Time) -> Time) -> (Time, Time) -> Time
forall a b. (a -> b) -> a -> b
$ ClockState -> (Time, Time)
nowArc ClockState
st

  sessionState <- liftIO $ Link.createAndCaptureAppSessionState abletonLink
  endCycle <- liftIO $ timeToCycles config sessionState logicalEnd

  liftIO $ action (startCycle, endCycle) (nudged st) config ref (sessionState, sessionState)

  liftIO $ Link.commitAndDestroyAppSessionState abletonLink sessionState

  put (st {nowArc = (startCycle, endCycle)})
  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 _ (ClockRef _ abletonLink) _) <- ReaderT ClockMemory (StateT ClockState IO) ClockMemory
forall r (m :: * -> *). MonadReader r m => m r
ask
  sessionState <- liftIO $ Link.createAndCaptureAppSessionState abletonLink
  now <- liftIO $ Link.clock abletonLink
  liftIO $ Link.setTempo sessionState (fromRational bpm) now
  liftIO $ Link.commitAndDestroyAppSessionState abletonLink sessionState
processAction (SetCycle Time
cyc) = do
  (ClockMemory config (ClockRef _ abletonLink) _) <- ReaderT ClockMemory (StateT ClockState IO) ClockMemory
forall r (m :: * -> *). MonadReader r m => m r
ask
  sessionState <- liftIO $ Link.createAndCaptureAppSessionState abletonLink

  now <- liftIO $ Link.clock abletonLink
  let 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
now Micros -> Micros -> Micros
forall a. Num a => a -> a -> a
+ Micros
processAhead
      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)
  liftIO $ Link.requestBeatAtTime sessionState beat startAt (clockQuantum config)
  liftIO $ Link.commitAndDestroyAppSessionState abletonLink sessionState

  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
  ss <- AbletonLink -> IO SessionState
Link.createAndCaptureAppSessionState AbletonLink
abletonLink
  nowLink <- liftIO $ Link.clock abletonLink
  Link.forceBeatAtTime ss 0 (nowLink + processAhead) (clockQuantum config)
  pure 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
  beat <- SessionState -> Micros -> BPM -> IO BPM
Link.beatAtTime SessionState
ss Micros
time (ClockConfig -> BPM
clockQuantum ClockConfig
config)
  pure $! (toRational beat) / (toRational (clockBeatsPerCycle 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
  nowOsc <- IO Time
forall (m :: * -> *). MonadIO m => m Time
O.time
  nowLink <- liftIO $ Link.clock abletonLink
  pure $ addMicrosToOsc (lt - nowLink) 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
  ss <- AbletonLink -> IO SessionState
Link.createAndCaptureAppSessionState AbletonLink
abletonLink
  bpm <- Link.getTempo ss
  Link.destroySessionState ss
  pure $! toRational 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
  now <- AbletonLink -> IO Micros
Link.clock AbletonLink
abletonLink
  ss <- Link.createAndCaptureAppSessionState abletonLink
  c <- timeToCycles config ss now
  Link.destroySessionState ss
  pure $! 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
  action <- TVar ClockAction -> STM ClockAction
forall a. TVar a -> STM a
readTVar TVar ClockAction
clock
  case 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
  action <- TVar ClockAction -> STM ClockAction
forall a. TVar a -> STM a
readTVar TVar ClockAction
clock
  case 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
  action <- TVar ClockAction -> STM ClockAction
forall a. TVar a -> STM a
readTVar TVar ClockAction
clock
  case 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
  ss <- ClockConfig -> ClockRef -> IO SessionState
getZeroedSessionState ClockConfig
config ClockRef
ref
  temposs <- Link.createAndCaptureAppSessionState abletonLink
  -- The nowArc is a full cycle
  action (0, 1) 0 config ref (ss, temposs)
  Link.destroySessionState ss
  Link.commitAndDestroyAppSessionState abletonLink 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