Env.hs

module Zwirn.Stream.Env where

import Control.Concurrent (forkIO, threadDelay)
import Control.Monad (void)
import Data.Fixed (mod')
import qualified Data.Map as Map
import Data.Text
import Sound.Tidal.Clock (getCPS, getCycleTime)
import Zwirn.Core.Time (Time)
import Zwirn.Language.Builtin.Internal
import Zwirn.Language.Builtin.Prelude (builtinEnvironmentWithPlayEnv, instances)
import Zwirn.Language.Environment
import Zwirn.Language.Evaluate (Zwirn, toID)
import Zwirn.Language.Evaluate.Convert (ToExpression (..))
import Zwirn.Language.Evaluate.Expression (Expression)
import Zwirn.Language.Play
import Zwirn.Stream.Types (Stream (..), StreamConfig (..))
import Zwirn.Stream.UI as Stream

builtinEnvironmentWithStream :: Stream -> InterpreterEnv
builtinEnvironmentWithStream str = IEnv (Map.unions [std, streamFunctions str]) instances
  where
    (IEnv std _) = builtinEnvironmentWithPlayEnv (playEnvFromStream str)

playEnvFromStream :: Stream -> PlayEnv
playEnvFromStream str = (PlayEnv {playMap = sPlayMap str, actionMap = sActionMap str, busMap = sBusMap str})

once :: Stream -> Zwirn Expression -> Zwirn (IO ())
once str iz = pure (streamFirst str iz)

tonce :: Stream -> Zwirn Text -> Zwirn Expression -> Zwirn (IO ())
tonce str tz iz = flip (streamFirstTarget str) iz <$> tz

bpm :: Stream -> Zwirn Double -> Zwirn (IO ())
bpm str iz = streamSetBPM str . realToFrac <$> iz

cps :: Stream -> Zwirn Double -> Zwirn (IO ())
cps str iz = streamSetCPS str . realToFrac <$> iz

setcycle :: Stream -> Zwirn Double -> Zwirn (IO ())
setcycle str iz = streamSetCycle str . realToFrac <$> iz

resetcycles :: Stream -> Zwirn (IO ())
resetcycles str = pure $ streamResetCycles str

enablelink :: Stream -> Zwirn (IO ())
enablelink str = pure $ streamEnableLink str

disablelink :: Stream -> Zwirn (IO ())
disablelink str = pure $ streamDisableLink str

execIn :: Zwirn Double -> Zwirn (IO ()) -> Zwirn (IO ())
execIn dz acz = execInSecs_ <$> dz <*> acz
  where
    execInSecs_ :: Double -> IO () -> IO ()
    execInSecs_ d ac = void $ forkIO $ threadDelay (floor $ d * 1000000) >> ac

execIn' :: Stream -> Zwirn Double -> Zwirn (IO ()) -> Zwirn (IO ())
execIn' str dz acz = execInCycs_ <$> dz <*> acz
  where
    execInCycs_ :: Double -> IO () -> IO ()
    execInCycs_ d ac = do
      xcps <- getCPS (streamConfigClock $ sConfig str) (sClockRef str)
      void $ forkIO $ threadDelay (floor $ d * realToFrac xcps * 1000000) >> ac

execMod :: Stream -> Zwirn Double -> Zwirn (IO ()) -> Zwirn (IO ())
execMod str dz acz = execMod_ <$> dz <*> acz
  where
    execMod_ :: Double -> IO () -> IO ()
    execMod_ d ac = do
      xcps <- getCPS (streamConfigClock $ sConfig str) (sClockRef str)
      now <- getCycleTime (streamConfigClock $ sConfig str) (sClockRef str)
      let del = d - mod' (realToFrac now) d
      void $ forkIO $ threadDelay (floor $ del * realToFrac xcps * 1000000) >> ac

transition :: Stream -> Zwirn Expression -> Zwirn (Zwirn Double -> Zwirn (Zwirn Expression -> Zwirn Expression)) -> Zwirn (IO ())
transition str kz = liftA2 (Stream.transition str) (toID <$> kz)

transition' :: Stream -> Zwirn Expression -> Zwirn Time -> Zwirn Expression -> Zwirn Expression -> Zwirn (Zwirn Expression -> Zwirn (Zwirn Expression -> Zwirn Expression)) -> Zwirn (IO ())
transition' str kz dur def sig fun = (\k -> Stream.transition' str k dur def sig fun) . toID <$> kz

streamFunctions :: Stream -> Map.Map Text AnnotatedExpression
streamFunctions str =
  Map.unions
    [ "once"
        === toExp (once str)
        <:: "Map -> Action"
        --| "play one cycle of the given zwirn",
      "tonce"
        === toExp (tonce str)
        <:: "Text -> Map -> Action"
        --| "play one cycle of the given zwirn on the given target",
      "bpm"
        === toExp (bpm str)
        <:: "Number -> Action"
        --| "set the current bpm (beats per minute)",
      "cps"
        === toExp (cps str)
        <:: "Number -> Action"
        --| "set the current cps (cycles per second)",
      "resetcycles"
        === toExp (resetcycles str)
        <:: "Action"
        --| "resets the cycle count to 0",
      "setcycle"
        === toExp (setcycle str)
        <:: "Number -> Action"
        --| "set the current cycle to specific point in time",
      "disablelink"
        === toExp (disablelink str)
        <:: "Action"
        --| "disable ableton link",
      "enablelink"
        === toExp (enablelink str)
        <:: "Action"
        --| "enable ableton link",
      "in"
        === toExp (execIn' str)
        <:: "Number -> Action -> Action"
        --| "start an action in a given amount of seconds",
      "inMod"
        === toExp (execMod str)
        <:: "Number -> Action -> Action"
        --| "start an action in a given amount of seconds",
      "transitionmap"
        === toExp (Zwirn.Stream.Env.transition str)
        <:: "Id a => a -> (Number -> Map -> Map) -> Action"
        --| "",
      "transition"
        === toExp (Zwirn.Stream.Env.transition' str)
        <:: "Id a => a -> Number -> b -> b -> (Map -> b -> Map) -> Action"
        --| ""
    ]