{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Sound.Tidal.Stream.UI where

import Control.Concurrent.MVar
import qualified Control.Exception as E
import qualified Data.Map as Map
import qualified Sound.Tidal.Clock as Clock
import Sound.Tidal.Config
import Sound.Tidal.ID
import Sound.Tidal.Pattern
import Sound.Tidal.Stream.Process
import Sound.Tidal.Stream.Types
import System.IO (hPutStrLn, stderr)
import System.Random (getStdRandom, randomR)

streamNudgeAll :: Stream -> Double -> IO ()
streamNudgeAll :: Stream -> Double -> IO ()
streamNudgeAll Stream
s = ClockRef -> Double -> IO ()
Clock.setNudge (Stream -> ClockRef
sClockRef Stream
s)

streamResetCycles :: Stream -> IO ()
streamResetCycles :: Stream -> IO ()
streamResetCycles Stream
s = Stream -> Rational -> IO ()
streamSetCycle Stream
s Rational
0

streamSetCycle :: Stream -> Time -> IO ()
streamSetCycle :: Stream -> Rational -> IO ()
streamSetCycle Stream
s = ClockRef -> Rational -> IO ()
Clock.setClock (Stream -> ClockRef
sClockRef Stream
s)

streamSetCPS :: Stream -> Time -> IO ()
streamSetCPS :: Stream -> Rational -> IO ()
streamSetCPS Stream
s = ClockConfig -> ClockRef -> Rational -> IO ()
Clock.setCPS (Config -> ClockConfig
toClockConfig (Config -> ClockConfig) -> Config -> ClockConfig
forall a b. (a -> b) -> a -> b
$ Stream -> Config
sConfig Stream
s) (Stream -> ClockRef
sClockRef Stream
s)

streamSetBPM :: Stream -> Time -> IO ()
streamSetBPM :: Stream -> Rational -> IO ()
streamSetBPM Stream
s = ClockRef -> Rational -> IO ()
Clock.setBPM (Stream -> ClockRef
sClockRef Stream
s)

streamGetCPS :: Stream -> IO Time
streamGetCPS :: Stream -> IO Rational
streamGetCPS Stream
s = ClockConfig -> ClockRef -> IO Rational
Clock.getCPS (Config -> ClockConfig
toClockConfig (Config -> ClockConfig) -> Config -> ClockConfig
forall a b. (a -> b) -> a -> b
$ Stream -> Config
sConfig Stream
s) (Stream -> ClockRef
sClockRef Stream
s)

-- Deprecated - compat with old style BootTidal.hs
streamGetcps :: Stream -> IO Time
streamGetcps :: Stream -> IO Rational
streamGetcps = Stream -> IO Rational
streamGetCPS

streamGetBPM :: Stream -> IO Time
streamGetBPM :: Stream -> IO Rational
streamGetBPM Stream
s = ClockRef -> IO Rational
Clock.getBPM (Stream -> ClockRef
sClockRef Stream
s)

streamGetNow :: Stream -> IO Time
streamGetNow :: Stream -> IO Rational
streamGetNow Stream
s = ClockConfig -> ClockRef -> IO Rational
Clock.getCycleTime (Config -> ClockConfig
toClockConfig (Config -> ClockConfig) -> Config -> ClockConfig
forall a b. (a -> b) -> a -> b
$ Stream -> Config
sConfig Stream
s) (Stream -> ClockRef
sClockRef Stream
s)

-- Deprecated - compat with old style BootTidal.hs
streamGetnow :: Stream -> IO Time
streamGetnow :: Stream -> IO Rational
streamGetnow = Stream -> IO Rational
streamGetNow

streamEnableLink :: Stream -> IO ()
streamEnableLink :: Stream -> IO ()
streamEnableLink Stream
s = ClockRef -> IO ()
Clock.enableLink (Stream -> ClockRef
sClockRef Stream
s)

streamDisableLink :: Stream -> IO ()
streamDisableLink :: Stream -> IO ()
streamDisableLink Stream
s = ClockRef -> IO ()
Clock.disableLink (Stream -> ClockRef
sClockRef Stream
s)

streamList :: Stream -> IO ()
streamList :: Stream -> IO ()
streamList Stream
s = do
  PlayMap
pMap <- MVar PlayMap -> IO PlayMap
forall a. MVar a -> IO a
readMVar (Stream -> MVar PlayMap
sPMapMV Stream
s)
  let hs :: Bool
hs = PlayMap -> Bool
forall k. Map k PlayState -> Bool
hasSolo PlayMap
pMap
  String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ ((String, PlayState) -> String) -> [(String, PlayState)] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Bool -> (String, PlayState) -> String
showKV Bool
hs) ([(String, PlayState)] -> String)
-> [(String, PlayState)] -> String
forall a b. (a -> b) -> a -> b
$ PlayMap -> [(String, PlayState)]
forall k a. Map k a -> [(k, a)]
Map.toList PlayMap
pMap
  where
    showKV :: Bool -> (PatId, PlayState) -> String
    showKV :: Bool -> (String, PlayState) -> String
