Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Some game steps

  • Loading branch information...
commit 3501e83912d9ae25b2fec192727a27c65e100396 1 parent e93d3e5
@Detegr authored
Showing with 141 additions and 56 deletions.
  1. +1 −1  dml-server.cabal
  2. +95 −16 src/DML/Game.hs
  3. +28 −24 src/DML/Types.hs
  4. +17 −15 src/Main.hs
View
2  dml-server.cabal
@@ -20,6 +20,6 @@ executable dml-server
main-is: Main.hs
other-modules: DML.Types
-- other-extensions:
- build-depends: base >=4.5 && <4.6, random-source, random-fu, random-extras, random, transformers, MonadRandom, mtl, data-default
+ build-depends: base >=4.5 && <4.6, random-source, random-fu, random-extras, random, transformers, MonadRandom, mtl, data-default, lens
hs-source-dirs: src
default-language: Haskell2010
View
111 src/DML/Game.hs
@@ -1,29 +1,108 @@
module DML.Game where
-import DML.Types
+import Control.Applicative ((<$>),(<*>))
+import Control.Lens
import Control.Monad.Random
+import Control.Monad.Trans (lift)
import Control.Monad.Trans.State
-import Control.Applicative ((<$>),(<*>))
+import Debug.Trace
+import DML.Types
type DML g a = RandT g (State DMLState) a
-runDML :: (RandomGen g) => DML g a -> DMLState -> g -> (a, DMLState)
-runDML f s g = runState (evalRandT f g) s
+runDML :: (RandomGen g) => DMLState -> g -> DML g a -> (a, DMLState)
+runDML s g f = runState (evalRandT f g) s
+
+evalDML :: (RandomGen g) => DMLState -> g -> DML g a -> a
+evalDML s g f = fst $ runDML s g f
+
+execDML :: (RandomGen g) => DMLState -> g -> DML g a -> DMLState
+execDML s g f = snd $ runDML s g f
+
+-- |Lifts a function modifying DMLState to DML monad
+liftDML :: (DMLState -> DMLState) -> DML g ()
+liftDML f = lift get >>= lift . put . f >> return ()
+
+-- |Lifts a function modifying DMLState to DML monad
+liftDML' :: (DMLState -> (a, DMLState)) -> DML g a
+liftDML' f = lift get >>= \s -> let (a,s') = f s in lift $ put s' >> return a
-evalDML :: (RandomGen g) => DML g a -> DMLState -> g -> a
-evalDML f s g = fst $ runDML f s g
+-- |Draws a card from 'EventDeck'.
+--
+-- If 'EventDeck' is empty, returns Nothing
+draw :: DMLState -> (Maybe Card, DMLState)
+draw s = if null deck'
+ then (Nothing, s)
+ else (Just c, draw' s)
+ where deck' = s ^. deck
+ c = head deck'
+ rest = tail deck'
+ draw' = deck .~ rest
-execDML :: (RandomGen g) => DML g a -> DMLState -> g -> DMLState
-execDML f s g = snd $ runDML f s g
+-- |Executes 'draw' in a DML monad
+drawM :: DML g (Maybe Card)
+drawM = liftDML' draw
+-- |Draws a card from 'EventStack' and assigns it as the
+-- current global event if the card is a valid event card
+drawEvent :: DMLState -> DMLState
+drawEvent s = let (c,s') = draw s in event .~ (mkEvent c) $ s'
+
+-- |Executes 'drawEvent' in a DML monad
+drawEventM :: DML g ()
+drawEventM = liftDML drawEvent
+
+-- |Supply phase of a DML game.
+--
+-- A card is drawn from 'EventDeck' and added either to 'Market' or 'DragonsLoot'
supply :: DMLState -> DMLState
-supply s
- | deck s == [] = s
- | otherwise = undefined
- where c = head (deck s)
-
--- | Rolls two dice and returns the values in a tuple
-mkRoll :: (RandomGen g) => DML g (Int, Int)
-mkRoll = (,) <$> rollOne <*> rollOne
+supply s =
+ case draw s of
+ (Nothing, st) -> st
+ (Just c, st) ->
+ case c of
+ DragonEgg _ -> addToLoot c st
+ Character _ -> addToLoot c st
+ Guild _ -> addToLoot c st
+ Card _ _ -> addToMarket c st
+ Thief -> addToLoot c st
+ King _ -> undefined
+ where addToLoot c = loot <>~ [c]
+ addToMarket c =
+ case (resource c) of
+ Slave -> over market $ slaves <>~ [c]
+ Spice -> over market $ spices <>~ [c]
+ Iron -> over market $ iron <>~ [c]
+ Wood -> over market $ wood <>~ [c]
+ Joker -> undefined
+
+-- |Executes 'supply' in a DML monad
+supplyM :: DML g ()
+supplyM = liftDML supply
+
+marketSize :: Market -> Int
+marketSize m = m1 + m2 + m3 + m4
+ where m1 = length $ m ^. slaves
+ m2 = length $ m ^. spices
+ m3 = length $ m ^. iron
+ m4 = length $ m ^. wood
+
+-- |Restock phase of a DML game
+--
+-- The market is restocked. Cards are drawn to the market using 'supply'
+-- until there's 3 cards in the market.
+restock :: DMLState -> DMLState
+restock s = if count < 3
+ then restock (supply s)
+ else s
+ where count = marketSize (s ^. market)
+
+-- |Executes 'restock' in a DML monad
+restockM :: DML g ()
+restockM = liftDML restock
+
+-- |Rolls two dice and returns the values in a tuple
+rollM :: (RandomGen g) => DML g (Int, Int)
+rollM = (,) <$> rollOne <*> rollOne
where range = (1,6)
rollOne = getRandomR range
View
52 src/DML/Types.hs
@@ -1,8 +1,8 @@
-{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE TemplateHaskell, FlexibleContexts #-}
module DML.Types(Resource(..),
- Card,
- Market(..),
+ Card(..),
+ Market, slaves, spices, iron, wood,
BlackMarket,
DragonsLoot,
EventDeck,
@@ -14,12 +14,14 @@ module DML.Types(Resource(..),
mkDeck,
mkPlayers,
Player,
- DMLState(..)) where
+ DMLState(DMLState), deck, market, bMarkets, loot, players, event
+ ) where
import Data.Default
+import Control.Lens.TH
import Data.Maybe (fromJust)
-import Data.Random.RVar
import Data.Random.Extras (shuffle)
+import Data.Random.RVar
import Data.Random.Source
import Data.Random.Source.DevRandom
@@ -45,11 +47,12 @@ data EventType = Decadence | TaxRelief | Looters | SupplyShortage | ForeignMerch
data Event = Event { etype :: EventType , power :: Int} deriving (Show,Eq)
-- | Type representing the market in a DML game.
-data Market = Market { slaves :: [Card]
- , spices :: [Card]
- , iron :: [Card]
- , wood :: [Card]
+data Market = Market { _slaves :: [Card]
+ , _spices :: [Card]
+ , _iron :: [Card]
+ , _wood :: [Card]
} deriving (Show,Eq)
+makeLenses ''Market
instance Default Market where
def = Market [] [] [] []
@@ -65,15 +68,16 @@ data Player = Player { treasury :: Treasury
, king :: Card
} deriving (Show,Eq)
-data DMLState = DMLState { deck :: EventDeck
- , market :: Market
- , bMarkets :: [BlackMarket]
- , loot :: DragonsLoot
- , players :: (Player, Player, Player, Player)
- , event :: Maybe Event
- }
+data DMLState = DMLState { _deck :: EventDeck
+ , _market :: Market
+ , _bMarkets :: [BlackMarket]
+ , _loot :: DragonsLoot
+ , _players :: (Player, Player, Player, Player)
+ , _event :: Maybe Event
+ } deriving (Show)
+makeLenses ''DMLState
--- | Constructs jack Character from a Resource
+-- | Constructs jack 'Character' from a 'Resource'
getJack :: Resource -> Character
getJack Slave = TroublesomeBlabbermouth
getJack Spice = GoodsSwindler
@@ -81,7 +85,7 @@ getJack Iron = GrandInquisitor
getJack Wood = BoonLiquidator
getJack Joker = undefined
--- | Constructs queen Character from a Resource
+-- |Constructs queen 'Character' from a 'Resource'
getQueen :: Resource -> Character
getQueen Slave = MotherOfDragons
getQueen Spice = Archudess
@@ -89,7 +93,7 @@ getQueen Iron = DragonEmpress
getQueen Wood = BitchQueen
getQueen Joker = undefined
--- | Constructs EventType from a Resource
+-- |Constructs 'EventType' from a 'Resource'
getEvent :: Resource -> EventType
getEvent Slave = Decadence
getEvent Spice = TaxRelief
@@ -97,12 +101,12 @@ getEvent Iron = Looters
getEvent Wood = SupplyShortage
getEvent Joker = ForeignMerchant
--- | Constructs an Event out of Card
-mkEvent :: Card -> Maybe Event
-mkEvent (Card r v) = Just $ Event (getEvent r) v
-mkEvent _ = Nothing
+-- |Constructs an 'Event' out of a 'Maybe Card'
+mkEvent :: Maybe Card -> Maybe Event
+mkEvent (Just (Card r v)) = Just $ Event (getEvent r) v
+mkEvent _ = Nothing
--- | Constructs a Card out of Resource and a value
+-- | Constructs a 'Card' out of 'Resource' and a value
mkCard :: Resource -> Int -> Maybe Card
mkCard r v
| v > 1 && v < 10 = Just $ Card r v
View
32 src/Main.hs
@@ -1,25 +1,27 @@
module Main where
+import Control.Lens
+import Control.Monad
import Control.Monad.Random
+import Control.Monad.Trans (lift)
import Control.Monad.Trans.State
-import System.Random
-import Data.Default
-import DML.Types
import DML.Game
+import DML.Types
+import Data.Default
main :: IO()
main = do
gen <- fmap mkStdGen randomIO
- deck <- mkDeck
- players <- mkPlayers
- print $ deck
+ initialDeck <- mkDeck
+ playerTuple <- mkPlayers
+
+ let initialState = DMLState initialDeck def [] [] playerTuple Nothing
- let initialState = DMLState { deck = deck
- , market = def
- , bMarkets = []
- , loot = []
- , players = players
- , event = Nothing
- }
- let roll=evalDML mkRoll initialState gen
- putStrLn $ show roll
+ let (_,st)=runDML initialState gen $ do
+ restockM
+ supplyM
+ supplyM
+ supplyM
+ supplyM
+ supplyM
+ putStrLn . show $ (st ^. market)
Please sign in to comment.
Something went wrong with that request. Please try again.