module Sound.Tidal.Stream.Main where

import Control.Concurrent (forkIO, newMVar)
import qualified Data.Map as Map
import qualified Sound.Tidal.Clock as Clock
import Sound.Tidal.Config
  ( Config (cCtrlAddr, cCtrlPort),
    toClockConfig,
    verbose,
  )
import Sound.Tidal.Stream.Listen
  ( ctrlResponder,
    openListener,
  )
import Sound.Tidal.Stream.Process (doTick)
import Sound.Tidal.Stream.Target (getCXs, superdirtShape)
import Sound.Tidal.Stream.Types (OSC, Stream (..), Target)
import Sound.Tidal.Version (tidal_status_string)
import System.IO (hPutStrLn, stderr)

{-
    Main.hs - Start tidals stream, listen and act on incoming messages
    Copyright (C) 2020, Alex McLean and contributors

    This library is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    This library is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this library.  If not, see <http://www.gnu.org/licenses/>.
-}

-- Start an instance of Tidal with superdirt OSC
startTidal :: Target -> Config -> IO Stream
startTidal :: Target -> Config -> IO Stream
startTidal Target
target Config
config = Config -> [(Target, [OSC])] -> IO Stream
startStream Config
config [(Target
target, [OSC
superdirtShape])]

-- Start an instance of Tidal
-- Spawns a thread within Tempo that acts as the clock
-- Spawns a thread that listens to and acts on OSC control messages
startStream :: Config -> [(Target, [OSC])] -> IO Stream
startStream :: Config -> [(Target, [OSC])] -> IO Stream
startStream Config
config [(Target, [OSC])]
oscmap = do
  MVar (Map String Value)
sMapMV <- Map String Value -> IO (MVar (Map String Value))
forall a. a -> IO (MVar a)
newMVar Map String Value
forall k a. Map k a
Map.empty
  MVar (Map String PlayState)
pMapMV <- Map String PlayState -> IO (MVar (Map String PlayState))
forall a. a -> IO (MVar a)
newMVar Map String PlayState
forall k a. Map k a
Map.empty
  MVar (ControlPattern -> ControlPattern)
globalFMV <- (ControlPattern -> ControlPattern)
-> IO (MVar (ControlPattern -> ControlPattern))
forall a. a -> IO (MVar a)
newMVar ControlPattern -> ControlPattern
forall a. a -> a
id

  IO String
tidal_status_string IO String -> (String -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Config -> String -> IO ()
verbose Config
config
  Config -> String -> IO ()
verbose Config
config (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Listening for external controls on " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Config -> String
cCtrlAddr Config
config String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Config -> Int
cCtrlPort Config
config)
  Maybe Udp
listen <- Config -> IO (Maybe Udp)
openListener Config
config

  [Cx]
cxs <- Config -> [(Target, [OSC])] -> IO [Cx]
getCXs Config
config [(Target, [OSC])]
oscmap

  ClockRef
clockRef <- ClockConfig -> TickAction -> IO ClockRef
Clock.clocked (Config -> ClockConfig
toClockConfig Config
config) (MVar (Map String Value)
-> MVar (Map String PlayState)
-> MVar (ControlPattern -> ControlPattern)
-> [Cx]
-> TickAction
doTick MVar (Map String Value)
sMapMV MVar (Map String PlayState)
pMapMV MVar (ControlPattern -> ControlPattern)
globalFMV [Cx]
cxs)

  let stream :: Stream
stream =
        Stream
          { sConfig :: Config
sConfig = Config
config,
            sStateMV :: MVar (Map String Value)
sStateMV = MVar (Map String Value)
sMapMV,
            sClockRef :: ClockRef
sClockRef = ClockRef
clockRef,
            -- sLink = abletonLink,
            sListen :: Maybe Udp
sListen = Maybe Udp
listen,
            sPMapMV :: MVar (Map String PlayState)
sPMapMV = MVar (Map String PlayState)
pMapMV,
            -- sActionsMV = actionsMV,
            sGlobalFMV :: MVar (ControlPattern -> ControlPattern)
sGlobalFMV = MVar (ControlPattern -> ControlPattern)
globalFMV,
            sCxs :: [Cx]
sCxs = [Cx]
cxs
          }

  -- Spawn a thread to handle OSC control messages
  ThreadId
_ <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ Config -> Stream -> IO ()
ctrlResponder Config
config Stream
stream
  Stream -> IO Stream
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Stream
stream

startMulti :: [Target] -> Config -> IO ()
startMulti :: [Target] -> Config -> IO ()
startMulti [Target]
_ Config
_ = Handle -> String -> IO ()
hPutStrLn Handle
stderr String
"startMulti has been removed, please check the latest documentation on tidalcycles.org"