showKV Bool
True (String
k, (PlayState {psSolo :: PlayState -> Bool
psSolo = Bool
True})) = String
k String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" - solo\n"
    showKV Bool
True (String
k, PlayState
_) = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
k String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")\n"
    showKV Bool
False (String
k, (PlayState {psSolo :: PlayState -> Bool
psSolo = Bool
False})) = String
k String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"
    showKV Bool
False (String
k, PlayState
_) = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
k String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") - muted\n"

-- Evaluation of pat is forced so exceptions are picked up here, before replacing the existing pattern.
streamReplace :: Stream -> ID -> ControlPattern -> IO ()
streamReplace :: Stream -> ID -> ControlPattern -> IO ()
streamReplace Stream
stream ID
k !ControlPattern
pat = do
  Rational
t <- ClockConfig -> ClockRef -> IO Rational
Clock.getCycleTime (Config -> ClockConfig
toClockConfig (Config -> ClockConfig) -> Config -> ClockConfig
forall a b. (a -> b) -> a -> b
$ Stream -> Config
sConfig Stream
stream) (Stream -> ClockRef
sClockRef Stream
stream)
  Stream -> ID -> Rational -> ControlPattern -> IO ()
updatePattern Stream
stream ID
k Rational
t ControlPattern
pat

-- streamFirst but with random cycle instead of always first cicle
streamOnce :: Stream -> ControlPattern -> IO ()
streamOnce :: Stream -> ControlPattern -> IO ()
streamOnce Stream
st ControlPattern
p = do
  Int
i <- (StdGen -> (Int, StdGen)) -> IO Int
forall (m :: * -> *) a. MonadIO m => (StdGen -> (a, StdGen)) -> m a
getStdRandom ((StdGen -> (Int, StdGen)) -> IO Int)
-> (StdGen -> (Int, StdGen)) -> IO Int
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> StdGen -> (Int, StdGen)
forall g. RandomGen g => (Int, Int) -> g -> (Int, g)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (Int
0, Int
8192)
  Stream -> ControlPattern -> IO ()
streamFirst Stream
st (ControlPattern -> IO ()) -> ControlPattern -> IO ()
forall a b. (a -> b) -> a -> b
$ Rational -> ControlPattern -> ControlPattern
forall a. Rational -> Pattern a -> Pattern a
rotL (Int -> Rational
forall a. Real a => a -> Rational
toRational (Int
i :: Int)) ControlPattern
p

streamFirst :: Stream -> ControlPattern -> IO ()
streamFirst :: Stream -> ControlPattern -> IO ()
streamFirst Stream
stream ControlPattern
pat = ClockConfig
-> ClockRef
-> MVar ValueMap
-> MVar PlayMap
-> MVar (ControlPattern -> ControlPattern)
-> [Cx]
-> ControlPattern
-> IO ()
onSingleTick (Config -> ClockConfig
toClockConfig (Config -> ClockConfig) -> Config -> ClockConfig
forall a b. (a -> b) -> a -> b
$ Stream -> Config
sConfig Stream
stream) (Stream -> ClockRef
sClockRef Stream
stream) (Stream -> MVar ValueMap
sStateMV Stream
stream) (Stream -> MVar PlayMap
sPMapMV Stream
stream) (Stream -> MVar (ControlPattern -> ControlPattern)
sGlobalFMV Stream
stream) (Stream -> [Cx]
sCxs Stream
stream) ControlPattern
pat

streamMute :: Stream -> ID -> IO ()
streamMute :: Stream -> ID -> IO ()
streamMute Stream
s ID
k = Stream -> [ID] -> (PlayState -> PlayState) -> IO ()
withPatIds Stream
s [ID
k] (\PlayState
x -> PlayState
x {psMute = True})

streamMutes :: Stream -> [ID] -> IO ()
streamMutes :: Stream -> [ID] -> IO ()
streamMutes Stream
s [ID]
ks = Stream -> [ID] -> (PlayState -> PlayState) -> IO ()
withPatIds Stream
s [ID]
ks (\PlayState
x -> PlayState
x {psMute = True})

streamUnmute :: Stream -> ID -> IO ()
streamUnmute :: Stream -> ID -> IO ()
streamUnmute Stream
s ID
k = Stream -> [ID] -> (PlayState -> PlayState) -> IO ()
withPatIds Stream
s [ID
k] (\PlayState
x -> PlayState
x {psMute = False})

