From 60e5c3c2316540b12126b4a940be6f17ee64baae Mon Sep 17 00:00:00 2001 From: Andrew Chen Date: Sat, 11 Jan 2025 22:16:00 -0500 Subject: [PATCH] More State pattern refactor; PlayerMap; More Eff integration #2 --- battlegrounds.cabal | 1 - src/Card.hs | 5 ++ src/Combat.hs | 89 ++++++++++++---------- src/Controller.hs | 131 ++++++++++++++++++-------------- src/Logic.hs | 179 ++++++++++++++++++++++++++------------------ src/Model.hs | 8 +- src/Utils.hs | 14 ---- src/View.hs | 32 +++++--- 8 files changed, 262 insertions(+), 197 deletions(-) delete mode 100644 src/Utils.hs diff --git a/battlegrounds.cabal b/battlegrounds.cabal index a4f0ef9..3b77774 100644 --- a/battlegrounds.cabal +++ b/battlegrounds.cabal @@ -31,7 +31,6 @@ library Effect Logic Model - Utils View other-modules: Paths_battlegrounds diff --git a/src/Card.hs b/src/Card.hs index 20bd609..d2a139a 100644 --- a/src/Card.hs +++ b/src/Card.hs @@ -3,6 +3,11 @@ module Card (module Card) where import Model + ( Card (..), + CardCriteria (..), + CardEffect (..), + CardName (..), + ) pool :: [Card] pool = [dummy, dumber, triDummy, dumbo, bigDumbo, kingDumbo] diff --git a/src/Combat.hs b/src/Combat.hs index 8a9416e..e23f3d4 100644 --- a/src/Combat.hs +++ b/src/Combat.hs @@ -1,18 +1,19 @@ -{-# LANGUAGE TypeOperators #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeOperators #-} module Combat where import Control.Lens hiding (Index) import Data.Bifunctor (Bifunctor (second)) import Data.List (findIndex, mapAccumL) +import Data.Map ((!)) import Data.Maybe (fromJust) import Debug.Trace (trace) +import Effect (RNG, getRandomR) +import Effectful (Eff, (:>)) import Logic (genId) import Model hiding (turn) -import Utils (selectPlayer, updatePlayer) -import Effectful (Eff, (:>)) -import Effect (RNG, getRandomR) +import Effectful.State.Static.Local dealDmg :: Int -> (Health, Armor) -> (Health, Armor) dealDmg n (hp, armor) = (hp - hpDmg, armor - armorDmg) @@ -21,31 +22,39 @@ dealDmg n (hp, armor) = (hp - hpDmg, armor - armorDmg) hpDmg = n - armorDmg -- `fight` simulates the combat -fight :: (RNG :> es) => Player -> Player -> GameState -> Eff es (GameState, CombatSimulation) -fight p1 p2 gs = do - sequence <- simulateCombat p1 p2 gs +fight :: (State GameState :> es, RNG :> es) => (PlayerId, PlayerId) -> Eff es CombatSimulation +fight (p1Id, p2Id) = do + gs <- get + let p1State = (gs ^. playerMap) ! p1Id + let p2State = (gs ^. playerMap) ! p2Id + sequence <- simulateCombat (p1Id, p2Id) let result = calculateResult (last sequence) let sim = CombatSimulation [] sequence result case result of - Tie -> return (gs, sim) + Tie -> return sim Loss fighter dmg -> do - let loser = case fighter of - One -> Player - Two -> AI - loserState = selectPlayer loser gs + let (loserId, loserState) = case fighter of + One -> (p1Id, p1State) + Two -> (p2Id, p2State) (hp', armor') = dealDmg dmg (loserState ^. hp, loserState ^. armor) - loserState' = loserState & hp .~ hp' - & armor .~ armor' - & alive .~ (hp' > 0) - return (updatePlayer loser loserState' gs, sim) - -simulateCombat :: (RNG :> es) => Player -> Player -> GameState -> Eff es CombatHistory -simulateCombat p1 p2 gs = do - let (p1State, p2State) = (selectPlayer p1 gs, selectPlayer p2 gs) + loserState' = + loserState + & hp .~ hp' + & armor .~ armor' + & alive .~ (hp' > 0) + put $ gs & playerMap . ix loserId .~ loserState' + return sim + +simulateCombat :: (State GameState :> es, RNG :> es) => (PlayerId, PlayerId) -> Eff es CombatHistory +simulateCombat (p1Id, p2Id) = do + gs <- get + let p1State = (gs ^. playerMap) ! p1Id + let p2State = (gs ^. playerMap) ! p2Id initialAttacker <- initAttacker (p1State ^. board) (p2State ^. board) + go (CombatState initialAttacker (FighterState p1State 0) (FighterState p2State 0) (gs ^. config)) - [] -- initial board is part of state + [(p1State ^. board, p2State ^. board)] -- initial board is part of state where go :: (RNG :> es) => CombatState -> CombatHistory -> Eff es CombatHistory go combatState history = do @@ -60,9 +69,8 @@ simulateCombat p1 p2 gs = do go combatState' (history ++ newHistorySlices) combatEnded :: CombatState -> Bool - combatEnded combatState = - null (combatState ^. one . fplayerState . board) || - null (combatState ^. two . fplayerState . board) + combatEnded cs = + null (cs ^. one . fplayerState . board) || null (cs ^. two . fplayerState . board) turn :: DefenderIndex -> -- Since the caller of `turn` specifies the `di`, testing single turns is easy. @@ -75,14 +83,13 @@ turn di cs = (cs''', history) Two -> (cs ^. two, cs ^. one) cs' = trade (attackingState ^. nextAttackIndex) di cs (cs'', snapshots) = handleDeaths cs' -- `handleDeath` does not clean the battleground (clear deaths) - cs''' = cs'' - & attacker .~ alternate (cs'' ^. attacker) - & one . fplayerState . board .~ clearDeath (cs'' ^. one . fplayerState . board) - & two . fplayerState . board .~ clearDeath (cs'' ^. two . fplayerState . board) + cs''' = + cs'' + & attacker .~ alternate (cs'' ^. attacker) + & one . fplayerState . board .~ clearDeath (cs'' ^. one . fplayerState . board) + & two . fplayerState . board .~ clearDeath (cs'' ^. two . fplayerState . board) history = map extractBoards [cs, cs'] ++ [extractBoards cs'' | not (null snapshots)] ++ [extractBoards cs'''] --- handleDeaths is recursive because certain deathrattles cause other minions to die. --- deathrattles are always handled in the order the minion died (and left-to-right on tie) handleDeaths :: CombatState -> (CombatState, CombatHistory) handleDeaths cs = if null (prepareDeathrattles cs) @@ -92,7 +99,7 @@ handleDeaths cs = (cs', states) = mapAccumL (\cs' (fighter, id, eff) -> (interpCombatEffect (CombatEffectContext cs' fighter id) eff, cs')) cs (prepareDeathrattles cs) histories = map extractBoards (tail states) -- be rid of the head, which is the original `cs` prepareDeathrattles :: CombatState -> [(Fighter, MinionID, CardEffect)] - prepareDeathrattles = undefined + prepareDeathrattles cs = [] -- TODO: implement extractBoards :: CombatState -> (Board, Board) extractBoards cs = (cs ^. one . fplayerState . board, cs ^. two . fplayerState . board) @@ -132,17 +139,21 @@ trade :: AttackerIndex -> DefenderIndex -> CombatState -> CombatState trade ai di cs = cs' where (attackingBoard, defendingBoard) = case cs ^. attacker of - One -> (cs ^. one.fplayerState.board, cs ^. two.fplayerState.board) - Two -> (cs ^. two.fplayerState.board, cs ^. one.fplayerState.board) - + One -> (cs ^. one . fplayerState . board, cs ^. two . fplayerState . board) + Two -> (cs ^. two . fplayerState . board, cs ^. one . fplayerState . board) + (attackingMinion, defendingMinion) = (attackingBoard !! ai, defendingBoard !! di) (attackingMinion', defendingMinion') = dmgOther (attackingMinion, defendingMinion) - + cs' = case cs ^. attacker of - One -> cs & one.fplayerState.board .~ attackingBoard - & two.fplayerState.board .~ defendingBoard - Two -> cs & one.fplayerState.board .~ defendingBoard - & two.fplayerState.board .~ attackingBoard + One -> + cs + & one . fplayerState . board .~ attackingBoard + & two . fplayerState . board .~ defendingBoard + Two -> + cs + & one . fplayerState . board .~ defendingBoard + & two . fplayerState . board .~ attackingBoard dmgOther :: (CardInstance, CardInstance) -> (CardInstance, CardInstance) dmgOther (attacker, defender) = diff --git a/src/Controller.hs b/src/Controller.hs index 72178f1..b4b6d95 100644 --- a/src/Controller.hs +++ b/src/Controller.hs @@ -1,29 +1,30 @@ +{-# LANGUAGE FlexibleContexts #-} -- Controller: Handles input, game loop {-# LANGUAGE TypeOperators #-} -{-# LANGUAGE FlexibleContexts #-} module Controller (module Controller) where import Card (bigDumbo) import Combat (fight) +import Control.Lens +import Data.Map (fromList, (!)) import qualified Data.Text.Lazy as TL import Debug.Trace (trace, traceM) +import Effect +import Effectful +import Effectful.Dispatch.Dynamic +import Effectful.State.Static.Local import GHC.Base (when) import Logic (execCommand, isGameOver, replenish) import Model import System.IO (hFlush, hReady, stdin, stdout) -import Text.Parsec hiding (Error) +import System.Random (newStdGen) +import Text.Parsec hiding (Error, State) import Text.Parsec.String (Parser) import Text.Pretty.Simple (pPrint, pShow) import Text.Read (readMaybe) import View -import Control.Lens -import Effectful -import Effectful.Error.Static -import Effectful.State.Static.Local -import Effectful.Dispatch.Dynamic -import Effect -import System.Random (newStdGen) + -- START: Functions for ingesting terminal input as PlayerAction -- -- Examples: -- b 1 -> Buy 1 @@ -84,86 +85,106 @@ playArgParser = do -- END -- initGameState :: GameState -initGameState = GameState {_playerState = defPlayerState, _aiState = tutorialAI, _turn = 0, _config = Config {_maxBoardSize = 7, _maxHandSize = 10}} +initGameState = + GameState + { _playerMap = fromList [(0, mainPlayerState), (1, tutorialAI)], + _turn = 0, + _config = Config {_maxBoardSize = 7, _maxHandSize = 10, _maxCombatBoardSize = 7} + } tutorialAI :: PlayerState -tutorialAI = mainPlayerState - & board .~ [CardInstance bigDumbo 0] - & hp .~ 5 +tutorialAI = + mainPlayerState + & board .~ [CardInstance bigDumbo 0] + & hp .~ 5 mainPlayerState :: PlayerState mainPlayerState = - PlayerState + defPlayerState { _tier = 1, _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, - _shop = [], - _board = [], - _hand = [], - _frozen = False, _hp = 20, _armor = 0, _alive = True, - _phase = Recruit, - _idGen = IdGen 0 + _phase = Recruit } +mainPlayerId :: Int +mainPlayerId = 0 + +aiPlayerId :: Int +aiPlayerId = 1 + runGame :: IO () runGame = do gen <- newStdGen - _ <- runEff . runRNG gen $ loop $ return initGameState + _ <- runEff . runRNG gen . evalState initGameState $ loop putStrLn "Game Loop Completed." where -- Repeat Recruit and Combat until game over - loop :: (IOE :> es, RNG :> es) => Eff es GameState -> Eff es GameState - loop mgs = do - gs <- mgs - let gs' = gs & playerState.phase %~ \p -> if isGameOver gs then EndScreen else p - - case gs' ^. playerState.phase of + loop :: (IOE :> es, RNG :> es, State GameState :> es) => Eff es () + loop = do + gs <- get + let mainPlayerPhase = (gs ^. playerMap) ! mainPlayerId ^. phase + gs' = + if isGameOver gs + then gs & playerMap . ix mainPlayerId . phase .~ EndScreen + else gs + + case mainPlayerPhase of Recruit -> do - replenishedPlayer <- replenish (gs' ^. playerState) - replenishedAI <- replenish (gs' ^. aiState) - let gs'' = gs' & playerState .~ replenishedPlayer - & aiState .~ replenishedAI - recruitLoop gs'' >>= (loop . return) - + case (gs' ^. playerMap . at mainPlayerId, gs' ^. playerMap . at aiPlayerId) of + (Just mainPlayer, Just aiPlayer) -> do + replenishedPlayer <- replenish mainPlayer + replenishedAI <- replenish aiPlayer + let gs'' = + gs' + & playerMap . ix mainPlayerId .~ replenishedPlayer + & playerMap . ix aiPlayerId .~ replenishedAI + put gs'' + recruitLoop + loop + _ -> error "Invalid player IDs in game state" Combat -> do - (gs'', sim) <- fight Player AI gs' + sim <- fight (mainPlayerId, aiPlayerId) liftIO $ replayCombat 1 sim liftIO flushInput liftIO $ putStrLn "finished playing" - loop $ return $ gs'' & playerState.phase .~ Recruit - & aiState.phase .~ Recruit - + gs'' <- get + put $ + gs'' + & playerMap . ix mainPlayerId . phase .~ Recruit + & playerMap . ix aiPlayerId . phase .~ Recruit + loop EndScreen -> do - liftIO $ putStrLn $ endScreenMsg gs' - return gs - + liftIO $ putStrLn $ endScreenMsg gs' mainPlayerId _ -> error "Other phases not yet implemented" - -recruitLoop :: (IOE :> es, RNG :> es) => GameState -> Eff es GameState -recruitLoop gs - | (gs ^. playerState . phase) == Recruit = do - liftIO $ putStrLn $ fmtRecruit gs Player + +recruitLoop :: (IOE :> es, RNG :> es, State GameState :> es) => Eff es () +recruitLoop = do + gs <- get + case (gs ^. playerMap) ! 0 ^. phase of + Recruit -> do + liftIO $ putStrLn $ fmtRecruit gs 0 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 + either + (\_ -> return ()) + ( \cmd -> do + res <- execCommand cmd 0 + maybe (return ()) (\s -> liftIO (putStrLn s) >> recruitLoop) res + ) + (interp input) + recruitLoop + _ -> return () flushInput :: IO () flushInput = do ready <- hReady stdin when ready $ do - _ <- getChar -- Ignores commands entered (pressing actual enter key), but, this does not ignore partially typed, not-yet-entered text + _ <- getChar flushInput \ No newline at end of file diff --git a/src/Logic.hs b/src/Logic.hs index 5597d70..ff3cb3c 100644 --- a/src/Logic.hs +++ b/src/Logic.hs @@ -1,42 +1,38 @@ +{-# LANGUAGE FlexibleContexts #-} -- Logic: Handles recruit phase logic, executing user commands -- TODO: Modularize out the recruit logic, since Combat.hs is already separate. {-# LANGUAGE ParallelListComp #-} {-# LANGUAGE TypeOperators #-} -{-# LANGUAGE FlexibleContexts #-} module Logic (module Logic) where import Card (pool) - -import Data.List (foldl', mapAccumL) +import Control.Lens (At (at), Ixed (ix), traversed, (&), (.~), (<&>), (^.)) +import Control.Monad (replicateM) +import Data.List (mapAccumL) +import Data.Map (elems, toList, (!)) +import Effect (RNG, getRandomR) +import Effectful (Eff, IOE, MonadIO (liftIO), type (:>)) +import Effectful.State.Static.Local import Model -import Utils import View (helpMenu) -import Control.Lens hiding (Index) -import Effectful -import Effect (RNG, getRandomR) -import Control.Monad (replicateM, liftM2) - -execCommand :: (IOE :> es, RNG :> es) => Command -> GameState -> Player -> Eff es (Either String GameState) -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 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 = (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) -execCommand TierUp gs p = return $ tierUp (selectPlayer p gs) >>= (\ps' -> Right $ updatePlayer p ps' gs) -execCommand Freeze gs p = return $ freeze (selectPlayer p gs) >>= (\ps' -> Right $ updatePlayer p ps' gs) -execCommand Concede gs p = return $ concede (selectPlayer p gs) >>= (\ps' -> Right $ updatePlayer p ps' gs) + +type ErrorString = String + +execCommand :: (IOE :> es, RNG :> es, State GameState :> es) => Command -> PlayerId -> Eff es (Maybe ErrorString) +execCommand (Buy ind) pId = buy ind pId +execCommand (Sell ind) pId = sell ind pId +execCommand (Play ind) pId = play ind pId +execCommand Help _ = liftIO (putStrLn helpMenu) >> return Nothing +execCommand EndTurn _ = endturn +execCommand Roll pId = roll pId +execCommand TierUp pId = tierUp pId +execCommand Freeze pId = freeze pId +execCommand Concede pId = concede pId -- Game over if exactly one player is alive isGameOver :: GameState -> Bool -isGameOver gs = gs ^. playerState . alive /= gs ^. aiState . alive +isGameOver gs = length (filter (^. alive) (elems $ gs ^. playerMap)) <= 1 -- Performed when we first transition to a new game phase. replenish :: (RNG :> es) => PlayerState -> Eff es PlayerState @@ -65,8 +61,9 @@ findCard ind instances = instances !! ind remove :: Int -> [a] -> [a] remove _ [] = [] -remove 0 (_ : xs) = xs -remove n (x : xs) = x : remove (n - 1) xs +remove n xs | n < 0 = xs -- Handle negative indices +remove n xs | n >= length xs = xs -- Handle out of bounds +remove n xs = take n xs ++ drop (n + 1) xs canTierUp :: PlayerState -> Bool canTierUp ps = ps ^. curGold >= ps ^. tierUpCost @@ -107,41 +104,63 @@ sampleNFromList n xs = replicateM n sample -- END -- -- START: Functions that Command maps to -- -play :: Index -> GameState -> Player -> Either String PlayerState -play ind gs p - | ind < 0 || ind >= length (ps ^. hand) || length (ps ^. board) >= gs ^. config . maxBoardSize = Left "Out of bounds." - | otherwise = Right ps {_board = ps ^. board ++ [findCard ind (ps ^. hand)], _hand = remove ind (ps ^. hand)} - where - ps = selectPlayer p gs - -buy :: Index -> GameState -> Player -> Either String PlayerState -buy ind gs p - | shopSize == 0 = Left "Cannot buy. Your shop is empty." - | length (ps ^. hand) >= gs ^. config . maxHandSize = Left "Your hand is full" - | ind < 0 || ind >= shopSize = Left "Out of bounds." - | cost > moneyLeft = - Left "Attempted buying without enough money." - | otherwise = - Right ps {_curGold = moneyLeft - cost, _shop = remove ind (ps ^. shop), _hand = ps ^. hand ++ [cardInstance]} - where - ps = selectPlayer p gs - cardInstance = findCard ind (ps ^. shop) - cost = cardInstance ^. card . baseCost - moneyLeft = ps ^. curGold - shopSize = length (ps ^. shop) - -sell :: Index -> PlayerState -> Either String PlayerState -sell ind ps - | ind < 0 || ind >= length (ps ^. board) = Left "Out of bounds." - | otherwise = Right ps {_curGold = ps ^. curGold + 1, _board = remove ind (ps ^. board)} - -roll :: (RNG :> es) => PlayerState -> Eff es (Either String PlayerState) -roll ps = - if ps ^. curGold < ps ^. rerollCost - then return $ Left "Attempted rollings without enough money" +play :: (State GameState :> es) => Index -> PlayerId -> Eff es (Maybe ErrorString) +play ind pId = do + gs <- get + let ps = (gs ^. playerMap) ! pId + if ind < 0 || ind >= length (ps ^. hand) || length (ps ^. board) >= gs ^. config . maxBoardSize + then return $ Just "Out of bounds." else do - (idGen', newShop) <- randomShop (ps ^. idGen) (ps ^. tier) - return $ Right $ ps {_curGold = ps ^. curGold - 1, _shop = newShop, _idGen = idGen'} + put $ gs & playerMap . ix pId .~ ps {_board = ps ^. board ++ [findCard ind (ps ^. hand)], _hand = remove ind (ps ^. hand)} + return Nothing + +buy :: (State GameState :> es) => Index -> PlayerId -> Eff es (Maybe ErrorString) +buy ind pId = do + gs <- get + let ps = (gs ^. playerMap) ! pId + cardInstance = findCard ind (ps ^. shop) + cost = cardInstance ^. card . baseCost + moneyLeft = ps ^. curGold + shopSize = length (ps ^. shop) + ps' = ps {_curGold = moneyLeft - cost, _shop = remove ind (ps ^. shop), _hand = ps ^. hand ++ [cardInstance]} + case () of + _ + | shopSize == 0 -> return $ Just "Cannot buy. Your shop is empty." + | length (ps ^. hand) >= gs ^. config . maxHandSize -> return $ Just "Your hand is full." + | ind < 0 || ind >= shopSize -> return $ Just "Out of bounds." + | cost > moneyLeft -> return $ Just "Attempted buying without enough money." + | otherwise -> do + put $ gs & playerMap . ix pId .~ ps' + return Nothing + +sell :: (State GameState :> es) => Index -> PlayerId -> Eff es (Maybe ErrorString) +sell ind pId = do + gs <- get + let ps = (gs ^. playerMap) ! pId + case () of + _ + | ind < 0 || ind >= length (ps ^. board) -> return $ Just "Out of bounds." + | otherwise -> do + put $ gs & playerMap . ix pId .~ ps {_curGold = ps ^. curGold + 1, _board = remove ind (ps ^. board)} + return Nothing + +roll :: (State GameState :> es, RNG :> es) => PlayerId -> Eff es (Maybe ErrorString) +roll pId = do + gs <- get + let ps = (gs ^. playerMap) ! pId + case () of + _ + | ps ^. curGold < ps ^. rerollCost -> return $ Just "Attempted rollings without enough money" + | otherwise -> do + (idGen', newShop) <- randomShop (ps ^. idGen) (ps ^. tier) + put $ gs & playerMap . ix pId .~ ps {_curGold = ps ^. curGold - 1, _shop = newShop, _idGen = idGen'} + return Nothing + +endturn :: (State GameState :> es) => Eff es (Maybe ErrorString) +endturn = do + gs <- get + put $ gs & playerMap . traversed . phase .~ Combat + return Nothing -- Cost for going to the TavernTier baseTierUpCost :: TavernTier -> Int @@ -153,20 +172,34 @@ baseTierUpCost t = case t of 6 -> 10 _ -> error "Tier Up to 7 is not possible for now. So, `baseTierUpCost` shouldn't have been queried" -tierUp :: PlayerState -> Either String PlayerState -tierUp ps - | ps ^. tier == 6 = Left "Attempted to tier up but already on Tavern 6" - | ps ^. curGold < ps ^. tierUpCost = Left "Attempted tier up without enough money" - | otherwise = return $ ps {_curGold = ps ^. curGold - ps ^. tierUpCost, _tier = newTier, _tierUpCost = if newTier == 6 then 10000 else baseTierUpCost (newTier + 1)} - where - newTier = ps ^. tier + 1 +tierUp :: (State GameState :> es) => PlayerId -> Eff es (Maybe ErrorString) +tierUp pId = do + gs <- get + let ps = (gs ^. playerMap) ! pId + let oldTier = ps ^. tier + let newTier = oldTier + 1 + case () of + _ + | oldTier == 6 -> return $ Just "Attempted to tier up but already on Tavern 6" + | (ps ^. curGold) < (ps ^. tierUpCost) -> return $ Just "Attempted tier up without enough money" + | otherwise -> do + put $ gs & playerMap . ix pId .~ ps {_curGold = ps ^. curGold - ps ^. tierUpCost, _tier = newTier, _tierUpCost = if newTier == 6 then 10000 else baseTierUpCost (newTier + 1)} + return Nothing -- toggle frozen -freeze :: PlayerState -> Either String PlayerState -freeze ps = return ps {_frozen = not (ps ^. frozen)} +freeze :: (State GameState :> es) => PlayerId -> Eff es (Maybe ErrorString) +freeze pId = do + gs <- get + let ps = (gs ^. playerMap) ! pId + put $ gs & playerMap . ix pId .~ ps {_frozen = not (ps ^. frozen)} + return Nothing -- Kill player and move their render screen to the EndScreen -concede :: PlayerState -> Either String PlayerState -concede ps = return ps {_alive = False} +concede :: (State GameState :> es) => PlayerId -> Eff es (Maybe ErrorString) +concede pId = do + gs <- get + let ps = (gs ^. playerMap) ! pId + put $ gs & playerMap . ix pId .~ ps {_alive = False} + return Nothing -- END -- diff --git a/src/Model.hs b/src/Model.hs index f061b17..d310d8b 100644 --- a/src/Model.hs +++ b/src/Model.hs @@ -2,9 +2,8 @@ module Model (module Model) where -import Prelude import Control.Lens -import Control.Lens.TH +import Data.Map (Map) {- Design Philosophy: @@ -161,9 +160,10 @@ defPlayerState = PlayerState { _idGen = IdGen 0 } +type PlayerId = Int + data GameState = GameState - { _playerState :: PlayerState, - _aiState :: PlayerState, + { _playerMap :: Map PlayerId PlayerState, _config :: Config, _turn :: Turn } diff --git a/src/Utils.hs b/src/Utils.hs deleted file mode 100644 index 6ef74be..0000000 --- a/src/Utils.hs +++ /dev/null @@ -1,14 +0,0 @@ - - -module Utils (module Utils) where -import Model -import Control.Lens - - -updatePlayer :: Player -> PlayerState -> GameState -> GameState -updatePlayer Player ps gs = gs & playerState .~ ps -updatePlayer AI ps gs = gs & aiState .~ ps - -selectPlayer :: Player -> GameState -> PlayerState -selectPlayer Player gs = gs ^. playerState -selectPlayer AI gs = gs ^. aiState \ No newline at end of file diff --git a/src/View.hs b/src/View.hs index 444fc4a..254a607 100644 --- a/src/View.hs +++ b/src/View.hs @@ -1,14 +1,12 @@ - - module View (module View) where import Control.Concurrent (threadDelay) +import Control.Lens import Control.Monad (forM_) import Data.List (intercalate) +import Data.Map (foldrWithKey, keys, (!)) import Debug.Trace (trace) import Model -import Utils (selectPlayer) -import Control.Lens rowWidth :: Int rowWidth = 142 @@ -25,8 +23,8 @@ renderCard ci = abbrev maxCardNameDisplayLength (show (ci ^. card . cardName)) + hBorder :: [Char] hBorder = "+" ++ replicate (rowWidth - 2) '-' ++ "+" -endScreenMsg :: GameState -> String -endScreenMsg gs = if gs ^. playerState . alive then "Victory! Ending now." else "You loss. Ending now." +endScreenMsg :: GameState -> PlayerId -> String +endScreenMsg gs pId = if (gs ^. playerMap) ! pId ^. 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. @@ -48,8 +46,8 @@ endScreenMsg gs = if gs ^. playerState . alive then "Victory! Ending now." else -- | 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 | -- +-------------------------------------------------------------------------------------------------------------------------------------------+ -fmtRecruit :: GameState -> Player -> String -fmtRecruit gs p = +fmtRecruit :: GameState -> PlayerId -> String +fmtRecruit gs pId = intercalate "\n" $ filter (not . null) @@ -73,7 +71,7 @@ fmtRecruit gs p = hBorder ] where - ps = selectPlayer p gs + ps = (gs ^. playerMap) ! pId shopCardNames = [(abbrev maxCardNameDisplayLength . show) (cardInstance ^. card . cardName) | cardInstance <- ps ^. shop] boardCardNames = [(abbrev maxCardNameDisplayLength . show) (cardInstance ^. card . cardName) | cardInstance <- ps ^. board] handCardNames = [(abbrev maxCardNameDisplayLength . show) (cardInstance ^. card . cardName) | cardInstance <- ps ^. hand] @@ -84,7 +82,17 @@ fmtRecruit gs p = healthText = "Health: " ++ show (ps ^. hp) armorText = "Armor: " ++ show (ps ^. armor) goldText = "Gold: " ++ show (ps ^. curGold) ++ "/" ++ show (ps ^. maxGold) - oppInfoText = "Tutorial AI" ++ ": " ++ show (gs ^. aiState . hp) ++ " + " ++ show (gs ^. aiState . armor) + opps = filter (/= pId) (keys (gs ^. playerMap)) + oppInfoText = + intercalate + " | " + [ show opp + ++ ": " + ++ show ((gs ^. playerMap) ! opp ^. hp) + ++ " + " + ++ show ((gs ^. playerMap) ! opp ^. armor) + | opp <- opps + ] abbrev :: Int -> String -> String abbrev maxLen s = @@ -104,8 +112,10 @@ alignMid space s = leftPad ++ s ++ rightPad -- 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) +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