{-# LANGUAGE OverloadedStrings #-} -- | -- SPDX-License-Identifier: BSD-3-Clause -- -- Main entry point for the Swarm application. module Swarm.App where import Brick import Brick.BChan import Control.Carrier.Lift (runM) import Control.Carrier.Throw.Either (runThrow) import Control.Concurrent (forkIO, threadDelay) import Control.Lens (view, (%~), (&), (?~)) import Control.Monad (forever, void, when) import Control.Monad.IO.Class (liftIO) import Data.IORef (newIORef, writeIORef) import Data.Text qualified as T import Data.Text.IO qualified as T import Graphics.Vty qualified as V import Swarm.Game.Failure (SystemFailure) import Swarm.Language.Pretty (prettyText) import Swarm.Log (LogSource (SystemLog), Severity (..)) import Swarm.ReadableIORef (mkReadonly) import Swarm.TUI.Controller import Swarm.TUI.Model import Swarm.TUI.Model.StateUpdate import Swarm.TUI.Model.UI (uiAttrMap) import Swarm.TUI.View import Swarm.Version (getNewerReleaseVersion) import Swarm.Web import System.IO (stderr) type EventHandler = BrickEvent Name AppEvent -> EventM Name AppState () -- | The configuration of the Swarm app which we pass to the @brick@ -- library. app :: EventHandler -> App AppState AppEvent Name app eventHandler = App { appDraw = drawUI , appChooseCursor = chooseCursor , appHandleEvent = eventHandler , appStartEvent = enablePasteMode , appAttrMap = view $ uiState . uiAttrMap } -- | The main @IO@ computation which initializes the state, sets up -- some communication channels, and runs the UI. appMain :: AppOpts -> IO () appMain opts = do res <- runM . runThrow $ initAppState opts case res of Left err -> T.hPutStrLn stderr (prettyText @SystemFailure err) Right s -> do -- Send Frame events as at a reasonable rate for 30 fps. The -- game is responsible for figuring out how many steps to take -- each frame to achieve the desired speed, regardless of the -- frame rate. Note that if the game cannot keep up with 30 -- fps, it's not a problem: the channel will fill up and this -- thread will block. So the force of the threadDelay is just -- to set a *maximum* possible frame rate. -- -- 5 is the size of the bounded channel; when it gets that big, -- any writes to it will block. Probably 1 would work fine, -- though it seems like it could be good to have a bit of buffer -- just so the app never has to wait for the thread to wake up -- and do another write. chan <- newBChan 5 _ <- forkIO $ forever $ do threadDelay 33_333 -- cap maximum framerate at 30 FPS writeBChan chan Frame _ <- forkIO $ do upRel <- getNewerReleaseVersion (repoGitInfo opts) writeBChan chan (UpstreamVersion upRel) -- Start the web service with a reference to the game state. -- NOTE: This reference should be considered read-only by -- the web service; the game alone shall host the canonical state. appStateRef <- newIORef s eport <- Swarm.Web.startWebThread (userWebPort opts) (mkReadonly appStateRef) chan let logP p = logEvent SystemLog Info "Web API" ("started on :" <> T.pack (show p)) let logE e = logEvent SystemLog Error "Web API" (T.pack e) let s' = s & runtimeState %~ case eport of Right p -> (webPort ?~ p) . (eventLog %~ logP p) Left e -> eventLog %~ logE e -- Update the reference for every event let eventHandler e = do curSt <- get liftIO $ writeIORef appStateRef curSt handleEvent e -- Setup virtual terminal let buildVty = V.mkVty $ V.defaultConfig {V.colorMode = colorMode opts} initialVty <- buildVty V.setMode (V.outputIface initialVty) V.Mouse True -- Run the app. void $ customMain initialVty buildVty (Just chan) (app eventHandler) s' -- | A demo program to run the web service directly, without the terminal application. -- This is useful to live update the code using @ghcid -W --test "Swarm.App.demoWeb"@. demoWeb :: IO () demoWeb = do let demoPort = 8080 res <- runM . runThrow $ initAppState (defaultAppOpts {userScenario = demoScenario}) case res of Left err -> T.putStrLn (prettyText @SystemFailure err) Right s -> do appStateRef <- newIORef s chan <- newBChan 5 webMain Nothing demoPort (mkReadonly appStateRef) chan where demoScenario = Just "./data/scenarios/Testing/475-wait-one.yaml" -- | If available for the terminal emulator, enable bracketed paste mode. enablePasteMode :: EventM n s () enablePasteMode = do vty <- getVtyHandle let output = V.outputIface vty when (V.supportsMode output V.BracketedPaste) $ liftIO $ V.setMode output V.BracketedPaste True