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)