From 8baf6df1a6898c163611e9abe666876ab97334ed Mon Sep 17 00:00:00 2001 From: flober Date: Fri, 2 Aug 2024 22:45:08 -0400 Subject: [PATCH] Game loop complete! (Combat algorithm is simplified) - Added traces - Better in-game messages - Combat is rendered as expected! Next up: - Implement correct combat algorithm - Refactor code to be test-friendly and create tests that can reproduce full combats. --- battlegrounds.cabal | 2 + package.yaml | 2 + src/Combat.hs | 117 +++++++++++++++++++++++++------------------- src/Controller.hs | 29 ++++++++--- src/Logic.hs | 27 ++++------ src/Model.hs | 14 +++--- src/View.hs | 21 +++++--- 7 files changed, 120 insertions(+), 92 deletions(-) diff --git a/battlegrounds.cabal b/battlegrounds.cabal index 11f4694..7519e3e 100644 --- a/battlegrounds.cabal +++ b/battlegrounds.cabal @@ -45,7 +45,9 @@ library , containers ==0.6.7 , mtl ==2.3.1 , parsec + , pretty-simple , random ==1.2.1.2 + , text ==2.0.2 , uuid ==1.3.15 default-language: Haskell2010 diff --git a/package.yaml b/package.yaml index 136ae50..29f12eb 100644 --- a/package.yaml +++ b/package.yaml @@ -42,6 +42,8 @@ library: - random == 1.2.1.2 - MonadRandom - parsec + - pretty-simple + - text == 2.0.2 executables: battlegrounds-terminal: diff --git a/src/Combat.hs b/src/Combat.hs index bab271c..3176890 100644 --- a/src/Combat.hs +++ b/src/Combat.hs @@ -3,82 +3,97 @@ module Combat where import Control.Monad.Random -import Data.List (sortOn) -import Data.Ord (Down (Down)) import Model -import Utils (selectPlayer) +import Utils (selectPlayer, updatePlayer) +import Debug.Trace (trace) -- New type for Attacker type Attacker = Contestant +dealDmg :: Int -> (Health, Armor) -> (Health, Armor) +dealDmg n (hp, armor) = (hp - hpDmg, armor - armorDmg) + where + 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 (CombatSimulation, CombatResult, Damage) +fight :: (MonadRandom m) => Player -> Player -> GameState -> m GameState fight p1 p2 gs = do (sequence, finalState) <- simulateCombat ((selectPlayer p1 gs).board, (selectPlayer p2 gs).board) - let result = determineCombatResult finalState - let damage = calculateDamage result finalState - return (CombatSimulation [] sequence, result, damage) + let result = calculateResult finalState + let gs' = gs {playerState = gs.playerState {phase = Combat, combatToReplay = CombatSimulation [] sequence result}} + case result of + Tie -> return gs' + Loss contestant dmg -> + let loser = case contestant of + One -> Player + Two -> AI + 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' +-- For now, the algorithm is wrong but simple: +-- Players do alternate attacking, but the attacking and defending minions are both random. simulateCombat :: (MonadRandom m) => (Board, Board) -> m (CombatHistory, (Board, Board)) -simulateCombat state = go state [] +simulateCombat initialState = do + attacker <- initialAttacker initialState + go attacker initialState [initialState] -- initial board is part of state where - go state history - | combatEnded state = return (reverse history, state) - | otherwise = do - attacker <- chooseAttacker state - newState <- performAttack attacker state - go newState (state : history) + go :: (MonadRandom m) => Attacker -> (Board, Board) -> CombatHistory -> m (CombatHistory, (Board, Board)) + go attacker state history = do + let state' = both (filter (\ci -> ci.card.health > 0)) state + if combatEnded state' + then return (reverse history, state') + else do + newState <- performAttack attacker state' + go (alternate attacker) newState (newState : history) + +both :: (a -> b) -> (a, a) -> (b, b) +both f (a, a') = (f a, f a') -displayInOrder :: Int -> Board -> Board -displayInOrder i b = _ +alternate :: Contestant -> Contestant +alternate One = Two +alternate Two = One -chooseAttacker :: (MonadRandom m) => (Board, Board) -> m Attacker -chooseAttacker (board1, board2) +initialAttacker :: (MonadRandom m) => (Board, Board) -> m Attacker +initialAttacker (board1, board2) | length board1 > length board2 = return One | length board2 > length board1 = return Two | otherwise = do r <- getRandomR (0, 1) :: (MonadRandom m) => m Int return $ if r == 0 then One else Two +setAt :: Int -> a -> [a] -> [a] +setAt i x xs = take i xs ++ [x] ++ drop (i + 1) xs + performAttack :: (MonadRandom m) => Attacker -> (Board, Board) -> m (Board, Board) -performAttack attacker (board1, board2) = do - let (attackingBoard, defendingBoard) = case attacker of +performAttack attackerP (board1, board2) = do + let (attackingBoard, defendingBoard) = case attackerP of One -> (board1, board2) Two -> (board2, board1) - defenderIndex <- selectRandomDefender defendingBoard - let (newAttackingBoard, newDefendingBoard) = atk (head attackingBoard) defenderIndex (attackingBoard, defendingBoard) - let rotatedAttackingBoard = tail newAttackingBoard ++ [head newAttackingBoard] - return $ case attacker of - One -> (rotatedAttackingBoard, newDefendingBoard) - Two -> (newDefendingBoard, rotatedAttackingBoard) - -selectRandomDefender :: (MonadRandom m) => Board -> m Int -selectRandomDefender board = getRandomR (0, length board - 1) + attackerIndex <- getRandomR (0, length attackingBoard - 1) + defenderIndex <- getRandomR (0, length defendingBoard - 1) + let attacker = attackingBoard !! attackerIndex + defender = defendingBoard !! defenderIndex + (attacker', defender') = trade (attacker, defender) + attackingBoard' = setAt attackerIndex attacker' attackingBoard + defendingBoard' = setAt defenderIndex defender' defendingBoard + return $ case attackerP of + One -> (attackingBoard', defendingBoard') + Two -> (defendingBoard', attackingBoard') -atk :: CardInstance -> Int -> (Board, Board) -> (Board, Board) -atk attacker defenderIndex (attackerBoard, defenderBoard) = - let defender = defenderBoard !! defenderIndex - newAttacker = attacker {card = (attacker.card) {health = max 0 (attacker.card.health - defender.card.attack)}} - newDefender = defender {card = (defender.card) {health = max 0 (defender.card.health - attacker.card.attack)}} - newAttackerBoard = if newAttacker.card.health > 0 then newAttacker : tail attackerBoard else tail attackerBoard - newDefenderBoard = - take defenderIndex defenderBoard - ++ ([newDefender | newDefender.card.health > 0]) - ++ drop (defenderIndex + 1) defenderBoard - in (newAttackerBoard, newDefenderBoard) +trade :: (CardInstance, CardInstance) -> (CardInstance, CardInstance) +trade (attacker, defender) = + ( attacker {card = attacker.card {health = attacker.card.health - defender.card.attack}}, + defender {card = defender.card {health = defender.card.health - attacker.card.attack}} + ) combatEnded :: (Board, Board) -> Bool combatEnded (board1, board2) = null board1 || null board2 -determineCombatResult :: (Board, Board) -> CombatResult -determineCombatResult (board1, board2) - | not (null board1) && null board2 = Loser Two - | null board1 && not (null board2) = Loser One +calculateResult :: (Board, Board) -> CombatResult +calculateResult (board1, board2) + | not (null board1) && null board2 = Loss Two (sum $ map (\ci -> ci.card.cardTier) board1) + | null board1 && not (null board2) = Loss One (sum $ map (\ci -> ci.card.cardTier) board2) | otherwise = Tie - -calculateDamage :: CombatResult -> (Board, Board) -> Damage -calculateDamage result (board1, board2) = - case result of - Loser One -> sum $ map (\ci -> ci.card.cardTier) board2 - Loser Two -> sum $ map (\ci -> ci.card.cardTier) board1 - Tie -> 0 diff --git a/src/Controller.hs b/src/Controller.hs index 81501e4..b000a96 100644 --- a/src/Controller.hs +++ b/src/Controller.hs @@ -10,8 +10,12 @@ import Text.Parsec hiding (Error) import Text.Parsec.String (Parser) import Text.Read (readMaybe) import View (render) -import System.IO (hReady, stdin) +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) -- START: Functions for ingesting terminal input as PlayerAction -- -- Examples: @@ -86,7 +90,7 @@ defPlayerState :: PlayerState defPlayerState = PlayerState { tier = 1, - maxGold = 2, -- By `enter`ing into the first turn, this becomes 3 as required. + maxGold = 300, -- By `enter`ing into the first turn, this becomes 3 as required. curGold = 2, tierUpCost = 6, -- By `enter`ing into the first turn, this becomes 5 as required. rerollCost = 1, @@ -98,7 +102,7 @@ defPlayerState = armor = 0, alive = True, phase = HeroSelect, - combatSimulation = CombatSimulation [] [] + combatToReplay = CombatSimulation [] [] Tie } runGame :: IO () @@ -114,11 +118,19 @@ runGame = do gs <- mgs if isGameOver gs then do - _ <- liftIO $ render gs Player -- Render the EndScreen before exit. - return gs - else case gs.playerState.phase of + 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 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) @@ -128,9 +140,10 @@ runGame = do Left err -> liftIO (putStrLn err) >> loop (return gs) Right gs' -> loop (return gs') Combat -> do - liftIO $ render gs Player + gs' <- fight Player AI gs + liftIO $ render gs' Player liftIO flushInput - loop $ enter Recruit Player gs + loop $ enter Recruit Player gs' _ -> mgs -- ignore input entered during combat phase diff --git a/src/Logic.hs b/src/Logic.hs index 4bcd469..5d8318b 100644 --- a/src/Logic.hs +++ b/src/Logic.hs @@ -6,7 +6,7 @@ module Logic (module Logic) where import Card (pool) -import Combat (CombatResult (..), fight) +import Combat (fight) import Control.Monad.Random import Data.Functor ((<&>)) import Model @@ -55,23 +55,14 @@ enter Recruit Player gs = do -- fight! And then -- 1) provide the render phase with simulation sequence -- 2) unleash the damage -enter Combat Player gs = do - let (sim, combatResult, dmg) = fight Player AI gs - let gs' = gs {playerState = gs.playerState {phase = Combat, combatSimulation = sim}} - case combatResult of - Tie -> return gs' - Loser loser -> return $ updatePlayer loser loserState' gs' - where - loserState = selectPlayer loser gs - (hp', armor') = dealDmg dmg (loserState.hp, loserState.armor) - loserState' = (selectPlayer loser gs) {hp = hp', armor = armor'} -- Note: Damage dealing happens before combat sequence is played -enter _ _ _ = error "Other phases should not be enterable" - -dealDmg :: Int -> (Health, Armor) -> (Health, Armor) -dealDmg n (hp, armor) = (hp - hpDmg, armor - armorDmg) - where - armorDmg = min n armor - hpDmg = n - armorDmg +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" + -- START: Utility Methods for PlayerAction Functions -- -- Determinisitc functions should only be used when the usage permits only the happy path diff --git a/src/Model.hs b/src/Model.hs index 4f0e081..becfe2b 100644 --- a/src/Model.hs +++ b/src/Model.hs @@ -48,20 +48,20 @@ type Turn = Int -- What turn are we on? type UserName = String -data Phase = HeroSelect | Recruit | Combat | EndScreen deriving (Eq) +data Phase = HeroSelect | Recruit | Combat | EndScreen deriving (Show, Eq) -- For now, GameState just keeps track of the solo player and one AI. data Player = Player | AI deriving (Show, Eq) -data Config = Config { maxBoardSize :: Int, maxHandSize :: Int } +data Config = Config { maxBoardSize :: Int, maxHandSize :: Int } deriving Show data GameState = GameState { playerState :: PlayerState, aiState :: PlayerState, config :: Config, turn :: Turn - } + } deriving Show -data CombatSimulation = CombatSimulation {combatMoves :: [CombatMove], boardSequences :: [(Board, Board)]} deriving Show +data CombatSimulation = CombatSimulation {combatMoves :: [CombatMove], boardSequences :: [(Board, Board)], result :: CombatResult } deriving Show -- TODO: The client can replay the same combat if provided the same seed -- However, for testing purposes, it will be nice to manually write out the attack sequence @@ -70,7 +70,7 @@ data CombatMove = deriving Show data Contestant = One | Two deriving (Show, Eq) -data CombatResult = Loser Contestant | Tie deriving (Show, Eq) +data CombatResult = Loss Contestant Damage | Tie deriving (Show, Eq) type Damage = Int type CombatHistory = [(Board, Board)] @@ -88,8 +88,8 @@ data PlayerState = PlayerState alive :: Bool, rerollCost :: Gold, phase :: Phase, - combatSimulation :: CombatSimulation - } + combatToReplay :: CombatSimulation + } deriving Show type Index = Int diff --git a/src/View.hs b/src/View.hs index d0945f3..8e83199 100644 --- a/src/View.hs +++ b/src/View.hs @@ -2,11 +2,12 @@ module View (render, helpMenu) where +import Control.Concurrent (threadDelay) +import Control.Monad (forM_) import Data.List (intercalate) +import Debug.Trace (trace) import Model import Utils (selectPlayer) -import Control.Monad (forM_) -import Control.Concurrent (threadDelay) -- Render creates the following example. In the example, 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. @@ -43,15 +44,19 @@ render gs p = case (selectPlayer p gs).phase of Recruit -> putStrLn $ renderRecruit gs p HeroSelect -> putStrLn "heroselect todo" - Combat -> forM_ (replayCombat gs.playerState.combatSimulation) $ \s -> do - putStrLn s - threadDelay $ 500 * 1000 -- 500 milliseconds + 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 +replayCombat (CombatSimulation _ bs _) = map renderBoardState bs renderBoardState :: ([CardInstance], [CardInstance]) -> String renderBoardState (board1, board2) = @@ -59,9 +64,9 @@ renderBoardState (board1, board2) = [ hBorder, "|" ++ alignMid (rowWidth - 2) "Combat Simulation" ++ "|", hBorder, - "| Player 1: " ++ alignMid maxRowContentWidth (intercalate " | " (map renderCard board1)) ++ " |", - hBorder, "| Player 2: " ++ alignMid maxRowContentWidth (intercalate " | " (map renderCard board2)) ++ " |", + hBorder, + "| Player 1: " ++ alignMid maxRowContentWidth (intercalate " | " (map renderCard board1)) ++ " |", hBorder ]