gameServer/HWProtoInRoomState.hs
changeset 10786 712283ed86e0
parent 10732 7c4f9e5e447c
child 10881 941b5ab9e5a6
equal deleted inserted replaced
10785:c5dd41e77a12 10786:712283ed86e0
   103 
   103 
   104 
   104 
   105 handleCmd_inRoom ("ADD_TEAM" : tName : color : grave : fort : voicepack : flag : difStr : hhsInfo)
   105 handleCmd_inRoom ("ADD_TEAM" : tName : color : grave : fort : voicepack : flag : difStr : hhsInfo)
   106     | length hhsInfo /= 16 = return [ProtocolError $ loc "Corrupted hedgehogs info"]
   106     | length hhsInfo /= 16 = return [ProtocolError $ loc "Corrupted hedgehogs info"]
   107     | otherwise = do
   107     | otherwise = do
   108         (ci, _) <- ask
       
   109         rm <- thisRoom
   108         rm <- thisRoom
   110         cl <- thisClient
   109         cl <- thisClient
   111         clNick <- clientNick
   110         clNick <- clientNick
   112         clChan <- thisClientChans
   111         clChan <- thisClientChans
   113         othChans <- roomOthersChans
   112         othChans <- roomOthersChans
   114         roomChans <- roomClientsChans
   113         roomChans <- roomClientsChans
   115         cl <- thisClient
       
   116         let isRegistered = (<) 0 . B.length . webPassword $ cl
   114         let isRegistered = (<) 0 . B.length . webPassword $ cl
   117         teamColor <-
   115         teamColor <-
   118             if clientProto cl < 42 then
   116             if clientProto cl < 42 then
   119                 return color
   117                 return color
   120                 else
   118                 else
   121                 liftM (head . (L.\\) (map B.singleton ['0'..]) . map teamcolor . teams) thisRoom
   119                 liftM (head . (L.\\) (map B.singleton ['0'..]) . map teamcolor . teams) thisRoom
   122         let roomTeams = teams rm
   120         let roomTeams = teams rm
   123         let hhNum = let p = if not $ null roomTeams then minimum [hhnum $ head roomTeams, canAddNumber roomTeams] else 4 in newTeamHHNum roomTeams p
   121         let hhNum = newTeamHHNum roomTeams $
       
   122                 if not $ null roomTeams then
       
   123                     minimum [hhnum $ head roomTeams, canAddNumber roomTeams]
       
   124                 else
       
   125                     defaultHedgehogsNumber rm
   124         let newTeam = clNick `seq` TeamInfo clNick tName teamColor grave fort voicepack flag isRegistered dif hhNum (hhsList hhsInfo)
   126         let newTeam = clNick `seq` TeamInfo clNick tName teamColor grave fort voicepack flag isRegistered dif hhNum (hhsList hhsInfo)
   125         return $
   127         return $
   126             if not . null . drop (maxTeams rm - 1) $ roomTeams then
   128             if not . null . drop (maxTeams rm - 1) $ roomTeams then
   127                 [Warning $ loc "too many teams"]
   129                 [Warning $ loc "too many teams"]
   128             else if canAddNumber roomTeams <= 0 then
   130             else if canAddNumber roomTeams <= 0 then
   399     return [ModifyRoom (\r -> r{greeting = msg}) | isAdministrator cl || (isMaster cl && (not $ isSpecial rm))]
   401     return [ModifyRoom (\r -> r{greeting = msg}) | isAdministrator cl || (isMaster cl && (not $ isSpecial rm))]
   400 
   402 
   401 
   403 
   402 handleCmd_inRoom ["CALLVOTE"] = do
   404 handleCmd_inRoom ["CALLVOTE"] = do
   403     cl <- thisClient
   405     cl <- thisClient
   404     return [AnswerClients [sendChan cl] ["CHAT", "[server]", "Available callvote commands: kick <nickname>, map <name>, pause"]]
   406     return [AnswerClients [sendChan cl]
       
   407         ["CHAT", "[server]", loc "Available callvote commands: kick <nickname>, map <name>, pause, newseed, hedgehogs"]
       
   408         ]
   405 
   409 
   406 handleCmd_inRoom ["CALLVOTE", "KICK"] = do
   410 handleCmd_inRoom ["CALLVOTE", "KICK"] = do
   407     cl <- thisClient
   411     cl <- thisClient
   408     return [AnswerClients [sendChan cl] ["CHAT", "[server]", "callvote kick: specify nickname"]]
   412     return [AnswerClients [sendChan cl] ["CHAT", "[server]", loc "callvote kick: specify nickname"]]
   409 
   413 
   410 handleCmd_inRoom ["CALLVOTE", "KICK", nickname] = do
   414 handleCmd_inRoom ["CALLVOTE", "KICK", nickname] = do
   411     (thisClientId, rnc) <- ask
   415     (thisClientId, rnc) <- ask
   412     cl <- thisClient
   416     cl <- thisClient
   413     rm <- thisRoom
   417     rm <- thisRoom
   419         return []
   423         return []
   420         else
   424         else
   421         if isJust maybeClientId && sameRoom then
   425         if isJust maybeClientId && sameRoom then
   422             startVote $ VoteKick nickname
   426             startVote $ VoteKick nickname
   423             else
   427             else
   424             return [AnswerClients [sendChan cl] ["CHAT", "[server]", "callvote kick: no such user"]]
   428             return [AnswerClients [sendChan cl] ["CHAT", "[server]", loc "callvote kick: no such user"]]
   425 
   429 
   426 
   430 
   427 handleCmd_inRoom ["CALLVOTE", "MAP"] = do
   431 handleCmd_inRoom ["CALLVOTE", "MAP"] = do
   428     cl <- thisClient
   432     cl <- thisClient
   429     s <- liftM (Map.keys . roomSaves) thisRoom
   433     s <- liftM (Map.keys . roomSaves) thisRoom
   435     rm <- thisRoom
   439     rm <- thisRoom
   436 
   440 
   437     if Map.member roomSave $ roomSaves rm then
   441     if Map.member roomSave $ roomSaves rm then
   438         startVote $ VoteMap roomSave
   442         startVote $ VoteMap roomSave
   439         else
   443         else
   440         return [AnswerClients [sendChan cl] ["CHAT", "[server]", "callvote map: no such map"]]
   444         return [AnswerClients [sendChan cl] ["CHAT", "[server]", loc "callvote map: no such map"]]
       
   445 
   441 
   446 
   442 handleCmd_inRoom ["CALLVOTE", "PAUSE"] = do
   447 handleCmd_inRoom ["CALLVOTE", "PAUSE"] = do
   443     cl <- thisClient
   448     cl <- thisClient
   444     rm <- thisRoom
   449     rm <- thisRoom
   445 
   450 
   446     if isJust $ gameInfo rm then
   451     if isJust $ gameInfo rm then
   447         startVote VotePause    
   452         startVote VotePause
   448         else 
   453         else 
   449         return [AnswerClients [sendChan cl] ["CHAT", "[server]", "callvote pause: no game in progress"]]
   454         return [AnswerClients [sendChan cl] ["CHAT", "[server]", loc "callvote pause: no game in progress"]]
       
   455 
       
   456 
       
   457 handleCmd_inRoom ["CALLVOTE", "NEWSEED"] = do
       
   458     startVote VoteNewSeed
       
   459 
       
   460 
       
   461 handleCmd_inRoom ["CALLVOTE", "HEDGEHOGS"] = do
       
   462     cl <- thisClient
       
   463     return [AnswerClients [sendChan cl] ["CHAT", "[server]", loc "callvote hedgehogs: specify number from 1 to 8"]]
       
   464 
       
   465 
       
   466 handleCmd_inRoom ["CALLVOTE", "HEDGEHOGS", hhs] = do
       
   467     cl <- thisClient
       
   468     let h = readInt_ hhs
       
   469 
       
   470     if h > 0 && h <= 8 then
       
   471         startVote $ VoteHedgehogsPerTeam h
       
   472         else
       
   473         return [AnswerClients [sendChan cl] ["CHAT", "[server]", loc "callvote hedgehogs: specify number from 1 to 8"]]
       
   474 
   450 
   475 
   451 handleCmd_inRoom ["VOTE", m] = do
   476 handleCmd_inRoom ["VOTE", m] = do
   452     cl <- thisClient
   477     cl <- thisClient
   453     let b = if m == "YES" then Just True else if m == "NO" then Just False else Nothing
   478     let b = if m == "YES" then Just True else if m == "NO" then Just False else Nothing
   454     if isJust b then
   479     if isJust b then