UI.hs

module Zwirn.Stream.UI where

import Control.Concurrent (readMVar)
import Control.Concurrent.MVar (modifyMVar_, newMVar)
import qualified Data.Map as Map
import Data.Text (pack)
import qualified Data.Text as T
import qualified Sound.Osc.Transport.Fd.Udp as O
import Sound.Tidal.Clock
import qualified Sound.Tidal.Clock as Clock
import Zwirn.Core.Lib.Core (zipApply)
import Zwirn.Core.Lib.Modulate (shift, slow)
import Zwirn.Core.Lib.Number (firstCyclesThen)
import Zwirn.Core.Lib.Structure (segment)
import qualified Zwirn.Core.Time as Zwirn
import Zwirn.Core.Types (silence, toList, unzwirn, value)
import Zwirn.Language.Evaluate.Expression
import Zwirn.Stream.Process
import Zwirn.Stream.Target
import Zwirn.Stream.Types

streamDefaultBPM :: Double
streamDefaultBPM = 138

streamReplace :: Stream -> Targeted Identifier -> Zwirn Expression -> IO ()
streamReplace _ (Targeted _ (TextID "_all")) _ = return ()
streamReplace _ (Targeted _ (TextID "_none")) _ = return ()
streamReplace str (Targeted ts key) p = modifyMVar_ (sPlayMap str) (return . Map.alter alterFunc key)
  where
    newTargs = if null ts then [sDefaultTarget str] else ts
    filterTargs = filter (\t -> t `elem` Map.keys (sTargetMap str)) newTargs
    alterFunc Nothing = if null filterTargs then Nothing else Just (Targeted filterTargs (Normal, p, Nothing))
    alterFunc (Just (Targeted _ (_, _, fx))) = if null filterTargs then Nothing else Just (Targeted filterTargs (Normal, p, fx))

streamReplaceBus :: Stream -> Targeted Int -> Zwirn Expression -> IO ()
streamReplaceBus str (Targeted ts key) p = modifyMVar_ (sBusMap str) (return . Map.insert key (Targeted filterTargs $ segment (pure 128) p))
  where
    newTargs = if null ts then [sDefaultTarget str] else ts
    filterTargs = filter (\t -> t `elem` Map.keys (sTargetMap str)) newTargs

streamReplaceAction :: Stream -> Identifier -> Zwirn Expression -> IO ()
streamReplaceAction _ (TextID "_all") _ = return ()
streamReplaceAction _ (TextID "_none") _ = return ()
streamReplaceAction str key p = modifyMVar_ (sActionMap str) (return . Map.insert key p)

streamHush :: Stream -> IO ()
streamHush str = do
  modifyMVar_ (sPlayMap str) (return . const Map.empty)
  modifyMVar_ (sActionMap str) (return . const Map.empty)
  modifyMVar_ (sBusMap str) (return . const Map.empty)

streamSet :: Stream -> T.Text -> Expression -> IO ()
streamSet str x ex = modifyMVar_ (sState str) (return . Map.insert x ex)

streamSetFx :: Stream -> Identifier -> Zwirn (Zwirn Expression -> Zwirn Expression) -> IO ()
streamSetFx str (TextID "_all") fx = modifyMVar_ (sPlayMap str) (return . fmap (fmap (\(st, p, _) -> (st, p, Just fx))))
streamSetFx str (TextID "_none") _ = modifyMVar_ (sPlayMap str) (return . fmap (fmap (\(st, p, _) -> (st, p, Nothing))))
streamSetFx str key fx = modifyMVar_ (sPlayMap str) (return . Map.update (\(Targeted ts (st, p, _)) -> Just $ Targeted ts (st, p, Just fx)) key)

streamGet :: Stream -> T.Text -> IO Expression
streamGet str key = do
  sm <- readMVar (sState str)
  return $ Map.findWithDefault (EZwirn silence) key sm

streamToggle :: Stream -> Identifier -> IO ()
streamToggle str key = case key of
  (TextID "_all") -> modifyMVar_ (sPlayMap str) (return . fmap (fmap toggle))
  _ -> modifyMVar_ (sPlayMap str) (return . Map.adjust (fmap toggle) key)
  where
    toggle (Mute, p, fx) = (Normal, p, fx)
    toggle (_, p, fx) = (Mute, p, fx)

streamMute :: Stream -> Identifier -> IO ()
streamMute str key = case key of
  TextID "_all" -> modifyMVar_ (sPlayMap str) (return . fmap (fmap toggle))
  TextID "_none" -> streamUnmute str (TextID "_all")
  _ -> modifyMVar_ (sPlayMap str) (return . Map.adjust (fmap toggle) key)
  where
    toggle (Normal, p, fx) = (Mute, p, fx)
    toggle (Solo, p, fx) = (Mute, p, fx)
    toggle x = x

streamUnmute :: Stream -> Identifier -> IO ()
streamUnmute str key = case key of
  TextID "_all" -> modifyMVar_ (sPlayMap str) (return . fmap (fmap toggle))
  TextID "_none" -> streamMute str (TextID "_all")
  _ -> modifyMVar_ (sPlayMap str) (return . Map.adjust (fmap toggle) key)
  where
    toggle (Mute, p, fx) = (Normal, p, fx)
    toggle x = x

