packages feed

zwirn-0.2.3.1: app/zwirnmill/Main.hs

module Main where

import qualified Brick.Animation as A
import Brick.BChan (BChan, newBChan, writeBChan)
import Config
import Control.Concurrent
import Control.Monad
import Editor.Core (OutputType (..))
import qualified Graphics.Vty as V
import Keymap (CustomKeymap (..), customKeyConfig)
import Session (SessionState (..), getSessionState)
import Setup
import Sound.Doux.Engine (destroy)
import UI
import UI.Config (windowMapFromConfig)
import UI.Core
import Zwirn.Doux.Types (Stream (..))
import Zwirn.Language (Environment)
import Zwirn.Language.Compiler (Environment (..))
import Zwirn.Language.Environment (extend)
import Zwirn.Language.Evaluate (Expression (..), ToExpression (..), Zwirn)

main :: IO ()
main = do
  chan <- newBChan 30
  (fullConfig, km) <- getConfig
  (SessionState wc) <- getSessionState
  (env, str) <- setup fullConfig (\st -> writeBChan chan (UpdateOutput (OutputInfo, st)))
  amgr <- A.startAnimationManager 50 chan AnimationUpdate
  _ <- forkIO $ forever $ do
    writeBChan chan UpdateStatus
    threadDelay 100000
  wm <- windowMapFromConfig (streamConfigSamples $ fullConfigStream fullConfig) wc
  let initialState = buildAppState km amgr wm (addOutputAction chan env) str (streamConfigMaxVoices $ fullConfigStream fullConfig) chan Nothing
  _ <- runUI initialState
  destroy (sDoux str)

buildAppState :: CustomKeymap -> A.AnimationManager AppState AppEvent Name -> WindowMap -> Environment -> Stream -> Int -> BChan AppEvent -> Maybe V.Output -> AppState
buildAppState km amgr wm env str mx chan out =
  AppState
    { asEnvironment = env,
      asStream = str,
      asMaxVoices = mx,
      asWindows = wm,
      asKeyConfig = customKeyConfig km,
      asVtyOutput = out,
      asChan = chan,
      asDragging = Nothing,
      asActiveWindow = Background,
      asOptionWindow = Nothing,
      asAnimationManager = amgr
    }

updateOutputExp :: BChan AppEvent -> Zwirn String -> Zwirn Expression
updateOutputExp chan = fmap (\t -> EAction $ writeBChan chan (UpdateOutput (OutputInfo, t)))

addOutputAction :: BChan AppEvent -> Environment -> Environment
addOutputAction chan env = env {intEnv = extend ("output", toExp $ updateOutputExp chan, "Text -> Action") $ intEnv env}