equal
deleted
inserted
replaced
29 else |
29 else |
30 actOnVoting . fromJust . 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 |
31 where |
32 actOnVoting :: Voting -> Reader (ClientIndex, IRnC) [Action] |
32 actOnVoting :: Voting -> Reader (ClientIndex, IRnC) [Action] |
33 actOnVoting vt = do |
33 actOnVoting vt = do |
34 let (contra, pro) = L.partition snd $ votes vt |
34 let (pro, contra) = L.partition snd $ votes vt |
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 |
65 act (VoteMap roomSave) = do |
65 act (VoteMap roomSave) = do |
66 rm <- thisRoom |
66 rm <- thisRoom |
67 let rs = Map.lookup roomSave (roomSaves rm) |
67 let rs = Map.lookup roomSave (roomSaves rm) |
68 case rs of |
68 case rs of |
69 Nothing -> return [] |
69 Nothing -> return [] |
70 Just (mp, p) -> return [ModifyRoom $ \r -> r{params = p, mapParams = mp}] |
70 Just (mp, p) -> return [Warning "ye!", ModifyRoom $ \r -> r{params = p, mapParams = mp}] |
71 |
71 |
72 |
72 |
73 startVote :: VoteType -> Reader (ClientIndex, IRnC) [Action] |
73 startVote :: VoteType -> Reader (ClientIndex, IRnC) [Action] |
74 startVote vt = do |
74 startVote vt = do |
75 (ci, rnc) <- ask |
75 (ci, rnc) <- ask |
80 let uids = map (clUID . client rnc) . roomClients rnc $ clientRoom rnc ci |
80 let uids = map (clUID . client rnc) . roomClients rnc $ clientRoom rnc ci |
81 |
81 |
82 if isJust $ voting rm then |
82 if isJust $ voting rm then |
83 return [] |
83 return [] |
84 else |
84 else |
85 liftM ([ModifyRoom (\r -> r{voting = Just (newVoting vt){entitledToVote = uids}}) |
85 return [ |
86 , AnswerClients chans ["CHAT", "[server]", B.concat [loc "New voting started", ": ", voteInfo vt]] |
86 ModifyRoom (\r -> r{voting = Just (newVoting vt){entitledToVote = uids}}) |
87 ] ++ ) $ voted True |
87 , AnswerClients chans ["CHAT", "[server]", B.concat [loc "New voting started", ": ", voteInfo vt]] |
|
88 , ReactCmd ["VOTE", "YES"] |
|
89 ] |
88 |
90 |
89 |
91 |
90 checkVotes :: StateT ServerState IO () |
92 checkVotes :: StateT ServerState IO () |
91 checkVotes = undefined |
93 checkVotes = undefined |
92 |
94 |