gameServer/Votes.hs
changeset 10215 26fc5502ba22
parent 10212 5fb3bb2de9d2
child 10216 6928a323097f
equal deleted inserted replaced
10214:426aafe1f3ed 10215:26fc5502ba22
    35         let v = (length $ entitledToVote vt) `div` 2 + 1
    35         let v = (length $ entitledToVote vt) `div` 2 + 1
    36 
    36 
    37         if length contra >= v then
    37         if length contra >= v then
    38             closeVoting
    38             closeVoting
    39         else if length pro >= v then do
    39         else if length pro >= v then do
    40             act $ voteType vt
    40             a <- act $ voteType vt
    41             closeVoting
    41             c <- closeVoting
       
    42             return $ c ++ a
    42         else
    43         else
    43             return [ModifyRoom $ \r -> r{voting = Just vt}]
    44             return [ModifyRoom $ \r -> r{voting = Just vt}]
    44 
    45 
    45     closeVoting = do
    46     closeVoting = do
    46         chans <- roomClientsChans
    47         chans <- roomClientsChans
    65     act (VoteMap roomSave) = do
    66     act (VoteMap roomSave) = do
    66         rm <- thisRoom
    67         rm <- thisRoom
    67         let rs = Map.lookup roomSave (roomSaves rm)
    68         let rs = Map.lookup roomSave (roomSaves rm)
    68         case rs of
    69         case rs of
    69              Nothing -> return []
    70              Nothing -> return []
    70              Just (mp, p) -> return [Warning "ye!", ModifyRoom $ \r -> r{params = p, mapParams = mp}]
    71              Just (mp, p) -> return [ModifyRoom $ \r -> r{params = p, mapParams = mp}]
    71 
    72 
    72 
    73 
    73 startVote :: VoteType -> Reader (ClientIndex, IRnC) [Action]
    74 startVote :: VoteType -> Reader (ClientIndex, IRnC) [Action]
    74 startVote vt = do
    75 startVote vt = do
    75     (ci, rnc) <- ask
    76     (ci, rnc) <- ask
    84     else
    85     else
    85         return [
    86         return [
    86             ModifyRoom (\r -> r{voting = Just (newVoting vt){entitledToVote = uids}})
    87             ModifyRoom (\r -> r{voting = Just (newVoting vt){entitledToVote = uids}})
    87             , AnswerClients chans ["CHAT", "[server]", B.concat [loc "New voting started", ": ", voteInfo vt]]
    88             , AnswerClients chans ["CHAT", "[server]", B.concat [loc "New voting started", ": ", voteInfo vt]]
    88             , ReactCmd ["VOTE", "YES"]
    89             , ReactCmd ["VOTE", "YES"]
    89         ] 
    90         ]
    90 
    91 
    91 
    92 
    92 checkVotes :: StateT ServerState IO ()
    93 checkVotes :: StateT ServerState IO [Action]
    93 checkVotes = undefined
    94 checkVotes = do
       
    95     rnc <- gets roomsClients
       
    96     io $ do
       
    97         ris <- allRoomsM rnc
       
    98         actions <- mapM (check rnc) ris
       
    99         mapM_ processAction actions
       
   100     where
       
   101         check rnc ri = do
       
   102             e <- room'sM rnc voting ri
       
   103             case e of
       
   104                  Just rv -> do
       
   105                      modifyRoom rnc (\r -> r{voting = if voteTTL rv == 0 then Nothing else Just rv{voteTTL = voteTTL rv - 1}}) ri
       
   106                      if voteTTL rv == 0 then do
       
   107                         chans <- liftM sendChan $ roomClientsM rnc ri
       
   108                         return [AnswerClients chans ["CHAT", "[server]", loc "Voting expired"]]
       
   109                         else
       
   110                         return []
       
   111                 Nothing -> return []
    94 
   112 
    95 
   113 
    96 voteInfo :: VoteType -> B.ByteString
   114 voteInfo :: VoteType -> B.ByteString
    97 voteInfo (VoteKick n) = B.concat [loc "kick", " ", n]
   115 voteInfo (VoteKick n) = B.concat [loc "kick", " ", n]
    98 voteInfo (VoteMap n) = B.concat [loc "map", " ", n]
   116 voteInfo (VoteMap n) = B.concat [loc "map", " ", n]