streamSolo :: Stream -> ID -> IO ()
streamSolo :: Stream -> ID -> IO ()
streamSolo Stream
s ID
k = Stream -> [ID] -> (PlayState -> PlayState) -> IO ()
withPatIds Stream
s [ID
k] (\PlayState
x -> PlayState
x {psSolo = True})

streamUnsolo :: Stream -> ID -> IO ()
streamUnsolo :: Stream -> ID -> IO ()
streamUnsolo Stream
s ID
k = Stream -> [ID] -> (PlayState -> PlayState) -> IO ()
withPatIds Stream
s [ID
k] (\PlayState
x -> PlayState
x {psSolo = False})

withPatIds :: Stream -> [ID] -> (PlayState -> PlayState) -> IO ()
withPatIds :: Stream -> [ID] -> (PlayState -> PlayState) -> IO ()
withPatIds Stream
s [ID]
ks PlayState -> PlayState
f =
  do
    PlayMap
playMap <- MVar PlayMap -> IO PlayMap
forall a. MVar a -> IO a
takeMVar (MVar PlayMap -> IO PlayMap) -> MVar PlayMap -> IO PlayMap
forall a b. (a -> b) -> a -> b
$ Stream -> MVar PlayMap
sPMapMV Stream
s
    let pMap' :: PlayMap
pMap' = (String -> PlayMap -> PlayMap) -> PlayMap -> [String] -> PlayMap
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((PlayState -> Maybe PlayState) -> String -> PlayMap -> PlayMap
forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
Map.update (\PlayState
x -> PlayState -> Maybe PlayState
forall a. a -> Maybe a
Just (PlayState -> Maybe PlayState) -> PlayState -> Maybe PlayState
forall a b. (a -> b) -> a -> b
$ PlayState -> PlayState
f PlayState
x)) PlayMap
playMap ((ID -> String) -> [ID] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ID -> String
fromID [ID]
ks)
    MVar PlayMap -> PlayMap -> IO ()
forall a. MVar a -> a -> IO ()
putMVar (Stream -> MVar PlayMap
sPMapMV Stream
s) PlayMap
pMap'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- TODO - is there a race condition here?
streamMuteAll :: Stream -> IO ()
streamMuteAll :: Stream -> IO ()
streamMuteAll Stream
s = MVar PlayMap -> (PlayMap -> IO PlayMap) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (Stream -> MVar PlayMap
sPMapMV Stream
s) ((PlayMap -> IO PlayMap) -> IO ())
-> (PlayMap -> IO PlayMap) -> IO ()
forall a b. (a -> b) -> a -> b
$ PlayMap -> IO PlayMap
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (PlayMap -> IO PlayMap)
-> (PlayMap -> PlayMap) -> PlayMap -> IO PlayMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PlayState -> PlayState) -> PlayMap -> PlayMap
forall a b. (a -> b) -> Map String a -> Map String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\PlayState
x -> PlayState
x {psMute = True})

streamHush :: Stream -> IO ()
streamHush :: Stream -> IO ()
streamHush Stream
s = MVar PlayMap -> (PlayMap -> IO PlayMap) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (Stream -> MVar PlayMap
sPMapMV Stream
s) ((PlayMap -> IO PlayMap) -> IO ())
-> (PlayMap -> IO PlayMap) -> IO ()
forall a b. (a -> b) -> a -> b
$ PlayMap -> IO PlayMap
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (PlayMap -> IO PlayMap)
-> (PlayMap -> PlayMap) -> PlayMap -> IO PlayMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PlayState -> PlayState) -> PlayMap -> PlayMap
forall a b. (a -> b) -> Map String a -> Map String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\PlayState
x -> PlayState
x {psPattern = silence, psHistory = silence : psHistory x})

streamUnmuteAll :: Stream -> IO ()
streamUnmuteAll :: Stream -> IO ()
streamUnmuteAll Stream
s = MVar PlayMap -> (PlayMap -> IO PlayMap) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (Stream -> MVar PlayMap
sPMapMV Stream
s) ((PlayMap -> IO PlayMap) -> IO ())
-> (PlayMap -> IO PlayMap) -> IO ()
forall a b. (a -> b) -> a -> b
$ PlayMap -> IO PlayMap
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (PlayMap -> IO PlayMap)
-> (PlayMap -> PlayMap) -> PlayMap -> IO PlayMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PlayState -> PlayState) -> PlayMap -> PlayMap
forall a b. (a -> b) -> Map String a -> Map String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\PlayState
x -> PlayState
x {psMute = False})

