Skip to content

Commit

Permalink
Refactored the neighborhood relationship
Browse files Browse the repository at this point in the history
  • Loading branch information
bartavelle committed May 12, 2014
1 parent 835a11d commit b3caa21
Show file tree
Hide file tree
Showing 4 changed files with 15 additions and 9 deletions.
6 changes: 3 additions & 3 deletions Startups/Game.hs
Expand Up @@ -46,7 +46,7 @@ initGame = do
playermap . ix pid %= (pCompany .~ profile)
. (pCards .~ [getResourceCard profile Project])
. (pFunds .~ 3)
. (pNeighborhood .~ M.fromList [(NLeft, ln), (NRight, rn)])
. (pNeighborhood .~ (ln, rn))
. (pCompanyStage .~ Project)

-- | A simple wrapper for getting random numbers.
Expand Down Expand Up @@ -104,7 +104,7 @@ resolveExchange pid exch = mconcat . M.elems <$> itraverse resolveExchange' exc
stt <- use playermap
let cost = getSum $ reslist ^. folded . to (Sum . getExchangeCost pid neigh stt)
playermoney = fromMaybe 0 (stt ^? ix pid . pFunds)
neighname = stt ^. ix pid . pNeighborhood . ix neigh
neighname = stt ^. ix pid . neighbor neigh
neigresources = stt ^. ix neighname . to (availableResources Exchange)
when (cost > playermoney) (throwError "A player tried to perform an exchange without enough funding")
unless (any (reslist `MS.isSubsetOf`) neigresources) (throwError "The neighbor doesn't have enough resources")
Expand Down Expand Up @@ -218,7 +218,7 @@ rotateHands age cardmap = itraverse rotatePlayer cardmap
where
rotatePlayer pid _ = do
-- get the identifier of the correct neighbor
neighid <- use (playermap . ix pid . pNeighborhood . ix direction)
neighid <- use (playermap . ix pid . neighbor direction)
-- get his hand
return (cardmap ^. ix neighid)
direction = if age == Age2
Expand Down
8 changes: 7 additions & 1 deletion Startups/GameTypes.hs
Expand Up @@ -23,11 +23,13 @@ data GameState = GameState { _playermap :: M.Map PlayerId PlayerState
, _rnd :: StdGen
}

type Neighborhood = (PlayerId, PlayerId)

data PlayerState = PlayerState { _pCompany :: CompanyProfile
, _pCompanyStage :: CompanyStage
, _pCards :: [Card]
, _pFunds :: Funding
, _pNeighborhood :: M.Map Neighbor PlayerId
, _pNeighborhood :: Neighborhood
, _pPoachingResults :: [PoachingOutcome]
}

Expand All @@ -40,6 +42,10 @@ cardEffects = pCards . traverse . cEffect . traverse
playerEffects :: PlayerId -> Traversal' GameState Effect
playerEffects pid = playermap . ix pid . cardEffects

neighbor :: Neighbor -> Lens' PlayerState PlayerId
neighbor NLeft = pNeighborhood . _1
neighbor NRight = pNeighborhood . _2

type Message = String

data PlayerAction = PlayerAction ActionType Card
Expand Down
2 changes: 1 addition & 1 deletion Startups/Utils.hs
Expand Up @@ -106,7 +106,7 @@ getTargets pid targets stt = targets ^.. folded . to getTargets' . traverse
where
getPlayer p = stt ^. at p
getTargets' Own = getPlayer pid
getTargets' (Neighboring n) = getPlayer pid >>= view (pNeighborhood . at n) >>= getPlayer
getTargets' (Neighboring n) = getPlayer pid >>= Just . view (neighbor n) >>= getPlayer

-- | Given a condition, counts how often it hits. It can return an
-- arbitrary Num because we will multiply this results with Funding or
Expand Down
8 changes: 4 additions & 4 deletions tests/tests.hs
Expand Up @@ -32,10 +32,10 @@ testState = GameState (M.fromList players) discard (mkStdGen 5)
ppam = CompanyProfile Apple B
ppoum = CompanyProfile Google A
pbob = CompanyProfile Twitter A
pim = PlayerState ppim Project pimcards 1 (M.fromList [(NLeft, "pam"), (NRight, "bob")]) []
pam = PlayerState ppam Project pamcards 3 (M.fromList [(NLeft, "poum"), (NRight, "pim")]) []
poum = PlayerState ppoum Project poumcards 6 (M.fromList [(NLeft, "bob"), (NRight, "pam")]) []
bob = PlayerState pbob Project bobcards 5 (M.fromList [(NLeft, "pim"), (NRight, "poum")]) []
pim = PlayerState ppim Project pimcards 1 ("pam", "bob") []
pam = PlayerState ppam Project pamcards 3 ("poum", "pim") []
poum = PlayerState ppoum Project poumcards 6 ("bob", "pam") []
bob = PlayerState pbob Project bobcards 5 ("pim", "poum") []
pimcards = map (getResourceCard ppim) [Project .. Stage1] <> map getCard [ "Cloud Servers"
, "Marketroid"
, "Company Nerf Battles"
Expand Down

0 comments on commit b3caa21

Please sign in to comment.