packages feed

zwirn-0.2.3.1: src/zwirn-doux/Zwirn/Doux/Env.hs

module Zwirn.Doux.Env where

import Control.Monad (void)
import qualified Data.Map as Map
import qualified Data.Text as T
import Sound.Doux.Engine (panic)
import Zwirn.Doux.Types (Stream (..))
import Zwirn.Doux.UI
import Zwirn.Language.Builtin.Internal
import Zwirn.Language.Builtin.Prelude (builtinEnvironmentWithPlayEnvDoux, instances)
import Zwirn.Language.Environment
import Zwirn.Language.Evaluate (Expression, ToExpression (..), Zwirn)
import Zwirn.Language.Play

builtinEnvironmentWithStream :: Stream -> InterpreterEnv
builtinEnvironmentWithStream str = IEnv (Map.unions [std, streamFunctions str]) instances
  where
    (IEnv std _) = builtinEnvironmentWithPlayEnvDoux (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 (streamNow str iz)

panicStream :: Stream -> Zwirn (IO ())
panicStream str = pure (void $ panic (sDoux str) >> playHush (PlayEnv (sPlayMap str) (sActionMap str) (sBusMap str)))

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

nudge :: Stream -> Zwirn Double -> Zwirn (IO ())
nudge str iz = streamNudge str <$> 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

streamFunctions :: Stream -> Map.Map T.Text AnnotatedExpression
streamFunctions str =
  Map.unions
    [ "once"
        === toExp (once str)
        <:: "Map -> Action"
        --| "play one cycle of the given zwirn",
      "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",
      "nudge"
        === toExp (nudge str)
        <:: "Number -> Action"
        --| "set the current nudge of the stream",
      "panic"
        === toExp (panicStream str)
        <:: "Action"
        --| "stop all sound immediately",
      "disablelink"
        === toExp (disablelink str)
        <:: "Action"
        --| "disable ableton link",
      "enablelink"
        === toExp (enablelink str)
        <:: "Action"
        --| "enable ableton link"
    ]