Implement /newseed and /hedgehogs commands. Only tested for building.
--- a/gameServer/Actions.hs Mon Jan 12 08:20:20 2015 -0500
+++ b/gameServer/Actions.hs Tue Jan 13 23:37:07 2015 +0300
@@ -425,6 +425,15 @@
mapM_ processAction removeTeamActions
+processAction SetRandomSeed = do
+ ri <- clientRoomA
+ thisRoomChans <- liftM (map sendChan) $ roomClientsS ri
+ seed <- liftM showB $ io $ (randomRIO (0, 10^9) :: IO Int)
+ mapM_ processAction [
+ ModifyRoom (\r -> r{mapParams = Map.insert "SEED" seed $ mapParams r})
+ , AnswerClients thisRoomChans ["CFG", "SEED", seed]
+ ]
+
processAction CheckRegistered = do
(Just ci) <- gets clientIndex
--- a/gameServer/CoreTypes.hs Mon Jan 12 08:20:20 2015 -0500
+++ b/gameServer/CoreTypes.hs Tue Jan 13 23:37:07 2015 +0300
@@ -101,6 +101,7 @@
| LoadRoom B.ByteString
| ReactCmd [B.ByteString]
| CheckVotes
+ | SetRandomSeed
data Event = LobbyChatMessage
@@ -110,7 +111,7 @@
type EventsInfo = [(Int, UTCTime)]
newEventsInfo :: EventsInfo
-newEventsInfo = []
+newEventsInfo = []
type ClientChan = Chan [B.ByteString]
@@ -222,6 +223,7 @@
isRestrictedTeams :: Bool,
isRegisteredOnly :: Bool,
isSpecial :: Bool,
+ defaultHedgehogsNumber :: Int,
greeting :: B.ByteString,
voting :: Maybe Voting,
roomBansList :: ![B.ByteString],
@@ -245,6 +247,7 @@
False
False
False
+ 4
""
Nothing
[]
@@ -319,6 +322,8 @@
data VoteType = VoteKick B.ByteString
| VoteMap B.ByteString
| VotePause
+ | VoteNewSeed
+ | VoteHedgehogsPerTeam Int
newVoting :: VoteType -> Voting
--- a/gameServer/HWProtoInRoomState.hs Mon Jan 12 08:20:20 2015 -0500
+++ b/gameServer/HWProtoInRoomState.hs Tue Jan 13 23:37:07 2015 +0300
@@ -105,14 +105,12 @@
handleCmd_inRoom ("ADD_TEAM" : tName : color : grave : fort : voicepack : flag : difStr : hhsInfo)
| length hhsInfo /= 16 = return [ProtocolError $ loc "Corrupted hedgehogs info"]
| otherwise = do
- (ci, _) <- ask
rm <- thisRoom
cl <- thisClient
clNick <- clientNick
clChan <- thisClientChans
othChans <- roomOthersChans
roomChans <- roomClientsChans
- cl <- thisClient
let isRegistered = (<) 0 . B.length . webPassword $ cl
teamColor <-
if clientProto cl < 42 then
@@ -120,7 +118,11 @@
else
liftM (head . (L.\\) (map B.singleton ['0'..]) . map teamcolor . teams) thisRoom
let roomTeams = teams rm
- let hhNum = let p = if not $ null roomTeams then minimum [hhnum $ head roomTeams, canAddNumber roomTeams] else 4 in newTeamHHNum roomTeams p
+ let hhNum = newTeamHHNum roomTeams $
+ if not $ null roomTeams then
+ minimum [hhnum $ head roomTeams, canAddNumber roomTeams]
+ else
+ defaultHedgehogsNumber rm
let newTeam = clNick `seq` TeamInfo clNick tName teamColor grave fort voicepack flag isRegistered dif hhNum (hhsList hhsInfo)
return $
if not . null . drop (maxTeams rm - 1) $ roomTeams then
@@ -401,11 +403,13 @@
handleCmd_inRoom ["CALLVOTE"] = do
cl <- thisClient
- return [AnswerClients [sendChan cl] ["CHAT", "[server]", "Available callvote commands: kick <nickname>, map <name>, pause"]]
+ return [AnswerClients [sendChan cl]
+ ["CHAT", "[server]", loc "Available callvote commands: kick <nickname>, map <name>, pause, newseed, hedgehogs"]
+ ]
handleCmd_inRoom ["CALLVOTE", "KICK"] = do
cl <- thisClient
- return [AnswerClients [sendChan cl] ["CHAT", "[server]", "callvote kick: specify nickname"]]
+ return [AnswerClients [sendChan cl] ["CHAT", "[server]", loc "callvote kick: specify nickname"]]
handleCmd_inRoom ["CALLVOTE", "KICK", nickname] = do
(thisClientId, rnc) <- ask
@@ -421,7 +425,7 @@
if isJust maybeClientId && sameRoom then
startVote $ VoteKick nickname
else
- return [AnswerClients [sendChan cl] ["CHAT", "[server]", "callvote kick: no such user"]]
+ return [AnswerClients [sendChan cl] ["CHAT", "[server]", loc "callvote kick: no such user"]]
handleCmd_inRoom ["CALLVOTE", "MAP"] = do
@@ -437,16 +441,37 @@
if Map.member roomSave $ roomSaves rm then
startVote $ VoteMap roomSave
else
- return [AnswerClients [sendChan cl] ["CHAT", "[server]", "callvote map: no such map"]]
+ return [AnswerClients [sendChan cl] ["CHAT", "[server]", loc "callvote map: no such map"]]
+
handleCmd_inRoom ["CALLVOTE", "PAUSE"] = do
cl <- thisClient
rm <- thisRoom
if isJust $ gameInfo rm then
- startVote VotePause
+ startVote VotePause
else
- return [AnswerClients [sendChan cl] ["CHAT", "[server]", "callvote pause: no game in progress"]]
+ return [AnswerClients [sendChan cl] ["CHAT", "[server]", loc "callvote pause: no game in progress"]]
+
+
+handleCmd_inRoom ["CALLVOTE", "NEWSEED"] = do
+ startVote VoteNewSeed
+
+
+handleCmd_inRoom ["CALLVOTE", "HEDGEHOGS"] = do
+ cl <- thisClient
+ return [AnswerClients [sendChan cl] ["CHAT", "[server]", loc "callvote hedgehogs: specify number from 1 to 8"]]
+
+
+handleCmd_inRoom ["CALLVOTE", "HEDGEHOGS", hhs] = do
+ cl <- thisClient
+ let h = readInt_ hhs
+
+ if h > 0 && h <= 8 then
+ startVote $ VoteHedgehogsPerTeam h
+ else
+ return [AnswerClients [sendChan cl] ["CHAT", "[server]", loc "callvote hedgehogs: specify number from 1 to 8"]]
+
handleCmd_inRoom ["VOTE", m] = do
cl <- thisClient
--- a/gameServer/Votes.hs Mon Jan 12 08:20:20 2015 -0500
+++ b/gameServer/Votes.hs Tue Jan 13 23:37:07 2015 +0300
@@ -49,7 +49,7 @@
return [AnswerClients [sendChan cl] ["CHAT", "[server]", loc "You already have voted"]]
else
actOnVoting $ voting{votes = (uid, vote):votes voting}
-
+
where
actOnVoting :: Voting -> Reader (ClientIndex, IRnC) [Action]
actOnVoting vt = do
@@ -107,8 +107,24 @@
chans <- roomClientsChans
let modifyGameInfo f room = room{gameInfo = fmap f $ gameInfo room}
return [ModifyRoom (modifyGameInfo $ \g -> g{isPaused = not $ isPaused g}),
- AnswerClients chans ["CHAT", "[server]", "Pause toggled"],
+ AnswerClients chans ["CHAT", "[server]", loc "Pause toggled"],
AnswerClients chans ["EM", toEngineMsg "I"]]
+ act (VoteNewSeed) =
+ return [SetRandomSeed]
+ act (VoteHedgehogsPerTeam h) = do
+ rm <- thisRoom
+ chans <- roomClientsChans
+ let answers = concatMap (\t ->
+ [ModifyRoom $ modifyTeam t{hhnum = h}
+ , AnswerClients chans ["HHNUM", teamname t, showB h]]
+ )
+ $
+ if isJust $ gameInfo rm then
+ teamsAtStart . fromJust . gameInfo $ rm
+ else
+ teams rm
+
+ return $ ModifyRoom (\r -> r{defaultHedgehogsNumber = h}) : answers
startVote :: VoteType -> Reader (ClientIndex, IRnC) [Action]
@@ -154,3 +170,5 @@
voteInfo (VoteKick n) = B.concat [loc "kick", " ", n]
voteInfo (VoteMap n) = B.concat [loc "map", " ", n]
voteInfo (VotePause) = B.concat [loc "pause"]
+voteInfo (VoteNewSeed) = B.concat [loc "new seed"]
+voteInfo (VoteHedgehogsPerTeam i) = B.concat [loc "number of hedgehogs in team", " ", showB i]