diff --git a/battlegrounds.cabal b/battlegrounds.cabal index 7152d91..5fa73d2 100644 --- a/battlegrounds.cabal +++ b/battlegrounds.cabal @@ -73,7 +73,6 @@ test-suite battlegrounds-test main-is: Spec.hs other-modules: CombatTest - ViewTest Paths_battlegrounds autogen-modules: Paths_battlegrounds diff --git a/src/Combat.hs b/src/Combat.hs index 81e3b1c..0743a2c 100644 --- a/src/Combat.hs +++ b/src/Combat.hs @@ -20,22 +20,22 @@ dealDmg n (hp, armor) = (hp - hpDmg, armor - armorDmg) armorDmg = min n armor hpDmg = n - armorDmg --- `fight` simulates the combat and logs every move and intermediate combat state. -fight :: (MonadRandom m) => Player -> Player -> GameState -> m GameState +-- `fight` simulates the combat +fight :: (MonadRandom m) => Player -> Player -> GameState -> m (GameState, CombatSimulation) fight p1 p2 gs = do (sequence, finalState) <- simulateCombat ((selectPlayer p1 gs).board, (selectPlayer p2 gs).board) let result = calculateResult finalState - let gs' = gs {playerState.phase = Combat, playerState.combatToReplay = CombatSimulation [] sequence result} + let sim = CombatSimulation [] sequence result case result of - Tie -> return gs' + Tie -> return (gs, sim) Loss contestant dmg -> let loser = case contestant of One -> Player Two -> AI - loserState = selectPlayer loser gs' + loserState = selectPlayer loser gs (hp', armor') = dealDmg dmg (loserState.hp, loserState.armor) loserState' = loserState {hp = hp', armor = armor', alive = hp' > 0} - in return $ updatePlayer loser loserState' gs' + in return (updatePlayer loser loserState' gs, sim) -- For now, the algorithm is wrong but simple: -- Players do alternate attacking, but the attacking and defending minions are both random. diff --git a/src/Controller.hs b/src/Controller.hs index 719a4d7..8d64b07 100644 --- a/src/Controller.hs +++ b/src/Controller.hs @@ -1,33 +1,33 @@ -- Controller: Handles input, game loop -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedRecordDot #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedRecordUpdate #-} -{-# LANGUAGE RebindableSyntax #-} +{-# LANGUAGE RebindableSyntax #-} {-# OPTIONS_GHC -fplugin=Data.Record.Plugin #-} + module Controller (module Controller) where -import Prelude -import Data.Record.Overloading import Card (bigDumbo) -import Control.Monad.Random (MonadRandom (getRandom), MonadIO, liftIO) -import Logic (enter, execCommand, isGameOver) +import Combat (fight) +import Control.Monad.Random (MonadIO, MonadRandom (getRandom), liftIO) +import Data.Record.Overloading hiding (loop) +import qualified Data.Text.Lazy as TL +import Debug.Trace (trace, traceM) +import GHC.Base (when) +import Logic (execCommand, isGameOver, replenish) import Model +import System.IO (hFlush, hReady, stdin, stdout) import Text.Parsec hiding (Error) import Text.Parsec.String (Parser) -import Text.Read (readMaybe) -import View (render) -import System.IO (hReady, stdin, hFlush, stdout) -import GHC.Base (when) import Text.Pretty.Simple (pPrint, pShow) -import Debug.Trace (trace, traceM) -import qualified Data.Text.Lazy as TL -import Combat (fight) +import Text.Read (readMaybe) +import View -- START: Functions for ingesting terminal input as PlayerAction -- -- Examples: @@ -91,7 +91,7 @@ playArgParser = do initGameState :: (MonadRandom m) => m GameState initGameState = do tutorialAIGameState <- tutorialAI - return $ GameState {playerState = defPlayerState, aiState = tutorialAIGameState, turn = 0, config = Config { maxBoardSize = 7, maxHandSize = 10 }} + return $ GameState {playerState = defPlayerState, aiState = tutorialAIGameState, turn = 0, config = Config {maxBoardSize = 7, maxHandSize = 10}} tutorialAI :: (MonadRandom m) => m PlayerState tutorialAI = do @@ -113,52 +113,57 @@ defPlayerState = hp = 20, armor = 0, alive = True, - phase = HeroSelect, - combatToReplay = CombatSimulation [] [] Tie + phase = Recruit } runGame :: IO () runGame = do gs <- initGameState - gs' <- enter Recruit Player gs - _ <- loop (return gs') + _ <- loop $ return gs putStrLn "Game Loop Completed." where -- Repeat Recruit and Combat until game over loop :: (MonadIO m, MonadRandom m) => m GameState -> m GameState loop mgs = do gs <- mgs - if isGameOver gs - then do - gs' <- enter EndScreen Player gs - _ <- liftIO $ render gs' Player -- Render the EndScreen before exit. - -- trace "Before loop finally returns" - -- $ - return gs' - else - -- trace (TL.unpack $ pShow gs) - -- $ - case gs.playerState.phase of + -- Go to EndScreen if applicable + let gs' = gs {playerState.phase = if isGameOver gs then EndScreen else gs.playerState.phase} + -- trace (TL.unpack $ pShow gs) + case gs'.playerState.phase of Recruit -> do - liftIO $ render gs Player - liftIO $ putStr "> " - liftIO $ hFlush stdout - input <- liftIO getLine - result <- either -- Combine two eithers: If first action Left, propogate it. If right, execCommand and return an Either. - (return . Left) - (\cmd -> execCommand cmd gs Player) - (interp input) - case result of -- Earlier, two eithers were combined together because they should run the same thing on Left. - Left err -> liftIO (putStrLn err) >> loop (return gs) - Right gs' -> loop (return gs') + replenishedPlayer <- replenish gs'.playerState + replenishedAI <- replenish gs'.aiState + let gs'' = gs' {playerState = replenishedPlayer, aiState = replenishedAI} + recruitLoop gs'' >>= (loop . return) Combat -> do - gs' <- fight Player AI gs - liftIO $ render gs' Player - liftIO flushInput - loop $ enter Recruit Player gs' - _ -> mgs + (gs'', sim) <- fight Player AI gs' + liftIO $ replayCombat 1 sim + liftIO flushInput -- ignore input entered during combat phase + liftIO $ putStrLn "finished playing" + loop $ return gs'' {playerState.phase = Recruit, aiState.phase = Recruit} + EndScreen -> do + -- Note EndScreen doesn't invoke `loop`. Game logic stops here. + liftIO $ putStrLn $ endScreenMsg gs' + return gs + _ -> error "Other phases not yet implemented" + +recruitLoop :: (MonadIO m, MonadRandom m) => GameState -> m GameState +recruitLoop gs + | gs.playerState.phase == Recruit = do + liftIO $ putStrLn $ fmtRecruit gs Player + liftIO $ putStr "> " + liftIO $ hFlush stdout + input <- liftIO getLine + result <- + either + (return . Left) + (\cmd -> execCommand cmd gs Player) + (interp input) + case result of + Left err -> liftIO (putStrLn err) >> recruitLoop gs + Right gs' -> recruitLoop gs' + | otherwise = return gs --- ignore input entered during combat phase flushInput :: IO () flushInput = do ready <- hReady stdin diff --git a/src/Logic.hs b/src/Logic.hs index 3808067..2516ff2 100644 --- a/src/Logic.hs +++ b/src/Logic.hs @@ -1,25 +1,23 @@ -- Logic: Handles recruit phase logic, executing user commands -- TODO: Modularize out the recruit logic, since Combat.hs is already separate. -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedRecordDot #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedRecordUpdate #-} -{-# LANGUAGE RebindableSyntax #-} {-# LANGUAGE ParallelListComp #-} -{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RebindableSyntax #-} module Logic (module Logic) where -import Data.Record.Overloading - import Card (pool) import Control.Monad.Random -import Data.Functor ((<&>)) +import Data.Record.Overloading import Model import Utils import View (helpMenu) @@ -28,8 +26,12 @@ execCommand :: (MonadIO m, MonadRandom m) => Command -> GameState -> Player -> m execCommand (Buy ind) gs p = return $ buy ind gs p >>= (\ps' -> Right $ updatePlayer p ps' gs) execCommand (Sell ind) gs p = return $ sell ind (selectPlayer p gs) >>= (\ps' -> Right $ updatePlayer p ps' gs) execCommand (Play ind) gs p = return $ play ind gs p >>= (\ps' -> Right $ updatePlayer p ps' gs) -execCommand Help gs _ = liftIO (putStrLn helpMenu) >> pure (Right gs) -execCommand EndTurn gs p = enter Combat p gs <&> Right +execCommand Help gs Player = liftIO (putStrLn helpMenu) >> pure (Right gs) +execCommand Help gs AI = error "Dev Error: AI shouldn't issue `Help`." +execCommand EndTurn gs Player = return $ Right gs { playerState.phase = Combat } +-- In tutorial mode, the single player issues the combat (on their will) and fights the AI always +-- In multiplayer, the server issues the combat (by a timer) and pairs up who to fight +execCommand EndTurn _ AI = error "Dev Error: AI really shouldn't issue `EndTurn`." execCommand Roll gs p = do ps' <- roll $ selectPlayer p gs return $ liftM2 (updatePlayer p) ps' (return gs) @@ -42,42 +44,19 @@ isGameOver :: GameState -> Bool isGameOver gs = gs.playerState.alive /= gs.aiState.alive -- Performed when we first transition to a new game phase. -enter :: (MonadRandom m) => Phase -> Player -> GameState -> m GameState -enter Recruit Player gs = do - -- Entering Player's recruit phase triggers AI to perform same logic - newPlayerState <- enter' gs.playerState - newAIState <- enter' gs.aiState - return - gs - { playerState = newPlayerState, - aiState = newAIState - } - where - enter' ps = do - newShop <- randomShop ps.tier - return $ - ps - { phase = Recruit, - maxGold = ps.maxGold + 1, - curGold = ps.maxGold + 1, - frozen = False, - shop = if ps.frozen then ps.shop else newShop - } --- fight! And then --- 1) provide the render phase with simulation sequence --- 2) unleash the damage -enter Combat p gs = do - let newState = (selectPlayer p gs) { phase = Combat } - return $ updatePlayer p newState gs -enter EndScreen p gs = do - let newState = (selectPlayer p gs) { phase = EndScreen } - return $ updatePlayer p newState gs -enter _ _ _ = error "Other phases are not yet enterable" - +replenish :: (MonadRandom m) => PlayerState -> m PlayerState +replenish ps = do + newShop <- randomShop ps.tier + return ps + { phase = Recruit, + maxGold = ps.maxGold + 1, + curGold = ps.maxGold + 1, + frozen = False, + shop = if ps.frozen then ps.shop else newShop + } -- START: Utility Methods for PlayerAction Functions -- -- Determinisitc functions should only be used when the usage permits only the happy path - deterministicLookup :: (Eq a) => a -> [(a, b)] -> b deterministicLookup a xs = case lookup a xs of @@ -183,6 +162,6 @@ freeze ps = return ps {frozen = not ps.frozen} -- Kill player and move their render screen to the EndScreen concede :: PlayerState -> Either String PlayerState -concede ps = return ps {alive = False, phase = EndScreen} +concede ps = return ps {alive = False} -- END -- diff --git a/src/Model.hs b/src/Model.hs index bbb0ff4..2506607 100644 --- a/src/Model.hs +++ b/src/Model.hs @@ -123,8 +123,7 @@ data PlayerState = PlayerState armor :: Armor, alive :: Bool, rerollCost :: Gold, - phase :: Phase, - combatToReplay :: CombatSimulation + phase :: Phase } deriving Show {-# ANN type GameState largeRecord #-} diff --git a/src/View.hs b/src/View.hs index c9f4745..fe0a586 100644 --- a/src/View.hs +++ b/src/View.hs @@ -10,7 +10,7 @@ {-# LANGUAGE RebindableSyntax #-} {-# OPTIONS_GHC -fplugin=Data.Record.Plugin #-} -module View (render, helpMenu) where +module View (module View) where import Data.Record.Overloading import Control.Concurrent (threadDelay) @@ -20,7 +20,25 @@ import Debug.Trace (trace) import Model import Utils (selectPlayer) --- Render creates the following example. In the example, the names and entries are maxed out. +rowWidth :: Int +rowWidth = 142 + +maxCardNameDisplayLength :: Int +maxCardNameDisplayLength = 15 + +maxRowContentWidth :: Int +maxRowContentWidth = length $ intercalate " | " $ replicate 7 "Rockpool Hunter" -- 123 + +renderCard :: CardInstance -> String +renderCard ci = abbrev maxCardNameDisplayLength (show ci.card.cardName) ++ "(" ++ show ci.card.attack ++ "/" ++ show ci.card.health ++ ")" + +hBorder :: [Char] +hBorder = "+" ++ replicate (rowWidth - 2) '-' ++ "+" + +endScreenMsg :: GameState -> String +endScreenMsg gs = if gs.playerState.alive then "Victory! Ending now." else "You loss. Ending now." + +-- fmtRecruit creates the following string. In the example below, the names and entries are maxed out. -- I.e., 15 characters is the longest permitting name (Rockpool Hunter and playeracgodman1 have 15 chars). Shop and board have 7 entries max, hand has 10 max. -- -- +-------------------------------------------------------------------------------------------------------------------------------------------+ @@ -40,55 +58,8 @@ import Utils (selectPlayer) -- | Opps HP: playeracgodman1: 35 + 5 | playeracgodman2: 26 + 3 | playeracgodman3: HP 27 + 0 | playeracgodman4: HP 27 + 3 | -- | playeracgodman5: 35 + 5 | playeracgodman6: 26 + 3 | playeracgodman7: HP 27 + 0 | -- +-------------------------------------------------------------------------------------------------------------------------------------------+ - -rowWidth :: Int -rowWidth = 142 - -maxCardNameDisplayLength :: Int -maxCardNameDisplayLength = 15 - -maxRowContentWidth :: Int -maxRowContentWidth = length $ intercalate " | " $ replicate 7 "Rockpool Hunter" -- 123 - -render :: GameState -> Player -> IO () -render gs p = - case (selectPlayer p gs).phase of - Recruit -> putStrLn $ renderRecruit gs p - HeroSelect -> putStrLn "heroselect todo" - Combat -> do - forM_ (replayCombat gs.playerState.combatToReplay) $ \s -> do - putStrLn s - threadDelay $ 1000 * 1000 -- 500 milliseconds - case gs.playerState.combatToReplay.result of - Tie -> putStrLn "You tied the round. Bob: Welcome back! How's it going out there?" - Loss loser dmg -> if loser == One then putStrLn $ "You lost the round and took " ++ show dmg ++ " dmg. Bob: You're good at this!" else putStrLn $ "You won the round and dealt " ++ show dmg ++ " dmg! Bob: I think you can win this thing!" - EndScreen -> if (selectPlayer p gs).alive then putStrLn "Victory! Ending now." else putStrLn "You loss. Ending now." - --- [String] contains each slice of the readily renderable combat! --- [CombatMove] is ignored for now. But, they are required to flavor the UI -replayCombat :: CombatSimulation -> [String] -replayCombat (CombatSimulation _ bs _) = map renderBoardState bs - -renderBoardState :: ([CardInstance], [CardInstance]) -> String -renderBoardState (board1, board2) = - intercalate "\n" $ - [ hBorder, - "|" ++ alignMid (rowWidth - 2) "Combat Simulation" ++ "|", - hBorder, - "| Player 2: " ++ alignMid maxRowContentWidth (intercalate " | " (map renderCard board2)) ++ " |", - hBorder, - "| Player 1: " ++ alignMid maxRowContentWidth (intercalate " | " (map renderCard board1)) ++ " |", - hBorder - ] - -renderCard :: CardInstance -> String -renderCard ci = abbrev maxCardNameDisplayLength (show ci.card.cardName) ++ "(" ++ show ci.card.attack ++ "/" ++ show ci.card.health ++ ")" - -hBorder :: [Char] -hBorder = "+" ++ replicate (rowWidth - 2) '-' ++ "+" - -renderRecruit :: GameState -> Player -> String -renderRecruit gs p = +fmtRecruit :: GameState -> Player -> String +fmtRecruit gs p = intercalate "\n" $ filter (not . null) @@ -141,6 +112,29 @@ alignMid space s = leftPad ++ s ++ rightPad leftPad = replicate leftPadCnt ' ' rightPad = replicate rightPadCnt ' ' +-- Replay the combat by rendering each "slice" of the combat state x seconds apart. +type Seconds = Double +replayCombat :: Seconds -> CombatSimulation -> IO () +replayCombat secs (CombatSimulation _ bs result) = do -- [CombatMove] is ignored for now. But, they are required to flavor the move UI (i.e., animate an attack require knowing who attacked who) + forM_ (map renderCombatBoardState bs) $ \s -> do + putStrLn s + threadDelay $ round $ secs * 1000 + case result of + Tie -> putStrLn "You tied the round. Bob: Welcome back! How's it going out there?" + Loss loser dmg -> if loser == One then putStrLn $ "You lost the round and took " ++ show dmg ++ " dmg. Bob: You're good at this!" else putStrLn $ "You won the round and dealt " ++ show dmg ++ " dmg! Bob: I think you can win this thing!" + +renderCombatBoardState :: (Board, Board) -> String +renderCombatBoardState (board1, board2) = + intercalate "\n" $ + [ hBorder, + "|" ++ alignMid (rowWidth - 2) "Combat Simulation" ++ "|", + hBorder, + "| Player 2: " ++ alignMid maxRowContentWidth (intercalate " | " (map renderCard board2)) ++ " |", + hBorder, + "| Player 1: " ++ alignMid maxRowContentWidth (intercalate " | " (map renderCard board1)) ++ " |", + hBorder + ] + helpMenu :: String helpMenu = intercalate