From 82ecd61f5c699cf3af6c4eadf47a1c52b1d696c6 Mon Sep 17 00:00:00 2001 From: Aspen Smith Date: Sun, 11 Feb 2024 22:00:40 -0500 Subject: chore(users): grfn -> aspen Change-Id: I6c6847fac56f0a9a1a2209792e00a3aec5e672b9 Reviewed-on: https://cl.tvl.fyi/c/depot/+/10809 Autosubmit: aspen Reviewed-by: sterni Tested-by: BuildkiteCI Reviewed-by: lukegb --- users/aspen/xanthous/app/Main.hs | 171 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 171 insertions(+) create mode 100644 users/aspen/xanthous/app/Main.hs (limited to 'users/aspen/xanthous/app/Main.hs') diff --git a/users/aspen/xanthous/app/Main.hs b/users/aspen/xanthous/app/Main.hs new file mode 100644 index 0000000000..c771a0d932 --- /dev/null +++ b/users/aspen/xanthous/app/Main.hs @@ -0,0 +1,171 @@ +{-# LANGUAGE RecordWildCards #-} +-------------------------------------------------------------------------------- +module Main ( main ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude hiding (finally) +import Brick +import qualified Brick.BChan +import qualified Graphics.Vty as Vty +import qualified Options.Applicative as Opt +import System.Random +import Control.Monad.Random (getRandom) +import Control.Exception (finally) +import System.Exit (die) +-------------------------------------------------------------------------------- +import qualified Xanthous.Game as Game +import Xanthous.Game.Env (GameEnv(..)) +import qualified Xanthous.Game.Env as Game +import Xanthous.App +import Xanthous.Generators.Level + ( GeneratorInput + , parseGeneratorInput + , generateFromInput + , showCells + ) +import qualified Xanthous.Entities.Character as Character +import Xanthous.Generators.Level.Util (regions) +import Xanthous.Generators.Level.LevelContents +import Xanthous.Data (Dimensions, Dimensions'(Dimensions)) +import Data.Array.IArray ( amap ) +-------------------------------------------------------------------------------- + +parseGameConfig :: Opt.Parser Game.Config +parseGameConfig = Game.Config + <$> Opt.switch + ( Opt.long "disable-saving" + <> Opt.help "Disallow saving games" + ) + +data RunParams = RunParams + { seed :: Maybe Int + , characterName :: Maybe Text + , gameConfig :: Game.Config + } + deriving stock (Show, Eq) + +parseRunParams :: Opt.Parser RunParams +parseRunParams = RunParams + <$> optional (Opt.option Opt.auto + ( Opt.long "seed" + <> Opt.help "Random seed for the game." + )) + <*> optional (Opt.strOption + ( Opt.short 'n' + <> Opt.long "name" + <> Opt.help + ( "Name for the character. If not set on the command line, " + <> "will be prompted for at runtime" + ) + )) + <*> parseGameConfig + +data Command + = Run RunParams + | Load FilePath + | Generate GeneratorInput Dimensions (Maybe Int) + +parseDimensions :: Opt.Parser Dimensions +parseDimensions = Dimensions + <$> Opt.option Opt.auto + ( Opt.short 'w' + <> Opt.long "width" + <> Opt.metavar "TILES" + ) + <*> Opt.option Opt.auto + ( Opt.short 'h' + <> Opt.long "height" + <> Opt.metavar "TILES" + ) + + +parseCommand :: Opt.Parser Command +parseCommand = (<|> Run <$> parseRunParams) $ Opt.subparser + $ Opt.command "run" + (Opt.info + (Run <$> parseRunParams) + (Opt.progDesc "Run the game")) + <> Opt.command "load" + (Opt.info + (Load <$> Opt.argument Opt.str (Opt.metavar "FILE")) + (Opt.progDesc "Load a saved game")) + <> Opt.command "generate" + (Opt.info + (Generate + <$> parseGeneratorInput + <*> parseDimensions + <*> optional + (Opt.option Opt.auto (Opt.long "seed")) + <**> Opt.helper + ) + (Opt.progDesc "Generate a sample level")) + +optParser :: Opt.ParserInfo Command +optParser = Opt.info + (parseCommand <**> Opt.helper) + (Opt.header "Xanthous: a WIP TUI RPG") + +thanks :: IO () +thanks = putStr "\n\n" >> putStrLn "Thanks for playing Xanthous!" + +newGame :: RunParams -> IO () +newGame rparams = do + gameSeed <- maybe getRandom pure $ seed rparams + when (isNothing $ seed rparams) + . putStrLn + $ "Seed: " <> tshow gameSeed + let initialState = Game.initialStateFromSeed gameSeed &~ do + for_ (characterName rparams) $ \cn -> + Game.character . Character.characterName ?= cn + runGame NewGame (gameConfig rparams) initialState `finally` do + thanks + when (isNothing $ seed rparams) + . putStrLn + $ "Seed: " <> tshow gameSeed + putStr "\n\n" + +loadGame :: FilePath -> IO () +loadGame saveFile = do + gameState <- maybe (die "Invalid save file!") pure . Game.loadGame . fromStrict + =<< readFile @IO saveFile + gameState `deepseq` runGame (LoadGame saveFile) Game.defaultConfig gameState + +runGame :: RunType -> Game.Config -> Game.GameState -> IO () +runGame rt _config gameState = do + _eventChan <- Brick.BChan.newBChan 10 + let gameEnv = GameEnv {..} + app <- makeApp gameEnv rt + let buildVty = Vty.mkVty Vty.defaultConfig + initialVty <- buildVty + _game' <- customMain + initialVty + buildVty + (Just _eventChan) + app + gameState + pure () + +runGenerate :: GeneratorInput -> Dimensions -> Maybe Int -> IO () +runGenerate input dims mSeed = do + putStrLn "Generating..." + genSeed <- maybe getRandom pure mSeed + let randGen = mkStdGen genSeed + res = generateFromInput input dims randGen + rs = regions $ amap not res + when (isNothing mSeed) + . putStrLn + $ "Seed: " <> tshow genSeed + putStr "num regions: " + print $ length rs + putStr "region lengths: " + print $ length <$> rs + putStr "character position: " + print =<< chooseCharacterPosition res + putStrLn $ showCells res + +runCommand :: Command -> IO () +runCommand (Run runParams) = newGame runParams +runCommand (Load saveFile) = loadGame saveFile +runCommand (Generate input dims mSeed) = runGenerate input dims mSeed + +main :: IO () +main = runCommand =<< Opt.execParser optParser -- cgit 1.4.1