Permalink
Browse files

Implemented processPrestacks, resolve

  • Loading branch information...
1 parent f35e95b commit 2e4e640a970c4b19fea38540f39af6fca978cf12 @MedeaMelana committed Nov 4, 2012
Showing with 41 additions and 20 deletions.
  1. +6 −6 Core.hs
  2. +25 −8 Engine.hs
  3. +8 −5 IdList.hs
  4. +2 −1 Types.hs
View
12 Core.hs
@@ -3,7 +3,7 @@
module Core
( compileZoneRef
- , evaluate, singleTarget, (<?>), askMagicTargets, allTargets
+ , evaluateTargetList, singleTarget, (<?>), askMagicTargets, allTargets
, module Types
) where
@@ -31,10 +31,10 @@ compileZoneRef z =
Exile -> exile
Command -> command
-evaluate :: TargetList Target a -> ([Target], a)
-evaluate (Nil x) = ([], x)
-evaluate (Snoc xs t) = (ts ++ [t], f t) where (ts, f) = evaluate xs
-evaluate (Test f _ xs) = (ts, f x) where (ts, x) = evaluate xs
+evaluateTargetList :: TargetList Target a -> ([Target], a)
+evaluateTargetList (Nil x) = ([], x)
+evaluateTargetList (Snoc xs t) = (ts ++ [t], f t) where (ts, f) = evaluateTargetList xs
+evaluateTargetList (Test f _ xs) = (ts, f x) where (ts, x) = evaluateTargetList xs
singleTarget :: TargetList () Target
singleTarget = Snoc (Nil id) ()
@@ -52,7 +52,7 @@ askTargets choose = askTargets' (const (return True))
Nil x -> return (Nil x)
Snoc xs () -> do
xs' <- askTargets choose ts xs
- let (_, f) = evaluate xs'
+ let (_, f) = evaluateTargetList xs'
eligibleTargets <- view (filterM (ok . f) ts)
chosen <- choose eligibleTargets
return (Snoc xs' chosen)
View
@@ -241,7 +241,7 @@ offerPriority :: Engine ()
offerPriority = do
-- TODO do this in a loop
checkSBAs
- emptyPrestacks
+ processPrestacks
mAction <- apnap >>= offerPriority'
case mAction of
Just action -> do
@@ -255,7 +255,7 @@ offerPriority = do
resolve i
offerPriority
where
- offerPriority' (p:ps) = do
+ offerPriority' ((p, _):ps) = do
actions <- collectActions p
mAction <- liftQuestion (AskPriorityAction p actions)
case mAction of
@@ -322,12 +322,29 @@ collectSBAs = execWriterT $ do
-- TODO [704.5r]
-- TODO [704.5s]
-
-emptyPrestacks :: Engine ()
-emptyPrestacks = undefined
+-- | Ask players to put pending items on the stack in APNAP order. [405.3]
+processPrestacks :: Engine ()
+processPrestacks = do
+ ips <- apnap
+ forM_ ips $ \(i,p) -> do
+ let pending = get prestack p
+ when (not (null pending)) $ do
+ pending' <- liftQuestion (AskReorder i pending)
+ forM_ pending' $ \mkStackObject -> do
+ stackObject <- executeMagic mkStackObject
+ stack ~: IdList.cons stackObject
resolve :: Id -> Engine ()
-resolve = undefined
+resolve i = do
+ o <- gets (stack .^ listEl i)
+ let Just item = get stackItem o
+ let (_, mkEffects) = evaluateTargetList item
+ executeMagic mkEffects >>= mapM_ executeEffect
+ -- if the object is now still on the stack, move it to the appropriate zone
+ let o' = set stackItem Nothing o
+ if (o `hasTypes` instantType || o `hasTypes` sorceryType)
+ then moveObject (Stack, i) (Graveyard (get controller o)) o'
+ else moveObject (Stack, i) Battlefield o'
object :: ObjectRef -> World :-> Object
object (zoneRef, i) = compileZoneRef zoneRef .^ listEl i
@@ -350,8 +367,8 @@ executeMagic :: Magic a -> Engine a
executeMagic m = State.get >>= lift . lift . runReaderT m
-- | Returns player IDs in APNAP order (active player, non-active player).
-apnap :: Engine [PlayerRef]
+apnap :: Engine [(PlayerRef, Player)]
apnap = do
activePlayerId <- gets activePlayer
- (ps, qs) <- break (== activePlayerId) . IdList.ids <$> gets players
+ (ps, qs) <- break ((== activePlayerId) . fst) . IdList.toList <$> gets players
return (qs ++ ps)
View
@@ -12,7 +12,7 @@ module IdList (
head, get, toList, ids,
-- * Modifying
- set, remove, cons, filter, shuffle,
+ set, remove, cons, cons', filter, shuffle,
consM, removeM, shuffleM
) where
@@ -49,7 +49,7 @@ empty :: IdList a
empty = IdList [] (Id 0)
fromList :: [a] -> IdList a
-fromList = foldr (\x xs -> snd (cons x xs)) empty
+fromList = foldr (\x xs -> snd (cons' x xs)) empty
@@ -91,8 +91,11 @@ remove i l =
--pop (IdList ((_, x) : ixs) i) = Just (x, IdList ixs i)
--pop _ = Nothing
-cons :: a -> IdList a -> (Id, IdList a)
-cons x (IdList ixs (Id i)) = (Id i, IdList ((Id i, x) : ixs) (Id (succ i)))
+cons :: a -> IdList a -> IdList a
+cons x xs = snd (cons' x xs)
+
+cons' :: a -> IdList a -> (Id, IdList a)
+cons' x (IdList ixs (Id i)) = (Id i, IdList ((Id i, x) : ixs) (Id (succ i)))
contents :: ([(Id, a)] -> [(Id, b)]) -> IdList a -> IdList b
contents f (IdList ixs i) = IdList (f ixs) i
@@ -115,6 +118,6 @@ removeM label i = do
consM :: MonadState s m => (s :-> IdList a) -> a -> m Id
consM label x = do
list <- gets label
- let (i, list') = cons x list
+ let (i, list') = cons' x list
puts label list'
return i
View
@@ -147,7 +147,7 @@ data EndStep
data Player = Player
{ _life :: Int
, _manaPool :: Bag (Maybe Color)
- , _prestack :: [Magic StackItem]
+ , _prestack :: [Magic Object]
, _library :: IdList Object
, _hand :: IdList Object
, _graveyard :: IdList Object
@@ -458,6 +458,7 @@ data Ask a where
AskKeepHand :: PlayerRef -> Ask Bool
AskPriorityAction :: PlayerRef -> [PriorityAction] -> Ask (Maybe PriorityAction)
AskTarget :: PlayerRef -> [Target] -> Ask Target
+ AskReorder :: PlayerRef -> [a] -> Ask [a]
view :: View a -> Magic a
view v = ReaderT $ return . runIdentity . runReaderT v

0 comments on commit 2e4e640

Please sign in to comment.