about summary refs log tree commit diff
path: root/src/Main.hs
blob: 2e9d8c41eef29cca6f1f7230d56213f902b86f4e (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
module Main ( main ) where
--------------------------------------------------------------------------------
import           Xanthous.Prelude hiding (finally)
import           Brick
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.App (makeApp)
import           Xanthous.Generators
                 ( GeneratorInput
                 , parseGeneratorInput
                 , generateFromInput
                 , showCells
                 )
import qualified Xanthous.Entities.Character as Character
import           Xanthous.Generators.Util (regions)
import           Xanthous.Generators.LevelContents
import           Xanthous.Data (Dimensions, Dimensions'(Dimensions))
import           Data.Array.IArray ( amap )
--------------------------------------------------------------------------------

data RunParams = RunParams
  { seed :: Maybe Int
  , characterName :: Maybe Text
  }
  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"
        )
      ))

data Command
  = Run RunParams
  | Load FilePath
  | Generate GeneratorInput Dimensions

parseDimensions :: Opt.Parser Dimensions
parseDimensions = Dimensions
  <$> Opt.option Opt.auto
       ( Opt.short 'w'
       <> Opt.long "width"
       )
  <*> Opt.option Opt.auto
       ( Opt.short 'h'
       <> Opt.long "height"
       )

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
        <**> 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!"

runGame :: RunParams -> IO ()
runGame rparams = do
  app <- makeApp
  gameSeed <- maybe getRandom pure $ seed rparams
  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!"
    when (isNothing $ seed rparams)
      . putStrLn
      $ "Seed: " <> tshow gameSeed
    putStr "\n\n"
  pure ()

loadGame :: FilePath -> IO ()
loadGame saveFile = do
  app <- makeApp
  gameState <- maybe (die "Invalid save file!") pure
              =<< Game.loadGame . fromStrict <$> readFile @IO saveFile
  _game' <- gameState `deepseq` defaultMain app gameState `finally` thanks
  pure ()


runGenerate :: GeneratorInput -> Dimensions -> IO ()
runGenerate input dims = do
  randGen <- getStdGen
  let res = generateFromInput input dims randGen
      rs = regions $ amap not res
  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) = runGame runParams
runCommand (Load saveFile) = loadGame saveFile
runCommand (Generate input dims) = runGenerate input dims

main :: IO ()
main = runCommand =<< Opt.execParser optParser