about summary refs log tree commit diff
path: root/src/Main.hs
diff options
context:
space:
mode:
authorGriffin Smith <root@gws.fyi>2020-05-12T03·03-0400
committerGriffin Smith <root@gws.fyi>2020-05-12T03·03-0400
commit34cabba896507f2b6523d6aec344ec1c88e453be (patch)
treea25801db3ecbfbb10582f4fceef2be8d14ba584e /src/Main.hs
parentecd33e0c901b34d77ea77ad0f3b65125d85a4515 (diff)
Add a very basic, naive auto-move command
Add a very basic, naive auto-move command, which just steps the player
in a direction until they collide with something, regardless of any
surrounding beasties who might want to eat them.

There's a lot of other stuff going on here - in order to get this
working the way I wanted with a slight (I settled on 50ms) delay between
every step in these autocommands while still redrawing in between I had
to do all the extra machinery for custom Brick events with a channel,
and then at the same time adding the bits for actually executing
autocommands in a general fashion (because there will definitely be
more!) hit my threshold for size for App.hs which sent me on a big
journey to break it up into smaller files -- which seems actually like
it was quite successful. Hopefully this will help with compile times
too, though App.hs is still pretty slow (maybe more to do here).
Diffstat (limited to 'src/Main.hs')
-rw-r--r--src/Main.hs34
1 files changed, 23 insertions, 11 deletions
diff --git a/src/Main.hs b/src/Main.hs
index 95cfc9edbaff..dcd31afff9c7 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -2,6 +2,8 @@ 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)
@@ -9,6 +11,7 @@ import           Control.Exception (finally)
 import           System.Exit (die)
 --------------------------------------------------------------------------------
 import qualified Xanthous.Game as Game
+import           Xanthous.Game.Env (GameEnv(..))
 import           Xanthous.App
 import           Xanthous.Generators
                  ( GeneratorInput
@@ -92,9 +95,8 @@ optParser = Opt.info
 thanks :: IO ()
 thanks = putStr "\n\n" >> putStrLn "Thanks for playing Xanthous!"
 
-runGame :: RunParams -> IO ()
-runGame rparams = do
-  app <- makeApp NewGame
+newGame :: RunParams -> IO ()
+newGame rparams = do
   gameSeed <- maybe getRandom pure $ seed rparams
   when (isNothing $ seed rparams)
     . putStrLn
@@ -102,23 +104,33 @@ runGame rparams = do
   let initialState = Game.initialStateFromSeed gameSeed &~ do
         for_ (characterName rparams) $ \cn ->
           Game.character . Character.characterName ?= cn
-  _game' <- defaultMain app initialState `finally` do
-    putStr "\n\n"
-    putStrLn "Thanks for playing Xanthous!"
+  runGame NewGame initialState `finally` do
+    thanks
     when (isNothing $ seed rparams)
       . putStrLn
       $ "Seed: " <> tshow gameSeed
     putStr "\n\n"
-  pure ()
 
 loadGame :: FilePath -> IO ()
 loadGame saveFile = do
-  app <- makeApp LoadGame
   gameState <- maybe (die "Invalid save file!") pure
               =<< Game.loadGame . fromStrict <$> readFile @IO saveFile
-  _game' <- gameState `deepseq` defaultMain app gameState `finally` thanks
-  pure ()
+  gameState `deepseq` runGame LoadGame gameState
 
+runGame :: RunType -> Game.GameState -> IO ()
+runGame rt gameState = do
+  eventChan <- Brick.BChan.newBChan 10
+  let gameEnv = GameEnv eventChan
+  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
@@ -139,7 +151,7 @@ runGenerate input dims mSeed = do
   putStrLn $ showCells res
 
 runCommand :: Command -> IO ()
-runCommand (Run runParams) = runGame runParams
+runCommand (Run runParams) = newGame runParams
 runCommand (Load saveFile) = loadGame saveFile
 runCommand (Generate input dims mSeed) = runGenerate input dims mSeed