41 rm <- thisRoom |
41 rm <- thisRoom |
42 uid <- liftM clUID thisClient |
42 uid <- liftM clUID thisClient |
43 |
43 |
44 case voting rm of |
44 case voting rm of |
45 Nothing -> |
45 Nothing -> |
46 return [AnswerClients [sendChan cl] ["CHAT", "[server]", loc "There's no voting going on."]] |
46 return [AnswerClients [sendChan cl] ["CHAT", nickServer, loc "There's no voting going on."]] |
47 Just voting -> |
47 Just voting -> |
48 if (not forced) && (uid `L.notElem` entitledToVote voting) then |
48 if (not forced) && (uid `L.notElem` entitledToVote voting) then |
49 return [] |
49 return [] |
50 else if (not forced) && (uid `L.elem` map fst (votes voting)) then |
50 else if (not forced) && (uid `L.elem` map fst (votes voting)) then |
51 return [AnswerClients [sendChan cl] ["CHAT", "[server]", loc "You already have voted."]] |
51 return [AnswerClients [sendChan cl] ["CHAT", nickServer, loc "You already have voted."]] |
52 else if forced && (not $ isAdministrator cl) then |
52 else if forced && (not $ isAdministrator cl) then |
53 return [] |
53 return [] |
54 else |
54 else |
55 ((:) (AnswerClients [sendChan cl] ["CHAT", "[server]", loc "Your vote has been counted."])) |
55 ((:) (AnswerClients [sendChan cl] ["CHAT", nickServer, loc "Your vote has been counted."])) |
56 <$> (actOnVoting $ voting{votes = (uid, vote):votes voting}) |
56 <$> (actOnVoting $ voting{votes = (uid, vote):votes voting}) |
57 |
57 |
58 where |
58 where |
59 actOnVoting :: Voting -> Reader (ClientIndex, IRnC) [Action] |
59 actOnVoting :: Voting -> Reader (ClientIndex, IRnC) [Action] |
60 actOnVoting vt = do |
60 actOnVoting vt = do |
72 return [ModifyRoom $ \r -> r{voting = Just vt}] |
72 return [ModifyRoom $ \r -> r{voting = Just vt}] |
73 |
73 |
74 closeVoting = do |
74 closeVoting = do |
75 chans <- roomClientsChans |
75 chans <- roomClientsChans |
76 return [ |
76 return [ |
77 AnswerClients chans ["CHAT", "[server]", loc "Voting closed."] |
77 AnswerClients chans ["CHAT", nickServer, loc "Voting closed."] |
78 , ModifyRoom (\r -> r{voting = Nothing}) |
78 , ModifyRoom (\r -> r{voting = Nothing}) |
79 ] |
79 ] |
80 |
80 |
81 act (VoteKick nickname) = do |
81 act (VoteKick nickname) = do |
82 (thisClientId, rnc) <- ask |
82 (thisClientId, rnc) <- ask |
99 Just (location, mp, p) -> do |
99 Just (location, mp, p) -> do |
100 cl <- thisClient |
100 cl <- thisClient |
101 chans <- roomClientsChans |
101 chans <- roomClientsChans |
102 return $ |
102 return $ |
103 [ModifyRoom $ \r -> r{params = p, mapParams = mp} |
103 [ModifyRoom $ \r -> r{params = p, mapParams = mp} |
104 , AnswerClients chans ["CHAT", "[server]", location] |
104 , AnswerClients chans ["CHAT", nickServer, location] |
105 , SendUpdateOnThisRoom |
105 , SendUpdateOnThisRoom |
106 , LoadGhost location] |
106 , LoadGhost location] |
107 act (VotePause) = do |
107 act (VotePause) = do |
108 rm <- thisRoom |
108 rm <- thisRoom |
109 chans <- roomClientsChans |
109 chans <- roomClientsChans |
110 let modifyGameInfo f room = room{gameInfo = fmap f $ gameInfo room} |
110 let modifyGameInfo f room = room{gameInfo = fmap f $ gameInfo room} |
111 return [ModifyRoom (modifyGameInfo $ \g -> g{isPaused = not $ isPaused g}), |
111 return [ModifyRoom (modifyGameInfo $ \g -> g{isPaused = not $ isPaused g}), |
112 AnswerClients chans ["CHAT", "[server]", loc "Pause toggled."], |
112 AnswerClients chans ["CHAT", nickServer, loc "Pause toggled."], |
113 AnswerClients chans ["EM", toEngineMsg "I"]] |
113 AnswerClients chans ["EM", toEngineMsg "I"]] |
114 act (VoteNewSeed) = |
114 act (VoteNewSeed) = |
115 return [SetRandomSeed] |
115 return [SetRandomSeed] |
116 act (VoteHedgehogsPerTeam h) = do |
116 act (VoteHedgehogsPerTeam h) = do |
117 rm <- thisRoom |
117 rm <- thisRoom |
142 if isJust $ voting rm then |
142 if isJust $ voting rm then |
143 return [] |
143 return [] |
144 else |
144 else |
145 return [ |
145 return [ |
146 ModifyRoom (\r -> r{voting = Just (newVoting vt){entitledToVote = uids}}) |
146 ModifyRoom (\r -> r{voting = Just (newVoting vt){entitledToVote = uids}}) |
147 , AnswerClients chans ["CHAT", "[server]", B.concat [loc "New voting started", ": ", voteInfo vt]] |
147 , AnswerClients chans ["CHAT", nickServer, B.concat [loc "New voting started", ": ", voteInfo vt]] |
148 , ReactCmd ["VOTE", "YES"] |
148 , ReactCmd ["VOTE", "YES"] |
149 ] |
149 ] |
150 |
150 |
151 |
151 |
152 checkVotes :: StateT ServerState IO [Action] |
152 checkVotes :: StateT ServerState IO [Action] |
161 case e of |
161 case e of |
162 Just rv -> do |
162 Just rv -> do |
163 modifyRoom rnc (\r -> r{voting = if voteTTL rv == 0 then Nothing else Just rv{voteTTL = voteTTL rv - 1}}) ri |
163 modifyRoom rnc (\r -> r{voting = if voteTTL rv == 0 then Nothing else Just rv{voteTTL = voteTTL rv - 1}}) ri |
164 if voteTTL rv == 0 then do |
164 if voteTTL rv == 0 then do |
165 chans <- liftM (map sendChan) $ roomClientsM rnc ri |
165 chans <- liftM (map sendChan) $ roomClientsM rnc ri |
166 return [AnswerClients chans ["CHAT", "[server]", loc "Voting expired."]] |
166 return [AnswerClients chans ["CHAT", nickServer, loc "Voting expired."]] |
167 else |
167 else |
168 return [] |
168 return [] |
169 Nothing -> return [] |
169 Nothing -> return [] |
170 |
170 |
171 |
171 |