{-# LANGUAGE ForeignFunctionInterface #-} module Sound.Tidal.Link where #include "abl_link.h" 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 _ = "-unshowable-" instance Show SessionState where show _ = "-unshowable-" type Beat = CDouble type BPM = CDouble type Micros = Int64 type Quantum = CDouble instance Storable AbletonLink where alignment _ = #{alignment abl_link} sizeOf _ = #{size abl_link} peek ptr = do impl <- #{peek abl_link,impl} ptr return (AbletonLink impl) poke ptr (AbletonLink impl) = do #{poke abl_link,impl} ptr impl instance Storable SessionState where alignment _ = #{alignment abl_link_session_state} sizeOf _ = #{size abl_link_session_state} peek ptr = do impl <- #{peek abl_link_session_state,impl} ptr return (SessionState impl) poke ptr (SessionState impl) = do #{poke abl_link_session_state,impl} ptr impl 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 True al = abl_link_enable al (CBool 1) setEnabled False al = abl_link_enable al (CBool 0) enable :: AbletonLink -> IO () enable = setEnabled True disable :: AbletonLink -> IO () disable = setEnabled 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 al = do sessionState <- createSessionState captureAppSessionState al sessionState return 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 al ss = do commitAppSessionState al ss destroySessionState 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 = do print "hello" link <- create 88 print "Created link" _ <- getLine print "gotline" now <- clock link print $ "Now: " ++ show now print "gotline" enable link print "Link enabled" _ <- getLine print "gotline" sessionState <- createSessionState print "Created sessionState" _ <- getLine print "gotline" captureAppSessionState link sessionState _line_1 <- getLine print "gotline" setTempo sessionState 130 now beat <- beatAtTime sessionState now 1 print $ "beat: " ++ show beat _line_2 <- getLine print "gotline" now' <- clock link print $ "Now': " ++ show now' beat' <- beatAtTime sessionState now' 1 print $ "beat': " ++ show beat' commitAndDestroyAppSessionState link sessionState _line_3 <- getLine print $ "done"