blob: c771a0d932cb77eb99edaddb5325755e9b45bec1 (
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
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
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
|
