diff --git a/src/Test.hs b/src/Test.hs old mode 100644 new mode 100755 index 30024f4..502d845 --- a/src/Test.hs +++ b/src/Test.hs @@ -1,3 +1,4 @@ +#! /usr/bin/runhaskell {-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TemplateHaskell #-} @@ -5,7 +6,6 @@ import Waterdeep.Types import Waterdeep.Monad import Waterdeep.Logic -import Waterdeep.Util (mrepeat) import Control.Applicative import Control.Lens import Control.Monad @@ -41,71 +41,71 @@ p2 = ("Ned", f2, l2) q1 = Quest { _questType = Arcana , _questTitle = "Research Palantirs" , _questQuote = "" - , _questAction = ReturnResource [Cleric] - <> ReturnResource [Rogue] - <> ReturnResource [Rogue] - <> ReturnResource [Wizard] - <> mrepeat 4 (ReturnResource [Gold]) + , _questAction = ReturnResources 1 [Cleric] + <> ReturnResources 1 [Rogue] + <> ReturnResources 1 [Rogue] + <> ReturnResources 1 [Wizard] + <> ReturnResources 4 [Gold] <> ScorePoints 15 - <> mrepeat 8 (TakeResource [Gold]) + <> TakeResources 8 [Gold] , _questPlotActions = [] } q2 = Quest { _questType = Skullduggery , _questTitle = "Rob Waterdeep Bank" , _questQuote = "" - , _questAction = mrepeat 8 (ReturnResource [Rogue]) + , _questAction = ReturnResources 8 [Rogue] <> ScorePoints 10 - <> mrepeat 16 (TakeResource [Gold]) + <> TakeResources 16 [Gold] , _questPlotActions = [] } b1 = Building { _buildingCost = 6 , _buildingTitle = "Monastary" - , _buildingAction = mrepeat 2 (TakeResource [Cleric]) - , _buildingOwnerAction = TakeResource [Cleric] + , _buildingAction = TakeResources 2 [Cleric] + , _buildingOwnerAction = TakeResources 1 [Cleric] , _buildingAccumType = NoAccumulation } b2 = Building { _buildingCost = 4 , _buildingTitle = "Training Hall" - , _buildingAction = mrepeat 2 (TakeResource [Fighter]) - , _buildingOwnerAction = TakeResource [Fighter] + , _buildingAction = TakeResources 2 [Fighter] + , _buildingOwnerAction = TakeResources 1 [Fighter] , _buildingAccumType = NoAccumulation } b3 = Building { _buildingCost = 4 , _buildingTitle = "Prison Yard" - , _buildingAction = mrepeat 2 (TakeResource [Rogue]) - , _buildingOwnerAction = TakeResource [Rogue] + , _buildingAction = TakeResources 2 [Rogue] + , _buildingOwnerAction = TakeResources 1 [Rogue] , _buildingAccumType = NoAccumulation } b4 = Building { _buildingCost = 6 , _buildingTitle = "Wizard School" - , _buildingAction = mrepeat 2 (TakeResource [Wizard]) - , _buildingOwnerAction = TakeResource [Wizard] + , _buildingAction = TakeResources 2 [Wizard] + , _buildingOwnerAction = TakeResources 1 [Wizard] , _buildingAccumType = NoAccumulation } b5 = Building { _buildingCost = 4 , _buildingTitle = "Gold Mine" - , _buildingAction = mrepeat 4 (TakeResource [Gold]) - , _buildingOwnerAction = mrepeat 4 (TakeResource [Gold]) + , _buildingAction = TakeResources 4 [Gold] + , _buildingOwnerAction = TakeResources 2 [Gold] , _buildingAccumType = NoAccumulation } i1 = IntrigueCard { _intrigueTitle = "Graduation Day" , _intrigueType = Utility - , _intrigueAction = mrepeat 2 (TakeResource [Wizard]) - <> OneOpponent (TakeResource [Wizard]) + , _intrigueAction = TakeResources 2 [Wizard] + <> OneOpponent (TakeResources 1 [Wizard]) , _intrigueQuote = "" } i2 = IntrigueCard { _intrigueTitle = "Call for Adventurers" , _intrigueType = Utility - , _intrigueAction = mrepeat 2 (TakeResource [Cleric, Fighter, Rogue, Wizard]) - <> OneOpponent (TakeResource [Cleric, Fighter, Rogue, Wizard]) + , _intrigueAction = TakeResources 2 [Cleric, Fighter, Rogue, Wizard] + <> OneOpponent (TakeResources 1 [Cleric, Fighter, Rogue, Wizard]) , _intrigueQuote = "" } diff --git a/src/Waterdeep/Logic.hs b/src/Waterdeep/Logic.hs index 8fe718a..9f3f8f1 100644 --- a/src/Waterdeep/Logic.hs +++ b/src/Waterdeep/Logic.hs @@ -14,7 +14,7 @@ import Control.Lens import Control.Monad import Control.Monad.Random import Control.Monad.State -import Control.Monad.Writer +import Control.Monad.Trans.Writer import Data.List import Data.Maybe import Data.Monoid @@ -88,13 +88,16 @@ newBuildingState p b = basicBuildings :: [Building] basicBuildings = - [ basicBuilding "Aurora's Realms Shop" (mrepeat 4 $ TakeResource [Gold]) - , basicBuilding "Blackstaff Tower" (TakeResource [Wizard]) + [ basicBuilding "Aurora's Realms Shop" (TakeResources 4 [Gold]) + , basicBuilding "Blackstaff Tower" (TakeResources 1 [Wizard]) , basicBuilding "Builder's Hall" BuyBuilding - , basicBuilding "Castle Waterdeep" (BecomeFirstPlayer `Then` DrawIntrigue) - , basicBuilding "Field of Triumph" (mrepeat 2 $ TakeResource [Fighter]) - , basicBuilding "The Grinning Lion Tavern" (mrepeat 2 $ TakeResource [Rogue]) - , basicBuilding "The Plinth" (TakeResource [Cleric]) + , basicBuilding "Castle Waterdeep" (BecomeFirstPlayer <> DrawIntrigue) + , basicBuilding "Field of Triumph" (TakeResources 2 [Fighter]) + , basicBuilding "The Grinning Lion Tavern" (TakeResources 2 [Rogue]) + , basicBuilding "The Plinth" (TakeResources 1 [Cleric]) + , basicBuilding "Cliffwatch Inn (2 Gold)" (ChooseQuest <> TakeResources 2 [Gold]) + , basicBuilding "Cliffwatch Inn (Intrigue)" (ChooseQuest <> DrawIntrigue) + , basicBuilding "Cliffwatch Inn (Reset)" (ReplaceQuests <> ChooseQuest) ] basicBuilding :: String -> GameAction -> Building @@ -115,15 +118,19 @@ waterdeepGame = do forM_ ps $ \p -> do replicateM_ 2 $ performAction p DrawQuest replicateM_ 2 $ performAction p DrawIntrigue - replicateM_ (3 + p) $ performAction p $ TakeResource [Gold] + performAction p $ TakeResources (3 + p) [Gold] forM_ [1..8] $ \round -> do beginRound round + -- TODO: Assign ambassador (if in play) fix $ \loop -> do p <- use gameCurrentPlayer success <- filterChoices $ performAction p AssignAgent case success of True -> do - filterChoices $ performAction p CompleteQuest + filterChoices $ join $ solicitChoice p "Complete quest?" $ + [ ("Yes", performAction p CompleteQuest) + , ("No", return True) + ] gameCurrentPlayer .= (p `mod` length ps) + 1 gameConsecutivePasses .= 0 loop @@ -190,6 +197,31 @@ filterChoices m = do forwardPrompt (NotifyState w) = get >>= \w0 -> put w >> notifyState >> put w0 forwardPrompt (Broadcast s) = broadcast' s +-- Returns True if there exists some sequence of choices +-- which would make the action succeed, or False otherwise. +canPerformAction :: PlayerID -> GameAction -> Waterdeep Bool +canPerformAction p a = do + return . tryChoice . runWaterdeepC Done Cont (performAction p a) =<< get + where + tryChoice :: ContWD Bool -> Bool + tryChoice (Done a) = fst a + tryChoice (Cont (NotifyState w) cont) = tryChoice $ cont () + tryChoice (Cont (Broadcast s) cont) = tryChoice $ cont () + tryChoice (Cont (SolicitChoice p t cs) cont) = + or $ map (tryChoice . cont . snd) cs + +-- Like (<$>), but with the same fixity and precedence as ($) +(<$$>) :: Applicative f => (a -> b) -> f a -> f b +(<$$>) = (<$>) +infixr 0 <$$> + +joinStrings :: [String] -> String +joinStrings [] = "nothing" +joinStrings [x] = x +joinStrings [x,y] = x ++ " and " ++ y +joinStrings [x,y,z] = x ++ ", " ++ y ++ ", and " ++ z +joinStrings (x:xs) = x ++ ", " ++ joinStrings xs + performAction :: PlayerID -> GameAction -> Waterdeep Bool performAction p a = do name <- use $ gamePlayer p . playerName @@ -197,50 +229,218 @@ performAction p a = do NoAction -> return True ScorePoints n -> do gamePlayer p . playerScore += n - broadcast $ name ++ " scored " ++ show n ++ "points." + broadcast $ name ++ " scored " ++ show n ++ " points." return True - TakeResource rs -> do - r <- solicitChoice p "Take one item:" $ map (show &&& id) rs - gamePlayer p . playerTavern %= flip (M.unionWith (+)) (M.fromList [(r, 1)]) - broadcast $ name ++ " received one " ++ show r ++ "." + TakeResources n rs -> do + received <- map (head &&& length) . group . sort <$$> replicateM n $ do + r <- solicitChoice p "Take one item:" $ map (show &&& id) rs + gamePlayer p . playerTavern %= M.insertWith' (+) r 1 + return r + let items = joinStrings $ map (\(r,n) -> show n ++ " " ++ show r) received + broadcast $ name ++ " received " ++ items ++ "." return True - ReturnResource rs -> do - tavern <- use $ gamePlayer p . playerTavern - let rs' = filter ((> 0) . maybe 0 id . flip M.lookup tavern) rs - if null rs' - then return False - else do - r <- solicitChoice p "Return one item:" $ map (show &&& id) rs' - let removeOne x = if x > 1 then Just (x-1) else Nothing - gamePlayer p . playerTavern %= M.update removeOne r - broadcast $ name ++ " returned one " ++ show r ++ " to the supply." - return True + ReturnResources n rs -> do + maybeReturned <- replicateM n $ do + tavern <- use $ gamePlayer p . playerTavern + let rs' = filter ((>= 1) . maybe 0 id . flip M.lookup tavern) rs + if null rs' + then return Nothing + else do + r <- solicitChoice p "Return one item:" $ map (show &&& id) rs' + let removeOne x = if x > 1 then Just (x-1) else Nothing + gamePlayer p . playerTavern %= M.update removeOne r + return (Just r) + let success = and . map isJust $ maybeReturned + let returned = map (head &&& length) . group . catMaybes $ maybeReturned + let items = joinStrings $ map (\(r,n) -> show n ++ " " ++ show r) $ returned + broadcast $ name ++ " returned " ++ items ++ " to the supply." + return success ChooseQuest -> do - qs <- use gameCliffwatchInn - if null qs + quests <- use gameCliffwatchInn + if null quests then return False else do - let names = qs ^.. traverse . questTitle - q <- solicitChoice p "Please choose a quest:" $ zip names qs - gameCliffwatchInn %= (\\ [q]) - gamePlayer p . playerIncompleteQuests <>= [q] - broadcast $ name ++ " chose " ++ (q ^. questTitle) ++ " from Cliffwatch Inn." + let titles = quests ^.. traverse . questTitle + i <- solicitChoice p "Choose one quest:" $ zip titles [0..] + let quest = quests !! i + gameCliffwatchInn %= deleteAt i + gamePlayer p . playerIncompleteQuests <>= [quest] + broadcast $ name ++ " chose " ++ (quest ^. questTitle) ++ " from Cliffwatch Inn." restockCliffwatchInn return True + ReplaceQuests -> do + quests <- gameCliffwatchInn <<.= [] + gameQuestDiscard <>= quests + restockCliffwatchInn + return True DrawQuest -> do mq <- drawQuest case mq of - Nothing -> return False + Nothing -> do + broadcast $ name ++ " failed to draw a quest because the quest deck is empty." + return False Just q -> do gamePlayer p . playerIncompleteQuests <>= [q] broadcast $ name ++ " drew " ++ (q ^. questTitle) ++ " from the quest deck." return True + DrawNamedQuestType -> do + let qtypes = [Piety, Warfare, Skullduggery, Arcana, Commerce] + qtype <- solicitChoice p "Choose a quest type:" $ map (show &&& id) qtypes + broadcast $ name ++ " chose the " ++ show qtype ++ " quest type." + flip fix [] $ \loop discards -> do + mq <- drawQuest + case mq of + Nothing -> do + broadcast $ "There were no " ++ show qtype ++ " quests available." + gameQuestDiscard <>= discards + return False + Just q -> do + broadcast $ printf "%s drew the %s quest %s." + name (show (q ^. questType)) (q ^. questTitle) + if (q ^. questType /= qtype) + then loop (q : discards) >> return True + else do + gameQuestDiscard <>= discards + gamePlayer p . playerIncompleteQuests <>= [q] + return True + DistributeQuests -> do + np <- IM.size <$> use gamePlayers + let loop p' remQuests = do + unless (null remQuests) $ do + i <- solicitChoice p' "Choose a quest:" $ + zip (map (view questTitle) remQuests) [0..] + gamePlayer p' . playerIncompleteQuests <>= [remQuests !! i] + loop ((p' `mod` np) + 1) (deleteAt i remQuests) + loop p =<< return . catMaybes =<< replicateM np drawQuest + return True + CompleteQuest -> do + quests <- use (gamePlayer p . playerIncompleteQuests) + if null quests + then return False + else filterChoices $ do + let choices = zip (map (view questTitle) quests) [0..] + i <- solicitChoice p "Complete one quest:" choices + let quest = quests !! i + if (quest ^. questType /= Mandatory && + or (map (\q -> q ^. questType == Mandatory) quests)) + then return False + else do + gamePlayer p . playerIncompleteQuests %= deleteAt i + success <- performAction p (quest ^. questAction) + if null (quest ^. questPlotActions) + then gamePlayer p . playerCompletedQuests <>= [quest] + else gamePlayer p . playerActivePlotQuests <>= [quest] + broadcast $ name ++ " completed the " ++ (quest ^. questTitle) ++ " quest." + return success + ChooseAndCompleteQuest bonusAction -> do + quests <- use gameCliffwatchInn + if null quests + then return False + else filterChoices $ do + let titles = quests ^.. traverse . questTitle + i <- solicitChoice p "Choose one quest:" $ zip titles [0..] + let quest = quests !! i + if (quest ^. questType /= Mandatory && + or (map (\q -> q ^. questType == Mandatory) quests)) + then return False + else do + gameCliffwatchInn %= deleteAt i + broadcast $ name ++ " chose " ++ (quest ^. questTitle) ++ " from Cliffwatch Inn." + restockCliffwatchInn + doQuest <- solicitChoice p "Complete this quest immediately?" + [("Yes", True), ("No", False)] + case doQuest of + True -> do + questSuccess <- performAction p (quest ^. questAction) + bonusSuccess <- performAction p bonusAction + if null (quest ^. questPlotActions) + then gamePlayer p . playerCompletedQuests <>= [quest] + else gamePlayer p . playerActivePlotQuests <>= [quest] + broadcast $ name ++ " completed the " ++ (quest ^. questTitle) ++ " quest." + return (questSuccess && bonusSuccess) + False -> do + gamePlayer p . playerIncompleteQuests <>= [quest] + return True + DiscardUncompletedQuest -> do + quests <- use (gamePlayer p . playerIncompleteQuests) + if null quests + then return False + else do + i <- solicitChoice p "Choose a quest to discard:" $ + zip (map (view questTitle) quests) [0..] + let quest = quests !! i + gamePlayer p . playerIncompleteQuests %= deleteAt i + gameQuestDiscard <>= [quest] + broadcast $ name ++ " discarded the " ++ (quest ^. questTitle) ++ " quest." + return True + BuyBuilding -> do + buildings <- use gameBuildersHall + if null buildings + then return False + else do + let labels = flip map buildings $ \b -> printf "%s (%d Gold, %d Points)" + (b ^. building . buildingTitle) + (b ^. building . buildingCost) + (b ^. buildingAccumulation) + filterChoices $ do + i <- solicitChoice p "Choose a building from Builder's Hall:" $ + zip labels [0..] + let b = buildings !! i + let cost = b ^. building . buildingCost + paid <- performAction p $ ReturnResources cost [Gold] + performAction p $ ScorePoints (b ^. buildingAccumulation) + gameBuildersHall %= deleteAt i + gameBuildings <>= [b & buildingOwner .~ p & buildingAccumulation .~ 0] + broadcast $ name ++ " built the " ++ (b ^. building . buildingTitle) ++ "." + restockBuildersHall + return paid + ChooseFreeBuilding -> do + buildings <- use gameBuildersHall + if null buildings + then return False + else do + let labels = flip map buildings $ \b -> printf "%s (%d Points)" + (b ^. building . buildingTitle) + (b ^. buildingAccumulation) + i <- solicitChoice p "Choose a building from Builder's Hall:" $ + zip labels [0..] + let b = buildings !! i + performAction p $ ScorePoints (b ^. buildingAccumulation) + gameBuildersHall %= deleteAt i + gameBuildings <>= [b & buildingOwner .~ p & buildingAccumulation .~ 0] + broadcast $ name ++ " built the " ++ (b ^. building . buildingTitle) ++ " for free." + restockBuildersHall + return True + DrawFreeBuilding -> do + mb <- drawBuilding + case mb of + Nothing -> return False + Just b -> do + gameBuildings <>= [newBuildingState p b] + broadcast $ name ++ " built the " ++ (b ^. buildingTitle) ++ " for free." + return True + DiscardUnoccupiedBuilding -> do + allBuildings <- use gameBuildings + let choices = flip mapMaybe (zip allBuildings [0..]) $ \(b, i) -> + case b ^. buildingOwner == p of + True -> Just (b ^. building . buildingTitle, i) + False -> Nothing + if null choices + then return False + else do + i <- solicitChoice p "Choose a building to discard:" choices + let b = allBuildings !! i + gameBuildings %= deleteAt i + gameBuildingDiscard <>= [b ^. building] + broadcast $ name ++ " discarded the " ++ (b ^. building . buildingTitle) ++ "." + return True DrawIntrigue -> do mi <- drawIntrigue case mi of Nothing -> return False Just i -> do gamePlayer p . playerIntrigueCards <>= [i] + broadcast $ name ++ " drew an Intrigue card." return True PlayIntrigue -> do intrigues <- use (gamePlayer p . playerIntrigueCards) @@ -250,15 +450,20 @@ performAction p a = do let sameTitle a b = fst a == fst b let choices = nubBy sameTitle $ zip (map (view intrigueTitle) intrigues) [0..] i <- solicitChoice p "Play one intrigue card:" choices - let deleteAt n l = (take n l) ++ (drop (n + 1) l) - gamePlayer p . playerIntrigueCards %= deleteAt i - performAction p (intrigues ^. singular (ix i) . intrigueAction) + let intrigue = intrigues !! i + filterChoices $ do + gamePlayer p . playerIntrigueCards %= deleteAt i + broadcast $ name ++ " played the " ++ (intrigue ^. intrigueTitle) ++ " Intrigue card." + success <- performAction p (intrigue ^. intrigueAction) + gameIntrigueDiscard <>= [intrigue] + return success + ReturnAgent -> return False -- TODO + ReturnAgentFromHarbor -> return False -- TODO AssignAgent -> do agents <- use (gamePlayer p . playerAgentsInPool) if agents <= 0 then return False else do - w <- get let assignToBuilding :: Lens' WaterdeepState BuildingState -> Waterdeep Bool assignToBuilding bl = do gamePlayer p . playerAgentsInPool -= 1 @@ -266,7 +471,7 @@ performAction p a = do bName <- use (bl . building . buildingTitle) broadcast $ name ++ " assigned an agent to " ++ bName ++ "." owner <- use (bl . buildingOwner) - when (owner /= noPlayerID) $ + when (owner `notElem` [noPlayerID, p]) $ void . performAction owner =<< use (bl . building . buildingOwnerAction) performAction p =<< use (bl . building . buildingAction) let assignToHarbor l = do @@ -274,29 +479,57 @@ performAction p a = do gameWaterdeepHarbor . l <>= [p] broadcast $ name ++ " assigned an agent to Waterdeep Harbor." performAction p PlayIntrigue - let findBuildings :: Writer [(String, Waterdeep Bool)] () - findBuildings = do - forM_ [0 .. length (w ^. gameBuildings) - 1] $ \i -> do - let l :: Lens' WaterdeepState BuildingState - l = gameBuildings . singular (ix i) - when (null (w ^. l . buildingAgents)) $ do - tell [(w ^. l . building . buildingTitle, assignToBuilding l)] - case w ^. gameWaterdeepHarbor of - ([], _, _) -> tell [("Waterdeep Harbor", assignToHarbor _1)] - (_, [], _) -> tell [("Waterdeep Harbor", assignToHarbor _2)] - (_, _, []) -> tell [("Waterdeep Harbor", assignToHarbor _3)] - _ -> return () - let buildings = execWriter findBuildings + buildings <- execWriterT $ do + w <- get + forM_ [0 .. length (w ^. gameBuildings) - 1] $ \i -> do + let l :: Lens' WaterdeepState BuildingState + l = gameBuildings . singular (ix i) + when (null (w ^. l . buildingAgents)) $ do + tell [(w ^. l . building . buildingTitle, assignToBuilding l)] + case w ^. gameWaterdeepHarbor of + ([], _, _) -> tell [("Waterdeep Harbor", assignToHarbor _1)] + (_, [], _) -> tell [("Waterdeep Harbor", assignToHarbor _2)] + (_, _, []) -> tell [("Waterdeep Harbor", assignToHarbor _3)] + _ -> return () if null buildings then return False else do join $ solicitChoice p "Assign one agent to:" buildings - Optional a1 -> do - join $ solicitChoice p "Perform action?" $ - [ ("Yes", performAction p a1) - , ("No", return False)] + AssignAgentToBuildersHall -> return False -- TODO + AssignAgentToOpponentsSpace -> return False -- TODO + UseOpponentsSpace -> return False -- TODO + GainLieutenant -> do + gamePlayer p . playerHasLieutenant .= True + gamePlayer p . playerAgentsInPool += 1 + broadcast $ name ++ " gained the Lieutenant." + return True + GainAmbassador -> do + unavail <- or . toListOf (traverse . playerHasAmbassador) <$> use gamePlayers + if unavail + then return False + else do + gameBuildings . each . buildingAgents %= (\\ [noPlayerID]) + gameWaterdeepHarbor . each %= (\\ [noPlayerID]) + gamePlayer p . playerHasAmbassador .= True + broadcast $ name ++ " gained the Ambassador." + return True + TakeAccumulated -> + return True + AssignMandatoryQuest quest -> do + players <- toListOf traverse <$> use gamePlayers + let opponents = filter (\player -> (player ^. playerNumber) /= p) players + let choices = map (\p -> (p ^. playerName, p ^. playerNumber)) opponents + opID <- solicitChoice p "Choose one opponent:" choices + opName <- use (gamePlayer opID . playerName) + gamePlayer opID . playerIncompleteQuests <>= [quest] + broadcast $ name ++ " assigned " ++ opName ++ " a mandatory quest." + return True + BecomeFirstPlayer -> do + gameFirstPlayer .= p + broadcast $ name ++ " is now the first player." + return True ChooseOne as -> do - a1 <- solicitChoice p "Choose an action:" $ map (show &&& id) as + a1 <- solicitChoice p "Choose one:" $ map (show &&& id) as performAction p a1 a1 `Then` a2 -> do (&&) <$> performAction p a1 <*> performAction p a2 @@ -327,7 +560,6 @@ performAction p a = do return True CurrentPlayer a1 -> flip performAction a1 =<< use gameCurrentPlayer - _ -> return False scoreFinalPoints :: Waterdeep () scoreFinalPoints = do diff --git a/src/Waterdeep/Types.hs b/src/Waterdeep/Types.hs index bbb474d..6f855da 100644 --- a/src/Waterdeep/Types.hs +++ b/src/Waterdeep/Types.hs @@ -193,16 +193,16 @@ data AccumulationType = NoAccumulation data GameAction = NoAction | ScorePoints Int - | TakeResource [Resource] - | ReturnResource [Resource] - | GiveResource [Resource] + | TakeResources Int [Resource] + | ReturnResources Int [Resource] + | GiveResources Int [Resource] | ChooseQuest | ReplaceQuests | DrawQuest | DrawNamedQuestType | DistributeQuests | CompleteQuest - | ChooseAndCompleteQuest + | ChooseAndCompleteQuest GameAction | DiscardUncompletedQuest | BuyBuilding | ChooseFreeBuilding @@ -219,10 +219,8 @@ data GameAction = NoAction | GainLieutenant | GainAmbassador | TakeAccumulated - | TakeResourceFromOpponent [Resource] | AssignMandatoryQuest Quest | BecomeFirstPlayer - | Optional GameAction | ChooseOne [GameAction] | Then GameAction GameAction | OrElse GameAction GameAction diff --git a/src/Waterdeep/Util.hs b/src/Waterdeep/Util.hs index e0d7929..dcc5d8c 100644 --- a/src/Waterdeep/Util.hs +++ b/src/Waterdeep/Util.hs @@ -1,8 +1,12 @@ module Waterdeep.Util ( mrepeat + , deleteAt ) where import Data.Monoid mrepeat :: (Monoid m) => Int -> m -> m mrepeat n m = mconcat $ replicate n m + +deleteAt :: Int -> [a] -> [a] +deleteAt n l = (take n l) ++ (drop (n + 1) l)