{-# LANGUAGE GADTs, ScopedTypeVariables, TupleSections #-} -- | All the building blocks to allow rules to manage players. module Language.Nomyx.Players where -- PlayerNumber, -- PlayerName, -- PlayerInfo(..), -- Player(..), -- playerNumber, playerName, -- getPlayers, getPlayer, getPlayerName, -- setPlayerName, -- modifyPlayerName, -- getPlayersNumber, getAllPlayerNumbers, -- delPlayer, -- forEachPlayer, forEachPlayer_, -- createValueForEachPlayer, createValueForEachPlayer_, -- getValueOfPlayer, -- modifyValueOfPlayer, modifyAllValues, -- showPlayer, -- getSelfProposedByPlayer, -- setVictory, -- giveVictory, import Language.Nomyx.Expression import Language.Nomyx.Events import Language.Nomyx.Variables import Language.Nomyx.Rules import Data.Typeable import Data.List import Data.Lens import Control.Applicative import Control.Arrow -- * Players -- | get all the players getPlayers :: Nomex [PlayerInfo] getPlayers = GetPlayers -- | Get a specific player getPlayer :: PlayerNumber -> Nomex (Maybe PlayerInfo) getPlayer pn = do pls <- GetPlayers return $ find ((== pn) . getL playerNumber) pls -- | Set the name of a player getPlayerName :: PlayerNumber -> Nomex (Maybe PlayerName) getPlayerName pn = do p <- getPlayer pn return $ _playerName <$> p -- | Set the name of a player setPlayerName :: PlayerNumber -> PlayerName -> Nomex Bool setPlayerName = SetPlayerName modifyPlayerName :: PlayerNumber -> (PlayerName -> PlayerName) -> Nomex Bool modifyPlayerName pn f = do mn <- getPlayerName pn case mn of Just name -> setPlayerName pn (f name) Nothing -> return False -- | Get the total number of players getPlayersNumber :: Nomex Int getPlayersNumber = length <$> getPlayers -- | Get all the players number getAllPlayerNumbers :: Nomex [PlayerNumber] getAllPlayerNumbers = map _playerNumber <$> getPlayers -- | Remove the player from the game (kick) delPlayer :: PlayerNumber -> Nomex Bool delPlayer = DelPlayer -- | perform an action for each current players, new players and leaving players forEachPlayer :: (PlayerNumber -> Nomex ()) -> (PlayerNumber -> Nomex ()) -> (PlayerNumber -> Nomex ()) -> Nomex () forEachPlayer action actionWhenArrive actionWhenLeave = do pns <- getAllPlayerNumbers mapM_ action pns onEvent_ (Player Arrive) $ \(PlayerData p) -> actionWhenArrive $ _playerNumber p onEvent_ (Player Leave) $ \(PlayerData p) -> actionWhenLeave $ _playerNumber p -- | perform the same action for each players, including new players forEachPlayer_ :: (PlayerNumber -> Nomex ()) -> Nomex () forEachPlayer_ action = forEachPlayer action action (\_ -> return ()) -- | create a value initialized for each players --manages players joining and leaving createValueForEachPlayer :: forall a. (Typeable a, Show a, Eq a) => a -> MsgVar [(PlayerNumber, a)] -> Nomex () createValueForEachPlayer initialValue mv = do pns <- getAllPlayerNumbers v <- newMsgVar_ (getMsgVarName mv) $ map (,initialValue::a) pns forEachPlayer (const $ return ()) (\p -> modifyMsgVar v ((p, initialValue) : )) (\p -> modifyMsgVar v $ filter $ (/= p) . fst) -- | create a value initialized for each players initialized to zero --manages players joining and leaving createValueForEachPlayer_ :: MsgVar [(PlayerNumber, Int)] -> Nomex () createValueForEachPlayer_ = createValueForEachPlayer 0 getValueOfPlayer :: forall a. (Typeable a, Show a, Eq a) => PlayerNumber -> MsgVar [(PlayerNumber, a)] -> Nomex (Maybe a) getValueOfPlayer pn var = do value <- readMsgVar_ var return $ lookup pn value modifyValueOfPlayer :: (Eq a, Show a, Typeable a) => PlayerNumber -> MsgVar [(PlayerNumber, a)] -> (a -> a) -> Nomex () modifyValueOfPlayer pn var f = modifyMsgVar var $ map $ (\(a,b) -> if a == pn then (a, f b) else (a,b)) modifyAllValues :: (Eq a, Show a, Typeable a) => MsgVar [(PlayerNumber, a)] -> (a -> a) -> Nomex () modifyAllValues var f = modifyMsgVar var $ map $ second f -- | show a player name based on his number showPlayer :: PlayerNumber -> Nomex String showPlayer pn = do mn <- getPlayerName pn case mn of Just name -> return name Nothing -> return ("Player " ++ (show pn)) -- | set victory to a list of players setVictory :: [PlayerNumber] -> Nomex () setVictory = SetVictory -- | give victory to one player giveVictory :: PlayerNumber -> Nomex () giveVictory pn = SetVictory [pn] getSelfProposedByPlayer :: Nomex PlayerNumber getSelfProposedByPlayer = getSelfRule >>= return . _rProposedBy