streamSolo :: Stream -> Identifier -> IO ()
streamSolo str key = case key of
  (TextID "_all") -> modifyMVar_ (sPlayMap str) (return . fmap (fmap toggle))
  (TextID "_none") -> streamUnsolo str (TextID "_all")
  _ -> modifyMVar_ (sPlayMap str) (return . Map.adjust (fmap toggle) key)
  where
    toggle (Normal, p, fx) = (Solo, p, fx)
    toggle (Mute, p, fx) = (Solo, p, fx)
    toggle x = x

streamUnsolo :: Stream -> Identifier -> IO ()
streamUnsolo str key = case key of
  (TextID "_all") -> modifyMVar_ (sPlayMap str) (return . fmap (fmap toggle))
  (TextID "_none") -> streamSolo str (TextID "_all")
  _ -> modifyMVar_ (sPlayMap str) (return . Map.adjust (fmap toggle) key)
  where
    toggle (Solo, p, fx) = (Normal, p, fx)
    toggle x = x

streamToggleSolo :: Stream -> Identifier -> IO ()
streamToggleSolo str key = case key of
  (TextID "_all") -> modifyMVar_ (sPlayMap str) (return . fmap (fmap toggle))
  _ -> modifyMVar_ (sPlayMap str) (return . Map.adjust (fmap toggle) key)
  where
    toggle (Solo, p, fx) = (Normal, p, fx)
    toggle (_, p, fx) = (Solo, p, fx)

streamSetCPS :: Stream -> Time -> IO ()
streamSetCPS str c = streamSetBPM str (c * toRational (cBeatsPerCycle (streamConfigClock $ sConfig str) * 60))

-- | set the bpm in the clock and update the tempo variable
streamSetBPM :: Stream -> Time -> IO ()
streamSetBPM s t = streamSet s "tempo" (EZwirn $ pure $ ENum $ realToFrac t) >> Clock.setBPM (sClockRef s) t

-- | read the tempo variable
streamGetBPM :: Stream -> IO Double
streamGetBPM str = do
  st <- readMVar (sState str)
  (EZwirn zt) <- streamGet str "tempo"
  let vs = toList $ unzwirn zt 0 st
  case vs of
    [] -> return streamDefaultBPM
    (v : _) -> case value $ fst v of
      ENum x -> return x
      _ -> return streamDefaultBPM

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

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

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

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

streamGetNow :: Stream -> IO Time
streamGetNow s = Clock.getCycleTime (streamConfigClock $ sConfig s) (sClockRef s)

streamFirst :: Stream -> Zwirn Expression -> IO ()
streamFirst str = streamFirstTarget str (sDefaultTarget str)

streamFirstTarget :: Stream -> TargetName -> Zwirn Expression -> IO ()
streamFirstTarget str targ z = do
  dummy <- newMVar $ Map.singleton (TextID $ pack "_streamOnceDummy_") (Targeted [targ] (Normal, z, Nothing))
  Clock.clockOnce (tickAction dummy (sActionMap str) (sBusMap str) (sState str) (sBusses str) (sTargetMap str) (sLocal str) (streamConfigPrecision $ sConfig str)) (streamConfigClock $ sConfig str) (sClockRef str)

startStream :: StreamConfig -> IO Stream
startStream config = do
  let targetConfigs = streamConfigTargets config
      conf = (streamConfigClock config) {cFrameTimespan = 10 * realToFrac (streamConfigPrecision config)}
  targetMap <- getTargetMap targetConfigs
  local <- O.udp_server (streamConfigLocalPort config)

  zMV <- newMVar Map.empty
  stMV <- newMVar Map.empty
  busMapMV <- newMVar Map.empty
  actionMapMV <- newMVar Map.empty
  bussesMV <- newMVar []

  cref <- clocked conf (tickAction zMV actionMapMV busMapMV stMV bussesMV targetMap local (streamConfigPrecision config))
  let str = Stream zMV actionMapMV busMapMV stMV bussesMV targetMap "superdirt" local cref config

  -- set the default bpm
  streamSetBPM str (realToFrac streamDefaultBPM)
  return str

evalAction :: Stream -> Zwirn Expression -> IO ()
evalAction str z = do
  st <- readMVar (sState str)
  let exps = toList $ unzwirn z 0 st
      sts = map snd exps
      exs = map (value . fst) exps

  updateState (sState str) sts
  mapM_ evalActionExp exs
  where
    evalActionExp (EAction i) = i
    evalActionExp _ = return ()

transition :: Stream -> Identifier -> (Zwirn Double -> Zwirn (Zwirn Expression -> Zwirn Expression)) -> IO ()
transition str key mapper = do
  now <- realToFrac <$> streamGetNow str
  modifyMVar_ (sPlayMap str) (return . Map.update (\(Targeted ts (ps, ex, fx)) -> Just $ Targeted ts (ps, mapper (pure now) `zipApply` ex, fx)) key)

transition' :: Stream -> Identifier -> Zwirn Zwirn.Time -> Zwirn Expression -> Zwirn Expression -> Zwirn (Zwirn Expression -> Zwirn (Zwirn Expression -> Zwirn Expression)) -> IO ()
transition' str key dur def sig mapper = do
  now <- realToFrac <$> streamGetNow str
  let shifted = shift (pure now) $ firstCyclesThen dur def (slow dur sig)
  modifyMVar_ (sPlayMap str) (return . Map.update (\(Targeted ts (ps, ex, fx)) -> Just $ Targeted ts (ps, mapper `zipApply` ex `zipApply` shifted, fx)) key)