40 rm <- thisRoom |
41 rm <- thisRoom |
41 uid <- liftM clUID thisClient |
42 uid <- liftM clUID thisClient |
42 |
43 |
43 case voting rm of |
44 case voting rm of |
44 Nothing -> |
45 Nothing -> |
45 return [AnswerClients [sendChan cl] ["CHAT", "[server]", loc "There's no voting going on."]] |
46 return [Warning $ loc "There's no voting going on."] |
46 Just voting -> |
47 Just voting -> |
47 if (not forced) && (uid `L.notElem` entitledToVote voting) then |
48 if (not forced) && (uid `L.notElem` entitledToVote voting) then |
48 return [] |
49 return [] |
49 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 |
50 return [AnswerClients [sendChan cl] ["CHAT", "[server]", loc "You already have voted."]] |
51 return [Warning $ loc "You already have voted."] |
51 else if forced && (not $ isAdministrator cl) then |
52 else if forced && (not $ isAdministrator cl) then |
52 return [] |
53 return [] |
53 else |
54 else |
54 ((:) (AnswerClients [sendChan cl] ["CHAT", "[server]", loc "Your vote has been counted."])) |
55 ((:) (AnswerClients [sendChan cl] ["CHAT", nickServer, loc "Your vote has been counted."])) |
55 <$> (actOnVoting $ voting{votes = (uid, vote):votes voting}) |
56 <$> (actOnVoting $ voting{votes = (uid, vote):votes voting}) |
56 |
57 |
57 where |
58 where |
58 actOnVoting :: Voting -> Reader (ClientIndex, IRnC) [Action] |
59 actOnVoting :: Voting -> Reader (ClientIndex, IRnC) [Action] |
59 actOnVoting vt = do |
60 actOnVoting vt = do |
71 return [ModifyRoom $ \r -> r{voting = Just vt}] |
72 return [ModifyRoom $ \r -> r{voting = Just vt}] |
72 |
73 |
73 closeVoting = do |
74 closeVoting = do |
74 chans <- roomClientsChans |
75 chans <- roomClientsChans |
75 return [ |
76 return [ |
76 AnswerClients chans ["CHAT", "[server]", loc "Voting closed."] |
77 AnswerClients chans ["CHAT", nickServer, loc "Voting closed."] |
77 , ModifyRoom (\r -> r{voting = Nothing}) |
78 , ModifyRoom (\r -> r{voting = Nothing}) |
78 ] |
79 ] |
79 |
80 |
80 act (VoteKick nickname) = do |
81 act (VoteKick nickname) = do |
81 (thisClientId, rnc) <- ask |
82 (thisClientId, rnc) <- ask |
98 Just (location, mp, p) -> do |
99 Just (location, mp, p) -> do |
99 cl <- thisClient |
100 cl <- thisClient |
100 chans <- roomClientsChans |
101 chans <- roomClientsChans |
101 return $ |
102 return $ |
102 [ModifyRoom $ \r -> r{params = p, mapParams = mp} |
103 [ModifyRoom $ \r -> r{params = p, mapParams = mp} |
103 , AnswerClients chans ["CHAT", "[server]", location] |
104 , AnswerClients chans ["CHAT", nickServer, location] |
104 , SendUpdateOnThisRoom |
105 , SendUpdateOnThisRoom |
105 , LoadGhost location] |
106 , LoadGhost location] |
106 act (VotePause) = do |
107 act (VotePause) = do |
107 rm <- thisRoom |
108 rm <- thisRoom |
108 chans <- roomClientsChans |
109 chans <- roomClientsChans |
109 let modifyGameInfo f room = room{gameInfo = fmap f $ gameInfo room} |
110 let modifyGameInfo f room = room{gameInfo = fmap f $ gameInfo room} |
110 return [ModifyRoom (modifyGameInfo $ \g -> g{isPaused = not $ isPaused g}), |
111 return [ModifyRoom (modifyGameInfo $ \g -> g{isPaused = not $ isPaused g}), |
111 AnswerClients chans ["CHAT", "[server]", loc "Pause toggled."], |
112 AnswerClients chans ["CHAT", nickServer, loc "Pause toggled."], |
112 AnswerClients chans ["EM", toEngineMsg "I"]] |
113 AnswerClients chans ["EM", toEngineMsg "I"]] |
113 act (VoteNewSeed) = |
114 act (VoteNewSeed) = |
114 return [SetRandomSeed] |
115 return [SetRandomSeed] |
115 act (VoteHedgehogsPerTeam h) = do |
116 act (VoteHedgehogsPerTeam h) = do |
116 rm <- thisRoom |
117 rm <- thisRoom |
117 chans <- roomClientsChans |
118 chans <- roomClientsChans |
118 let answers = concatMap (\t -> |
119 let answers = concatMap (\t -> |
119 [ModifyRoom $ modifyTeam t{hhnum = h} |
120 [ModifyRoom $ modifyTeam t{hhnum = h} |
120 , AnswerClients chans ["HH_NUM", teamname t, showB h]] |
121 , AnswerClients chans ["HH_NUM", teamname t, showB h]] |
121 ) $ if length curteams * h > 48 then [] else curteams |
122 ) $ if length curteams * h > cMaxHHs then [] else curteams |
122 ; |
123 ; |
123 curteams = |
124 curteams = |
124 if isJust $ gameInfo rm then |
125 if isJust $ gameInfo rm then |
125 teamsAtStart . fromJust . gameInfo $ rm |
126 teamsAtStart . fromJust . gameInfo $ rm |
126 else |
127 else |
141 if isJust $ voting rm then |
142 if isJust $ voting rm then |
142 return [] |
143 return [] |
143 else |
144 else |
144 return [ |
145 return [ |
145 ModifyRoom (\r -> r{voting = Just (newVoting vt){entitledToVote = uids}}) |
146 ModifyRoom (\r -> r{voting = Just (newVoting vt){entitledToVote = uids}}) |
146 , 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]] |
147 , ReactCmd ["VOTE", "YES"] |
148 , ReactCmd ["VOTE", "YES"] |
148 ] |
149 ] |
149 |
150 |
150 |
151 |
151 checkVotes :: StateT ServerState IO [Action] |
152 checkVotes :: StateT ServerState IO [Action] |