maleghast-engine/app/Main.hs

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)