streamUnsoloAll :: Stream -> IO ()
streamUnsoloAll :: Stream -> IO ()
streamUnsoloAll Stream
s = MVar PlayMap -> (PlayMap -> IO PlayMap) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (Stream -> MVar PlayMap
sPMapMV Stream
s) ((PlayMap -> IO PlayMap) -> IO ())
-> (PlayMap -> IO PlayMap) -> IO ()
forall a b. (a -> b) -> a -> b
$ PlayMap -> IO PlayMap
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (PlayMap -> IO PlayMap)
-> (PlayMap -> PlayMap) -> PlayMap -> IO PlayMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PlayState -> PlayState) -> PlayMap -> PlayMap
forall a b. (a -> b) -> Map String a -> Map String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\PlayState
x -> PlayState
x {psSolo = False})

streamSilence :: Stream -> ID -> IO ()
streamSilence :: Stream -> ID -> IO ()
streamSilence Stream
s ID
k = Stream -> [ID] -> (PlayState -> PlayState) -> IO ()
withPatIds Stream
s [ID
k] (\PlayState
x -> PlayState
x {psPattern = silence, psHistory = silence : psHistory x})

streamAll :: Stream -> (ControlPattern -> ControlPattern) -> IO ()
streamAll :: Stream -> (ControlPattern -> ControlPattern) -> IO ()
streamAll Stream
s ControlPattern -> ControlPattern
f = do
  ControlPattern -> ControlPattern
_ <- MVar (ControlPattern -> ControlPattern)
-> (ControlPattern -> ControlPattern)
-> IO (ControlPattern -> ControlPattern)
forall a. MVar a -> a -> IO a
swapMVar (Stream -> MVar (ControlPattern -> ControlPattern)
sGlobalFMV Stream
s) ControlPattern -> ControlPattern
f
  () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

streamGet :: Stream -> String -> IO (Maybe Value)
streamGet :: Stream -> String -> IO (Maybe Value)
streamGet Stream
s String
k = String -> ValueMap -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
k (ValueMap -> Maybe Value) -> IO ValueMap -> IO (Maybe Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVar ValueMap -> IO ValueMap
forall a. MVar a -> IO a
readMVar (Stream -> MVar ValueMap
sStateMV Stream
s)

streamSet :: (Valuable a) => Stream -> String -> Pattern a -> IO ()
streamSet :: forall a. Valuable a => Stream -> String -> Pattern a -> IO ()
streamSet Stream
s String
k Pattern a
pat = do
  ValueMap
sMap <- MVar ValueMap -> IO ValueMap
forall a. MVar a -> IO a
takeMVar (MVar ValueMap -> IO ValueMap) -> MVar ValueMap -> IO ValueMap
forall a b. (a -> b) -> a -> b
$ Stream -> MVar ValueMap
sStateMV Stream
s
  let pat' :: Pattern Value
pat' = a -> Value
forall a. Valuable a => a -> Value
toValue (a -> Value) -> Pattern a -> Pattern Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern a
pat
      sMap' :: ValueMap
sMap' = String -> Value -> ValueMap -> ValueMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert String
k (Pattern Value -> Value
VPattern Pattern Value
pat') ValueMap
sMap
  MVar ValueMap -> ValueMap -> IO ()
forall a. MVar a -> a -> IO ()
putMVar (Stream -> MVar ValueMap
sStateMV Stream
s) (ValueMap -> IO ()) -> ValueMap -> IO ()
forall a b. (a -> b) -> a -> b
$ ValueMap
sMap'

streamSetI :: Stream -> String -> Pattern Int -> IO ()
streamSetI :: Stream -> String -> Pattern Int -> IO ()
streamSetI = Stream -> String -> Pattern Int -> IO ()
forall a. Valuable a => Stream -> String -> Pattern a -> IO ()
streamSet

streamSetF :: Stream -> String -> Pattern Double -> IO ()
streamSetF :: Stream -> String -> Pattern Double -> IO ()
streamSetF = Stream -> String -> Pattern Double -> IO ()
forall a. Valuable a => Stream -> String -> Pattern a -> IO ()
streamSet

streamSetS :: Stream -> String -> Pattern String -> IO ()
streamSetS :: Stream -> String -> Pattern String -> IO ()
streamSetS = Stream -> String -> Pattern String -> IO ()
forall a. Valuable a => Stream -> String -> Pattern a -> IO ()
streamSet

streamSetB :: Stream -> String -> Pattern Bool -> IO ()
streamSetB :: Stream -> String -> Pattern Bool -> IO ()
streamSetB = Stream -> String -> Pattern Bool -> IO ()
forall a. Valuable a => Stream -> String -> Pattern a -> IO ()
streamSet

streamSetR :: Stream -> String -> Pattern Rational -> IO ()
streamSetR :: Stream -> String -> Pattern Rational -> IO ()
streamSetR = Stream -> String -> Pattern Rational -> IO ()
forall a. Valuable a => Stream -> String -> Pattern a -> IO ()
streamSet