gameServer/Votes.hs
changeset 13079 81c154fd4380
parent 11575 db7743e2fad1
child 13504 f747c385b5ba
equal deleted inserted replaced
13078:dd904dd9c587 13079:81c154fd4380
    40     rm <- thisRoom
    40     rm <- thisRoom
    41     uid <- liftM clUID thisClient
    41     uid <- liftM clUID thisClient
    42 
    42 
    43     case voting rm of
    43     case voting rm of
    44         Nothing -> 
    44         Nothing -> 
    45             return [AnswerClients [sendChan cl] ["CHAT", "[server]", loc "There's no voting going on"]]
    45             return [AnswerClients [sendChan cl] ["CHAT", "[server]", loc "There's no voting going on."]]
    46         Just voting ->
    46         Just voting ->
    47             if (not forced) && (uid `L.notElem` entitledToVote voting) then
    47             if (not forced) && (uid `L.notElem` entitledToVote voting) then
    48                 return []
    48                 return []
    49             else if (not forced) && (uid `L.elem` map fst (votes voting)) then
    49             else if (not forced) && (uid `L.elem` map fst (votes voting)) then
    50                 return [AnswerClients [sendChan cl] ["CHAT", "[server]", loc "You already have voted"]]
    50                 return [AnswerClients [sendChan cl] ["CHAT", "[server]", loc "You already have voted."]]
    51             else if forced && (not $ isAdministrator cl) then
    51             else if forced && (not $ isAdministrator cl) then
    52                 return []
    52                 return []
    53             else
    53             else
    54                 ((:) (AnswerClients [sendChan cl] ["CHAT", "[server]", loc "Your vote counted"]))
    54                 ((:) (AnswerClients [sendChan cl] ["CHAT", "[server]", loc "Your vote has been counted."]))
    55                 <$> (actOnVoting $ voting{votes = (uid, vote):votes voting})
    55                 <$> (actOnVoting $ voting{votes = (uid, vote):votes voting})
    56 
    56 
    57     where
    57     where
    58     actOnVoting :: Voting -> Reader (ClientIndex, IRnC) [Action]
    58     actOnVoting :: Voting -> Reader (ClientIndex, IRnC) [Action]
    59     actOnVoting vt = do
    59     actOnVoting vt = do
    71             return [ModifyRoom $ \r -> r{voting = Just vt}]
    71             return [ModifyRoom $ \r -> r{voting = Just vt}]
    72 
    72 
    73     closeVoting = do
    73     closeVoting = do
    74         chans <- roomClientsChans
    74         chans <- roomClientsChans
    75         return [
    75         return [
    76             AnswerClients chans ["CHAT", "[server]", loc "Voting closed"]
    76             AnswerClients chans ["CHAT", "[server]", loc "Voting closed."]
    77             , ModifyRoom (\r -> r{voting = Nothing})
    77             , ModifyRoom (\r -> r{voting = Nothing})
    78             ]
    78             ]
    79 
    79 
    80     act (VoteKick nickname) = do
    80     act (VoteKick nickname) = do
    81         (thisClientId, rnc) <- ask
    81         (thisClientId, rnc) <- ask
   106     act (VotePause) = do
   106     act (VotePause) = do
   107         rm <- thisRoom
   107         rm <- thisRoom
   108         chans <- roomClientsChans
   108         chans <- roomClientsChans
   109         let modifyGameInfo f room  = room{gameInfo = fmap f $ gameInfo room}
   109         let modifyGameInfo f room  = room{gameInfo = fmap f $ gameInfo room}
   110         return [ModifyRoom (modifyGameInfo $ \g -> g{isPaused = not $ isPaused g}),
   110         return [ModifyRoom (modifyGameInfo $ \g -> g{isPaused = not $ isPaused g}),
   111                 AnswerClients chans ["CHAT", "[server]", loc "Pause toggled"],
   111                 AnswerClients chans ["CHAT", "[server]", loc "Pause toggled."],
   112                 AnswerClients chans ["EM", toEngineMsg "I"]]
   112                 AnswerClients chans ["EM", toEngineMsg "I"]]
   113     act (VoteNewSeed) =
   113     act (VoteNewSeed) =
   114         return [SetRandomSeed]
   114         return [SetRandomSeed]
   115     act (VoteHedgehogsPerTeam h) = do
   115     act (VoteHedgehogsPerTeam h) = do
   116         rm <- thisRoom
   116         rm <- thisRoom
   160             case e of
   160             case e of
   161                  Just rv -> do
   161                  Just rv -> do
   162                      modifyRoom rnc (\r -> r{voting = if voteTTL rv == 0 then Nothing else Just rv{voteTTL = voteTTL rv - 1}}) ri
   162                      modifyRoom rnc (\r -> r{voting = if voteTTL rv == 0 then Nothing else Just rv{voteTTL = voteTTL rv - 1}}) ri
   163                      if voteTTL rv == 0 then do
   163                      if voteTTL rv == 0 then do
   164                         chans <- liftM (map sendChan) $ roomClientsM rnc ri
   164                         chans <- liftM (map sendChan) $ roomClientsM rnc ri
   165                         return [AnswerClients chans ["CHAT", "[server]", loc "Voting expired"]]
   165                         return [AnswerClients chans ["CHAT", "[server]", loc "Voting expired."]]
   166                         else
   166                         else
   167                         return []
   167                         return []
   168                  Nothing -> return []
   168                  Nothing -> return []
   169 
   169 
   170 
   170 
   171 voteInfo :: VoteType -> B.ByteString
   171 voteInfo :: VoteType -> B.ByteString
   172 voteInfo (VoteKick n) = B.concat [loc "kick", " ", n]
   172 voteInfo (VoteKick n) = B.concat [loc "kick", " ", n]
   173 voteInfo (VoteMap n) = B.concat [loc "map", " ", n]
   173 voteInfo (VoteMap n) = B.concat [loc "map", " ", n]
   174 voteInfo (VotePause) = B.concat [loc "pause"]
   174 voteInfo (VotePause) = B.concat [loc "pause"]
   175 voteInfo (VoteNewSeed) = B.concat [loc "new seed"]
   175 voteInfo (VoteNewSeed) = B.concat [loc "new seed"]
   176 voteInfo (VoteHedgehogsPerTeam i) = B.concat [loc "number of hedgehogs in team", " ", showB i]
   176 voteInfo (VoteHedgehogsPerTeam i) = B.concat [loc "hedgehogs per team: ", " ", showB i]