gameServer/Votes.hs
changeset 10087 5ba891578621
parent 10081 0af84e5cbd4d
child 10090 a471a7bbc339
equal deleted inserted replaced
10086:4a7ce724357f 10087:5ba891578621
     9 import Data.Maybe
     9 import Data.Maybe
    10 -------------------
    10 -------------------
    11 import Utils
    11 import Utils
    12 import CoreTypes
    12 import CoreTypes
    13 import HandlerUtils
    13 import HandlerUtils
       
    14 import Actions
    14 
    15 
    15 
    16 
    16 voted :: Bool -> Reader (ClientIndex, IRnC) [Action]
    17 voted :: Bool -> Reader (ClientIndex, IRnC) [Action]
    17 voted vote = do
    18 voted vote = do
    18     cl <- thisClient
    19     cl <- thisClient
    24     else if uid `L.notElem` entitledToVote (fromJust $ voting rm) then
    25     else if uid `L.notElem` entitledToVote (fromJust $ voting rm) then
    25         return []
    26         return []
    26     else if uid `L.elem` map fst (votes . fromJust $ voting rm) then
    27     else if uid `L.elem` map fst (votes . fromJust $ voting rm) then
    27         return [AnswerClients [sendChan cl] ["CHAT", "[server]", loc "You already have voted"]]
    28         return [AnswerClients [sendChan cl] ["CHAT", "[server]", loc "You already have voted"]]
    28     else
    29     else
    29         return [ModifyRoom $ \r -> r{voting = liftM (\v -> v{votes = (uid, vote):votes v}) $ voting rm}]
    30         actOnVoting . fromJust . liftM (\v -> v{votes = (uid, vote):votes v}) $ voting rm
       
    31     where
       
    32     actOnVoting :: Voting -> Reader (ClientIndex, IRnC) [Action]
       
    33     actOnVoting vt = do
       
    34         let (contra, pro) = L.partition snd $ votes vt
       
    35         let v = (length $ entitledToVote vt) `div` 2 + 1
       
    36 
       
    37         if length contra >= v then
       
    38             closeVoting
       
    39         else if length pro >= v then do
       
    40             act $ voteType vt
       
    41             closeVoting
       
    42         else
       
    43             return [ModifyRoom $ \r -> r{voting = Just vt}]
       
    44 
       
    45     closeVoting = do
       
    46         chans <- roomClientsChans
       
    47         return [
       
    48             AnswerClients chans ["CHAT", "[server]", loc "Voting closed"]
       
    49             , ModifyRoom (\r -> r{voting = Nothing})
       
    50             ]
       
    51 
       
    52     act (VoteKick nickname) = do
       
    53         (thisClientId, rnc) <- ask
       
    54         maybeClientId <- clientByNick nickname
       
    55         rm <- thisRoom
       
    56         let kickId = fromJust maybeClientId
       
    57         let kickCl = rnc `client` kickId
       
    58         let sameRoom = clientRoom rnc thisClientId == clientRoom rnc kickId
       
    59         return
       
    60             [KickRoomClient kickId |
       
    61                 isJust maybeClientId
       
    62                 && sameRoom
       
    63                 && ((isNothing $ gameInfo rm) || teamsInGame kickCl == 0)
       
    64             ]
    30 
    65 
    31 
    66 
    32 startVote :: VoteType -> Reader (ClientIndex, IRnC) [Action]
    67 startVote :: VoteType -> Reader (ClientIndex, IRnC) [Action]
    33 startVote vt = do
    68 startVote vt = do
    34     (ci, rnc) <- ask
    69     (ci, rnc) <- ask