{-# LINE 1 "src/hs/Sound/Tidal/Link.hsc" #-}
{-# LANGUAGE ForeignFunctionInterface #-}

module Sound.Tidal.Link where



import Foreign
import Foreign.C.Types
import Data.Int()

data AbletonLinkImpl
data SessionStateImpl

newtype AbletonLink = AbletonLink (Ptr AbletonLinkImpl)
newtype SessionState = SessionState (Ptr SessionStateImpl)

instance Show AbletonLink where
  show :: AbletonLink -> String
show AbletonLink
_ = String
"-unshowable-"

instance Show SessionState where
  show :: SessionState -> String
show SessionState
_ = String
"-unshowable-"

type Beat    = CDouble
type BPM     = CDouble
type Micros  = Int64
type Quantum = CDouble

instance Storable AbletonLink where
  alignment :: AbletonLink -> Int
alignment AbletonLink
_ = Int
8
{-# LINE 30 "src/hs/Sound/Tidal/Link.hsc" #-}
  sizeOf    _ = (8)
{-# LINE 31 "src/hs/Sound/Tidal/Link.hsc" #-}
  peek ptr = do
    impl <- (\hsc_ptr -> peekByteOff hsc_ptr 0) ptr
{-# LINE 33 "src/hs/Sound/Tidal/Link.hsc" #-}
    return (AbletonLink impl)
  poke :: Ptr AbletonLink -> AbletonLink -> IO ()
poke Ptr AbletonLink
ptr (AbletonLink Ptr AbletonLinkImpl
impl) = do
    (\Ptr AbletonLink
hsc_ptr -> Ptr AbletonLink -> Int -> Ptr AbletonLinkImpl -> IO ()
forall b. Ptr b -> Int -> Ptr AbletonLinkImpl -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr AbletonLink
hsc_ptr Int
0) Ptr AbletonLink
ptr Ptr AbletonLinkImpl
impl
{-# LINE 36 "src/hs/Sound/Tidal/Link.hsc" #-}

instance Storable SessionState where
  alignment :: SessionState -> Int
alignment SessionState
_ = Int
8
{-# LINE 39 "src/hs/Sound/Tidal/Link.hsc" #-}
  sizeOf    _ = (8)
{-# LINE 40 "src/hs/Sound/Tidal/Link.hsc" #-}
  peek ptr = do
    impl <- (\hsc_ptr -> peekByteOff hsc_ptr 0) ptr
{-# LINE 42 "src/hs/Sound/Tidal/Link.hsc" #-}
    return (SessionState impl)
  poke :: Ptr SessionState -> SessionState -> IO ()
poke Ptr SessionState
ptr (SessionState Ptr SessionStateImpl
impl) = do
    (\Ptr SessionState
hsc_ptr -> Ptr SessionState -> Int -> Ptr SessionStateImpl -> IO ()
forall b. Ptr b -> Int -> Ptr SessionStateImpl -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr SessionState
hsc_ptr Int
0) Ptr SessionState
ptr Ptr SessionStateImpl
impl
{-# LINE 45 "src/hs/Sound/Tidal/Link.hsc" #-}

foreign import ccall "abl_link.h abl_link_create"
  create :: BPM -> IO AbletonLink

foreign import ccall "abl_link.h abl_link_enable"
  abl_link_enable :: AbletonLink -> CBool -> IO ()

setEnabled :: Bool -> AbletonLink -> IO ()
setEnabled :: Bool -> AbletonLink -> IO ()
setEnabled Bool
True AbletonLink
al = AbletonLink -> CBool -> IO ()
abl_link_enable AbletonLink
al (Word8 -> CBool
CBool Word8
1)
setEnabled Bool
False AbletonLink
al = AbletonLink -> CBool -> IO ()
abl_link_enable AbletonLink
al (Word8 -> CBool
CBool Word8
0)

enable :: AbletonLink -> IO ()
enable :: AbletonLink -> IO ()
enable = Bool -> AbletonLink -> IO ()
setEnabled Bool
True

disable :: AbletonLink -> IO ()
disable :: AbletonLink -> IO ()
disable = Bool -> AbletonLink -> IO ()
setEnabled Bool
False

foreign import ccall "abl_link.h abl_link_create_session_state"
  createSessionState :: IO SessionState

foreign import ccall "abl_link.h abl_link_capture_app_session_state"
  captureAppSessionState :: AbletonLink -> SessionState -> IO ()

createAndCaptureAppSessionState :: AbletonLink -> IO SessionState
createAndCaptureAppSessionState :: AbletonLink -> IO SessionState
createAndCaptureAppSessionState AbletonLink
al = do
  SessionState
sessionState <- IO SessionState
createSessionState
  AbletonLink -> SessionState -> IO ()
captureAppSessionState AbletonLink
al SessionState
sessionState
  SessionState -> IO SessionState
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SessionState
sessionState

foreign import ccall "abl_link.h abl_link_commit_app_session_state"
  commitAppSessionState :: AbletonLink -> SessionState -> IO ()

foreign import ccall "abl_link.h abl_link_destroy_session_state"
  destroySessionState :: SessionState -> IO ()

commitAndDestroyAppSessionState :: AbletonLink -> SessionState -> IO ()
commitAndDestroyAppSessionState :: AbletonLink -> SessionState -> IO ()
commitAndDestroyAppSessionState AbletonLink
al SessionState
ss = do
  AbletonLink -> SessionState -> IO ()
commitAppSessionState AbletonLink
al SessionState
ss
  SessionState -> IO ()
destroySessionState SessionState
ss

foreign import ccall "abl_link.h abl_link_clock_micros"
  clock :: AbletonLink -> IO Micros

foreign import ccall "abl_link.h abl_link_beat_at_time"
  beatAtTime :: SessionState -> Micros -> Quantum -> IO Beat

foreign import ccall "abl_link.h abl_link_time_at_beat"
  timeAtBeat :: SessionState -> Beat -> Quantum -> IO Micros

foreign import ccall "abl_link.h abl_link_tempo"
  getTempo :: SessionState -> IO BPM

foreign import ccall "abl_link.h abl_link_set_tempo"
  setTempo :: SessionState -> BPM -> Micros -> IO ()

foreign import ccall "abl_link.h abl_link_request_beat_at_time"
  requestBeatAtTime :: SessionState -> Beat -> Micros -> Quantum -> IO ()

foreign import ccall "abl_link.h abl_link_force_beat_at_time"
  forceBeatAtTime :: SessionState -> Beat -> Micros -> Quantum -> IO ()

-- |Test
hello :: IO ()
hello :: IO ()
hello = do
    String -> IO ()
forall a. Show a => a -> IO ()
print String
"hello"
    AbletonLink
link <- BPM -> IO AbletonLink
create BPM
88
    String -> IO ()
forall a. Show a => a -> IO ()
print String
"Created link"
    String
_ <- IO String
getLine
    String -> IO ()
forall a. Show a => a -> IO ()
print String
"gotline"
    Micros
now <- AbletonLink -> IO Micros
clock AbletonLink
link
    String -> IO ()
forall a. Show a => a -> IO ()
print (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Now: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Micros -> String
forall a. Show a => a -> String
show Micros
now
    String -> IO ()
forall a. Show a => a -> IO ()
print String
"gotline"
    AbletonLink -> IO ()
enable AbletonLink
link
    String -> IO ()
forall a. Show a => a -> IO ()
print String
"Link enabled"
    String
_ <- IO String
getLine
    String -> IO ()
forall a. Show a => a -> IO ()
print String
"gotline"
    SessionState
sessionState <- IO SessionState
createSessionState
    String -> IO ()
forall a. Show a => a -> IO ()
print String
"Created sessionState"
    String
_ <- IO String
getLine
    String -> IO ()
forall a. Show a => a -> IO ()
print String
"gotline"
    AbletonLink -> SessionState -> IO ()
captureAppSessionState AbletonLink
link SessionState
sessionState
    String
_line_1 <- IO String
getLine
    String -> IO ()
forall a. Show a => a -> IO ()
print String
"gotline"
    SessionState -> BPM -> Micros -> IO ()
setTempo SessionState
sessionState BPM
130 Micros
now
    BPM
beat <- SessionState -> Micros -> BPM -> IO BPM
beatAtTime SessionState
sessionState Micros
now BPM
1
    String -> IO ()
forall a. Show a => a -> IO ()
print (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"beat: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ BPM -> String
forall a. Show a => a -> String
show BPM
beat
    String
_line_2 <- IO String
getLine
    String -> IO ()
forall a. Show a => a -> IO ()
print String
"gotline"
    Micros
now' <- AbletonLink -> IO Micros
clock AbletonLink
link
    String -> IO ()
forall a. Show a => a -> IO ()
print (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Now': " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Micros -> String
forall a. Show a => a -> String
show Micros
now'
    BPM
beat' <- SessionState -> Micros -> BPM -> IO BPM
beatAtTime SessionState
sessionState Micros
now' BPM
1
    String -> IO ()
forall a. Show a => a -> IO ()
print (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"beat': " String -> ShowS
forall a. [a] -> [a] -> [a]
++ BPM -> String
forall a. Show a => a -> String
show BPM
beat'
    AbletonLink -> SessionState -> IO ()
commitAndDestroyAppSessionState AbletonLink
link SessionState
sessionState
    String
_line_3 <- IO String
getLine
    String -> IO ()
forall a. Show a => a -> IO ()
print (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"done"