# HG changeset patch
# User unc0rr
# Date 1421181427 -10800
# Node ID 712283ed86e0e7a6548a27908f1ffb5362833686
# Parent  c5dd41e77a12c20cf57b33d39323229436c6c99e
Implement /newseed and /hedgehogs commands. Only tested for building.

diff -r c5dd41e77a12 -r 712283ed86e0 gameServer/Actions.hs
--- 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
diff -r c5dd41e77a12 -r 712283ed86e0 gameServer/CoreTypes.hs
--- 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
diff -r c5dd41e77a12 -r 712283ed86e0 gameServer/HWProtoInRoomState.hs
--- 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
diff -r c5dd41e77a12 -r 712283ed86e0 gameServer/Votes.hs
--- 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]