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
]