From 34cabba896507f2b6523d6aec344ec1c88e453be Mon Sep 17 00:00:00 2001
From: Griffin Smith <root@gws.fyi>
Date: Mon, 11 May 2020 23:03:21 -0400
Subject: 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).
---
 src/Main.hs | 34 +++++++++++++++++++++++-----------
 1 file changed, 23 insertions(+), 11 deletions(-)

(limited to 'src/Main.hs')

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
 
-- 
cgit 1.4.1