81 lines
2.5 KiB
Haskell
81 lines
2.5 KiB
Haskell
module Main (main) where
|
|
|
|
import System.IO (hFlush, stdout)
|
|
import Util (note)
|
|
import GameModel (Point(..), Player(..), newBoard, BaseStats, BoardState, EnvTile (..), DieFace, bestOrWorst)
|
|
import Units.Debug (basic, freeMoveTester)
|
|
import GameLogic (buildChoiceTree, ChoiceTree(..), ChoiceTree'(..), makeChoice, ctTree)
|
|
|
|
import Text.Read (readMaybe)
|
|
import qualified Control.Monad
|
|
import Control.Monad (replicateM, void)
|
|
import System.Random (randomIO)
|
|
|
|
initialPlacement :: Point -> Maybe (Player, BaseStats)
|
|
initialPlacement = flip lookup [(Point 5, (Max, basic)), (Point 0, (Max, freeMoveTester)), (Point 23, (Min, basic)), (Point 22, (Min, freeMoveTester))]
|
|
|
|
initialTerrain :: Point -> [EnvTile]
|
|
initialTerrain (Point 4) = [Rough]
|
|
initialTerrain (Point 5) = [Stairs]
|
|
initialTerrain (Point 6) = [Elevation]
|
|
initialTerrain (Point 7) = [Elevation]
|
|
initialTerrain (Point 8) = [Stairs, Hazard]
|
|
initialTerrain (Point 11) = [Stairs, Rough]
|
|
initialTerrain (Point 12) = [Hazard]
|
|
initialTerrain (Point 17) = [Wall]
|
|
initialTerrain (Point 18) = [Wall]
|
|
initialTerrain (Point 20) = [Rough, Hazard]
|
|
initialTerrain _ = []
|
|
|
|
initialBoard :: BoardState
|
|
initialBoard = newBoard 5 5 initialPlacement initialTerrain
|
|
|
|
choiceTree :: ChoiceTree
|
|
choiceTree = buildChoiceTree initialBoard
|
|
|
|
readPrompt :: Read a => String -> (a -> Either String b) -> IO b
|
|
readPrompt prompt validate = do
|
|
putStr prompt
|
|
hFlush stdout
|
|
line <- getLine
|
|
case readMaybe line of
|
|
Just input -> case validate input of
|
|
Right out -> return out
|
|
Left error -> do
|
|
putStrLn error
|
|
putChar '\n'
|
|
readPrompt prompt validate
|
|
Nothing -> do
|
|
putStrLn "Malformed input\n"
|
|
readPrompt prompt validate
|
|
|
|
roll :: IO DieFace
|
|
roll = do
|
|
getLine
|
|
result <- randomIO
|
|
putStr $ show result
|
|
hFlush stdout
|
|
return result
|
|
|
|
runGame :: ChoiceTree -> IO (Maybe Player)
|
|
runGame tree = do
|
|
print tree
|
|
case tree of
|
|
ChoiceTree ct@(Node {}) -> do
|
|
choiceMade <- readPrompt "=> " (note "Out of range" . flip makeChoice ct)
|
|
runGame choiceMade
|
|
ChoiceTree ct@(Random nDice pos outcomes) -> do
|
|
putStr "[Press enter to roll]"
|
|
hFlush stdout
|
|
dice <- replicateM (fromIntegral nDice) roll
|
|
putChar '\n'
|
|
let result = bestOrWorst pos dice
|
|
putStr "Done! Final result: "
|
|
print result
|
|
putStrLn "[Press enter to continue]"
|
|
getLine
|
|
runGame $ ctTree $ outcomes result
|
|
ChoiceTree ct@(EndOfGame winner) -> return winner
|
|
|
|
main :: IO ()
|
|
main = void (runGame choiceTree) |