10 import Data.Maybe |
10 import Data.Maybe |
11 ------------------- |
11 ------------------- |
12 import Utils |
12 import Utils |
13 import CoreTypes |
13 import CoreTypes |
14 import HandlerUtils |
14 import HandlerUtils |
|
15 import EngineInteraction |
15 |
16 |
16 |
17 |
17 voted :: Bool -> Reader (ClientIndex, IRnC) [Action] |
18 voted :: Bool -> Reader (ClientIndex, IRnC) [Action] |
18 voted vote = do |
19 voted vote = do |
19 cl <- thisClient |
20 cl <- thisClient |
20 rm <- thisRoom |
21 rm <- thisRoom |
21 uid <- liftM clUID thisClient |
22 uid <- liftM clUID thisClient |
22 |
23 |
23 if isNothing $ voting rm then |
24 case voting rm of |
24 return [AnswerClients [sendChan cl] ["CHAT", "[server]", loc "There's no voting going on"]] |
25 Nothing -> |
25 else if uid `L.notElem` entitledToVote (fromJust $ voting rm) then |
26 return [AnswerClients [sendChan cl] ["CHAT", "[server]", loc "There's no voting going on"]] |
26 return [] |
27 Just voting -> |
27 else if uid `L.elem` map fst (votes . fromJust $ voting rm) then |
28 if uid `L.notElem` entitledToVote voting then |
28 return [AnswerClients [sendChan cl] ["CHAT", "[server]", loc "You already have voted"]] |
29 return [] |
29 else |
30 else if uid `L.elem` map fst (votes voting) then |
30 actOnVoting . fromJust . liftM (\v -> v{votes = (uid, vote):votes v}) $ voting rm |
31 return [AnswerClients [sendChan cl] ["CHAT", "[server]", loc "You already have voted"]] |
|
32 else |
|
33 actOnVoting $ voting{votes = (uid, vote):votes voting} |
|
34 |
31 where |
35 where |
32 actOnVoting :: Voting -> Reader (ClientIndex, IRnC) [Action] |
36 actOnVoting :: Voting -> Reader (ClientIndex, IRnC) [Action] |
33 actOnVoting vt = do |
37 actOnVoting vt = do |
34 let (pro, contra) = L.partition snd $ votes vt |
38 let (pro, contra) = L.partition snd $ votes vt |
35 let v = (length $ entitledToVote vt) `div` 2 + 1 |
39 let totalV = length $ entitledToVote vt |
|
40 let successV = totalV `div` 2 + 1 |
36 |
41 |
37 if length contra >= v then |
42 if length contra > totalV - successV then |
38 closeVoting |
43 closeVoting |
39 else if length pro >= v then do |
44 else if length pro >= successV then do |
40 a <- act $ voteType vt |
45 a <- act $ voteType vt |
41 c <- closeVoting |
46 c <- closeVoting |
42 return $ c ++ a |
47 return $ c ++ a |
43 else |
48 else |
44 return [ModifyRoom $ \r -> r{voting = Just vt}] |
49 return [ModifyRoom $ \r -> r{voting = Just vt}] |
77 : SendUpdateOnThisRoom |
82 : SendUpdateOnThisRoom |
78 : a |
83 : a |
79 where |
84 where |
80 replaceChans chans (AnswerClients _ msg) = AnswerClients chans msg |
85 replaceChans chans (AnswerClients _ msg) = AnswerClients chans msg |
81 replaceChans _ a = a |
86 replaceChans _ a = a |
|
87 act (VotePause) = do |
|
88 rm <- thisRoom |
|
89 chans <- roomClientsChans |
|
90 let modifyGameInfo f room = room{gameInfo = fmap f $ gameInfo room} |
|
91 return [ModifyRoom (modifyGameInfo $ \g -> g{isPaused = not $ isPaused g}), |
|
92 AnswerClients chans ["CHAT", "[server]", "Pause toggled"], |
|
93 AnswerClients chans ["EM", toEngineMsg "I"]] |
82 |
94 |
83 |
95 |
84 startVote :: VoteType -> Reader (ClientIndex, IRnC) [Action] |
96 startVote :: VoteType -> Reader (ClientIndex, IRnC) [Action] |
85 startVote vt = do |
97 startVote vt = do |
86 (ci, rnc) <- ask |
98 (ci, rnc) <- ask |
121 |
133 |
122 |
134 |
123 voteInfo :: VoteType -> B.ByteString |
135 voteInfo :: VoteType -> B.ByteString |
124 voteInfo (VoteKick n) = B.concat [loc "kick", " ", n] |
136 voteInfo (VoteKick n) = B.concat [loc "kick", " ", n] |
125 voteInfo (VoteMap n) = B.concat [loc "map", " ", n] |
137 voteInfo (VoteMap n) = B.concat [loc "map", " ", n] |
|
138 voteInfo (VotePause) = B.concat [loc "pause"] |