gameServer/Votes.hs
changeset 10786 712283ed86e0
parent 10464 d08611b52000
child 10787 50a4cdeedb44
equal deleted inserted replaced
10785:c5dd41e77a12 10786:712283ed86e0
    47                 return []
    47                 return []
    48             else if uid `L.elem` map fst (votes voting) then
    48             else if uid `L.elem` map fst (votes voting) then
    49                 return [AnswerClients [sendChan cl] ["CHAT", "[server]", loc "You already have voted"]]
    49                 return [AnswerClients [sendChan cl] ["CHAT", "[server]", loc "You already have voted"]]
    50             else
    50             else
    51                 actOnVoting $ voting{votes = (uid, vote):votes voting}
    51                 actOnVoting $ voting{votes = (uid, vote):votes voting}
    52       
    52 
    53     where
    53     where
    54     actOnVoting :: Voting -> Reader (ClientIndex, IRnC) [Action]
    54     actOnVoting :: Voting -> Reader (ClientIndex, IRnC) [Action]
    55     actOnVoting vt = do
    55     actOnVoting vt = do
    56         let (pro, contra) = L.partition snd $ votes vt
    56         let (pro, contra) = L.partition snd $ votes vt
    57         let totalV = length $ entitledToVote vt 
    57         let totalV = length $ entitledToVote vt 
   105     act (VotePause) = do
   105     act (VotePause) = do
   106         rm <- thisRoom
   106         rm <- thisRoom
   107         chans <- roomClientsChans
   107         chans <- roomClientsChans
   108         let modifyGameInfo f room  = room{gameInfo = fmap f $ gameInfo room}
   108         let modifyGameInfo f room  = room{gameInfo = fmap f $ gameInfo room}
   109         return [ModifyRoom (modifyGameInfo $ \g -> g{isPaused = not $ isPaused g}),
   109         return [ModifyRoom (modifyGameInfo $ \g -> g{isPaused = not $ isPaused g}),
   110                 AnswerClients chans ["CHAT", "[server]", "Pause toggled"],
   110                 AnswerClients chans ["CHAT", "[server]", loc "Pause toggled"],
   111                 AnswerClients chans ["EM", toEngineMsg "I"]]
   111                 AnswerClients chans ["EM", toEngineMsg "I"]]
       
   112     act (VoteNewSeed) =
       
   113         return [SetRandomSeed]
       
   114     act (VoteHedgehogsPerTeam h) = do
       
   115         rm <- thisRoom
       
   116         chans <- roomClientsChans
       
   117         let answers = concatMap (\t -> 
       
   118                 [ModifyRoom $ modifyTeam t{hhnum = h}
       
   119                 , AnswerClients chans ["HHNUM", teamname t, showB h]]
       
   120                 )
       
   121                 $
       
   122                 if isJust $ gameInfo rm then
       
   123                     teamsAtStart . fromJust . gameInfo $ rm 
       
   124                 else
       
   125                     teams rm
       
   126 
       
   127         return $ ModifyRoom (\r -> r{defaultHedgehogsNumber = h}) : answers
   112 
   128 
   113 
   129 
   114 startVote :: VoteType -> Reader (ClientIndex, IRnC) [Action]
   130 startVote :: VoteType -> Reader (ClientIndex, IRnC) [Action]
   115 startVote vt = do
   131 startVote vt = do
   116     (ci, rnc) <- ask
   132     (ci, rnc) <- ask
   152 
   168 
   153 voteInfo :: VoteType -> B.ByteString
   169 voteInfo :: VoteType -> B.ByteString
   154 voteInfo (VoteKick n) = B.concat [loc "kick", " ", n]
   170 voteInfo (VoteKick n) = B.concat [loc "kick", " ", n]
   155 voteInfo (VoteMap n) = B.concat [loc "map", " ", n]
   171 voteInfo (VoteMap n) = B.concat [loc "map", " ", n]
   156 voteInfo (VotePause) = B.concat [loc "pause"]
   172 voteInfo (VotePause) = B.concat [loc "pause"]
       
   173 voteInfo (VoteNewSeed) = B.concat [loc "new seed"]
       
   174 voteInfo (VoteHedgehogsPerTeam i) = B.concat [loc "number of hedgehogs in team", " ", showB i]