Permalink
Browse files

drawOpeningHands; moved effects to their own functions; refined Ask

  • Loading branch information...
1 parent 35500f3 commit f7ce9282ba9038d46a389a457ecf18546fdf9197 @MedeaMelana committed Sep 3, 2012
Showing with 53 additions and 28 deletions.
  1. +50 −17 Engine.hs
  2. +3 −11 Types.hs
View
@@ -2,25 +2,27 @@
module Engine where
+import IdList (Id)
import qualified IdList
import Labels
import Predicates
import Types
import Utils
import Control.Applicative ((<$>))
-import Control.Monad (forever, void, forM_)
-import Control.Monad.Operational
+import Control.Monad (forever, void, forM_, replicateM_)
+import qualified Control.Monad.Operational as Operational
import Control.Monad.Random (RandT, StdGen)
import Control.Monad.State (StateT)
import Control.Monad.Trans (lift)
import Data.Ord (comparing)
import Data.Label.Pure (set)
import Data.Label.PureM (gets, puts, (=:))
import Data.List (sortBy)
+import Data.Maybe (catMaybes)
import Data.Traversable (for)
-type Engine = StateT World (RandT StdGen (Program Ask))
+type Engine = StateT World (RandT StdGen (Operational.Program Ask))
enterPlayer :: [Card] -> Engine ()
@@ -30,6 +32,26 @@ enterPlayer deck = do
t <- tick
IdList.consM (players .^ listEl playerId .^ library) (instantiateCard card t playerId)
+drawOpeningHands :: [PlayerRef] -> Int -> Engine ()
+drawOpeningHands [] _ =
+ return ()
+drawOpeningHands playerIds 0 =
+ forM_ playerIds shuffleLibrary
+drawOpeningHands playerIds handSize = do
+ mulliganingPlayers <-
+ for playerIds $ \playerId -> do
+ moveAllObjects (Hand playerId) (Library playerId)
+ shuffleLibrary playerId
+ replicateM_ handSize (drawCard playerId)
+ keepHand <- liftQuestion (AskKeepHand playerId)
+ if keepHand
+ then return Nothing
+ else return (Just playerId)
+ drawOpeningHands (catMaybes mulliganingPlayers) (handSize - 1)
+
+liftQuestion :: Ask a -> Engine a
+liftQuestion = lift . lift . Operational.singleton
+
round :: Engine ()
round = forever $ do
players ~:* set manaPool []
@@ -153,39 +175,50 @@ executeEffect e = do
-- Compilation of effects
compileEffect :: OneShotEffect -> Engine ()
+compileEffect (UntapPermanent i) = untapPermanent i
+compileEffect (DrawCard rp) = drawCard rp
+compileEffect (MoveObject rObj rToZone) = moveObject rObj rToZone
+compileEffect (ShuffleLibrary rPlayer) = shuffleLibrary rPlayer
+compileEffect _ = undefined
+
+
+tick :: Engine Timestamp
+tick = do
+ t <- gets time
+ time ~: succ
+ return t
-compileEffect (UntapPermanent ro) =
- battlefield .^ listEl ro .^ tapStatus =: Just Untapped
+untapPermanent :: Id -> Engine ()
+untapPermanent ro = battlefield .^ listEl ro .^ tapStatus =: Just Untapped
-compileEffect (DrawCard rp) = do
+drawCard :: PlayerRef -> Engine ()
+drawCard rp = do
lib <- gets (players .^ listEl rp .^ library)
case IdList.toList lib of
[] -> players .^ listEl rp .^ failedCardDraw =: True
(ro, _) : _ -> executeEffect (MoveObject (Library rp, ro) (Hand rp))
-compileEffect (MoveObject (rFromZone, i) rToZone) = do
+moveObject :: ObjectRef -> ZoneRef -> Engine ()
+moveObject (rFromZone, i) rToZone = do
mObj <- IdList.removeM (compileZoneRef rFromZone) i
case mObj of
Nothing -> return ()
Just obj -> do
t <- tick
void (IdList.consM (compileZoneRef rToZone) (set timestamp t obj))
-compileEffect (ShuffleLibrary rPlayer) = do
+moveAllObjects :: ZoneRef -> ZoneRef -> Engine ()
+moveAllObjects rFromZone rToZone = do
+ objectIds <- map fst . IdList.toList <$> gets (compileZoneRef rFromZone)
+ forM_ objectIds $ \i -> moveObject (rFromZone, i) rToZone
+
+shuffleLibrary :: PlayerRef -> Engine ()
+shuffleLibrary rPlayer = do
let libraryLabel = players .^ listEl rPlayer .^ library
lib <- gets libraryLabel
lib' <- lift (IdList.shuffle lib)
puts libraryLabel lib'
-compileEffect _ = undefined
-
-
-tick :: Engine Timestamp
-tick = do
- t <- gets time
- time ~: succ
- return t
-
sortOn :: Ord b => (a -> b) -> [a] -> [a]
sortOn = sortBy . comparing
View
@@ -13,7 +13,7 @@ import IdList (Id, IdList)
import Control.Applicative
import Control.Monad.Reader
import Control.Monad.Identity
-import Control.Monad.Operational
+import qualified Control.Monad.Operational as Operational
import Data.Label (mkLabels)
import Data.Label.Pure ((:->))
import Data.Monoid
@@ -309,14 +309,6 @@ data OneShotEffect
| AttachPermanent ObjectRef (Maybe ObjectRef) (Maybe ObjectRef) -- aura/equipment, old target, new target
| RemoveFromCombat ObjectRef
-data Choice
- = ChoosePlayer PlayerRef
- | ChooseObject ObjectRef
- | ChooseColor Color
- | ChooseNumber Int
- | Pass
- | Concede
-
-- Targets
@@ -378,9 +370,9 @@ askTargets choose = askTargets' (const True)
type ViewT = ReaderT World
type View = ViewT Identity
-type Magic = ViewT (Program Ask)
+type Magic = ViewT (Operational.Program Ask)
data Ask a where
- Ask :: PlayerRef -> [Choice] -> Ask Choice
+ AskKeepHand :: PlayerRef -> Ask Bool
$(mkLabels [''World, ''Player, ''Object, ''ObjectTypes, ''Action])

0 comments on commit f7ce928

Please sign in to comment.