gameServer/HWProtoInRoomState.hs
branch0.9.14
changeset 4242 5e3c5fe2cb14
parent 3655 1ae653467897
child 4295 1f5604cd99be
child 4334 82cfbbab73da
--- a/gameServer/HWProtoInRoomState.hs	Thu Nov 11 11:04:24 2010 -0500
+++ b/gameServer/HWProtoInRoomState.hs	Thu Nov 11 22:17:54 2010 +0300
@@ -1,240 +1,182 @@
-{-# LANGUAGE OverloadedStrings #-}
 module HWProtoInRoomState where
 
 import qualified Data.Foldable as Foldable
+import qualified Data.IntMap as IntMap
 import qualified Data.Map as Map
 import Data.Sequence(Seq, (|>), (><), fromList, empty)
 import Data.List
-import Data.Maybe
-import qualified Data.ByteString.Char8 as B
-import Control.Monad
-import Control.Monad.Reader
+import Maybe
 --------------------------------------
 import CoreTypes
 import Actions
 import Utils
-import HandlerUtils
-import RoomsAndClients
+
 
 handleCmd_inRoom :: CmdHandler
 
-handleCmd_inRoom ["CHAT", msg] = do
-    n <- clientNick
-    s <- roomOthersChans
-    return [AnswerClients s ["CHAT", n, msg]]
+handleCmd_inRoom clID clients _ ["CHAT", msg] =
+    [AnswerOthersInRoom ["CHAT", clientNick, msg]]
+    where
+        clientNick = nick $ clients IntMap.! clID
 
-handleCmd_inRoom ["PART"] = return [MoveToLobby "part"]
-handleCmd_inRoom ["PART", msg] = return [MoveToLobby $ "part: " `B.append` msg]
+handleCmd_inRoom clID clients rooms ["PART"] =
+    [RoomRemoveThisClient "part"]
+    where
+        client = clients IntMap.! clID
 
 
-handleCmd_inRoom ("CFG" : paramName : paramStrs)
-    | null paramStrs = return [ProtocolError "Empty config entry"]
-    | otherwise = do
-        chans <- roomOthersChans
-        cl <- thisClient
-        if isMaster cl then
-           return [
-                ModifyRoom (\r -> r{params = Map.insert paramName paramStrs (params r)}),
-                AnswerClients chans ("CFG" : paramName : paramStrs)]
-            else
-            return [ProtocolError "Not room master"]
+handleCmd_inRoom clID clients rooms ("CFG" : paramName : paramStrs)
+    | null paramStrs = [ProtocolError "Empty config entry"]
+    | isMaster client =
+        [ModifyRoom (\r -> r{params = Map.insert paramName paramStrs (params r)}),
+        AnswerOthersInRoom ("CFG" : paramName : paramStrs)]
+    | otherwise = [ProtocolError "Not room master"]
+    where
+        client = clients IntMap.! clID
 
-handleCmd_inRoom ("ADD_TEAM" : name : color : grave : fort : voicepack : flag : difStr : hhsInfo)
-    | length hhsInfo /= 16 = return [ProtocolError "Corrupted hedgehogs info"]
-    | otherwise = do
-        (ci, rnc) <- ask
-        r <- thisRoom
-        clNick <- clientNick
-        clChan <- thisClientChans
-        othersChans <- roomOthersChans
-        return $
-            if not . null . drop 5 $ teams r then
-                [Warning "too many teams"]
-            else if canAddNumber r <= 0 then
-                [Warning "too many hedgehogs"]
-            else if isJust $ findTeam r then
-                [Warning "There's already a team with same name in the list"]
-            else if gameinprogress r then
-                [Warning "round in progress"]
-            else if isRestrictedTeams r then
-                [Warning "restricted"]
-            else
-                [ModifyRoom (\r -> r{teams = teams r ++ [newTeam ci clNick r]}),
-                ModifyClient (\c -> c{teamsInGame = teamsInGame c + 1, clientClan = color}),
-                AnswerClients clChan ["TEAM_ACCEPTED", name],
-                AnswerClients othersChans $ teamToNet $ newTeam ci clNick r,
-                AnswerClients othersChans ["TEAM_COLOR", name, color]
-                ]
-        where
-        canAddNumber r = 48 - (sum . map hhnum $ teams r)
-        findTeam = find (\t -> name == teamname t) . teams
-        newTeam ci clNick r = (TeamInfo ci clNick name color grave fort voicepack flag difficulty (newTeamHHNum r) (hhsList hhsInfo))
-        difficulty = case B.readInt difStr of
-                           Just (i, t) | B.null t -> fromIntegral i
-                           otherwise -> 0
+handleCmd_inRoom clID clients rooms ("ADD_TEAM" : name : color : grave : fort : voicepack : flag : difStr : hhsInfo)
+    | length hhsInfo == 15 && clientProto client < 30 = handleCmd_inRoom clID clients rooms ("ADD_TEAM" : name : color : grave : fort : voicepack : " " : flag : difStr : hhsInfo)
+    | length hhsInfo /= 16 = [ProtocolError "Corrupted hedgehogs info"]
+    | length (teams room) == 6 = [Warning "too many teams"]
+    | canAddNumber <= 0 = [Warning "too many hedgehogs"]
+    | isJust findTeam = [Warning "There's already a team with same name in the list"]
+    | gameinprogress room = [Warning "round in progress"]
+    | isRestrictedTeams room = [Warning "restricted"]
+    | otherwise =
+        [ModifyRoom (\r -> r{teams = teams r ++ [newTeam]}),
+        ModifyClient (\c -> c{teamsInGame = teamsInGame c + 1, clientClan = color}),
+        AnswerThisClient ["TEAM_ACCEPTED", name],
+        AnswerOthersInRoom $ teamToNet (clientProto client) newTeam,
+        AnswerOthersInRoom ["TEAM_COLOR", name, color]
+        ]
+    where
+        client = clients IntMap.! clID
+        room = rooms IntMap.! (roomID client)
+        canAddNumber = 48 - (sum . map hhnum $ teams room)
+        findTeam = find (\t -> name == teamname t) $ teams room
+        newTeam = (TeamInfo clID (nick client) name color grave fort voicepack flag difficulty newTeamHHNum (hhsList hhsInfo))
+        difficulty = fromMaybe 0 (maybeRead difStr :: Maybe Int)
         hhsList [] = []
-        hhsList [_] = error "Hedgehogs list with odd elements number"
         hhsList (n:h:hhs) = HedgehogInfo n h : hhsList hhs
-        newTeamHHNum r = min 4 (canAddNumber r)
-
-handleCmd_inRoom ["REMOVE_TEAM", name] = do
-        (ci, rnc) <- ask
-        r <- thisRoom
-        clNick <- clientNick
-
-        let maybeTeam = findTeam r
-        let team = fromJust maybeTeam
+        newTeamHHNum = min 4 canAddNumber
 
-        return $
-            if isNothing $ findTeam r then
-                [Warning "REMOVE_TEAM: no such team"]
-            else if clNick /= teamowner team then
-                [ProtocolError "Not team owner!"]
-            else
-                [RemoveTeam name,
-                ModifyClient
-                    (\c -> c{
-                        teamsInGame = teamsInGame c - 1,
-                        clientClan = if teamsInGame c == 1 then undefined else anotherTeamClan ci r
-                        })
-                ]
+handleCmd_inRoom clID clients rooms ["REMOVE_TEAM", teamName]
+    | noSuchTeam = [Warning "REMOVE_TEAM: no such team"]
+    | nick client /= teamowner team = [ProtocolError "Not team owner!"]
+    | otherwise =
+            [RemoveTeam teamName,
+            ModifyClient (\c -> c{teamsInGame = teamsInGame c - 1, clientClan = if teamsInGame client == 1 then undefined else anotherTeamClan})
+            ]
     where
-        anotherTeamClan ci = teamcolor . fromJust . find (\t -> teamownerId t == ci) . teams
-        findTeam = find (\t -> name == teamname t) . teams
+        client = clients IntMap.! clID
+        room = rooms IntMap.! (roomID client)
+        noSuchTeam = isNothing findTeam
+        team = fromJust findTeam
+        findTeam = find (\t -> teamName == teamname t) $ teams room
+        anotherTeamClan = teamcolor $ fromJust $ find (\t -> teamownerId t == clID) $ teams room
 
 
-handleCmd_inRoom ["HH_NUM", teamName, numberStr] = do
-    cl <- thisClient
-    others <- roomOthersChans
-    r <- thisRoom
-
-    let maybeTeam = findTeam r
-    let team = fromJust maybeTeam
-
-    return $
-        if not $ isMaster cl then
-            [ProtocolError "Not room master"]
-        else if hhNumber < 1 || hhNumber > 8 || isNothing maybeTeam || hhNumber > (canAddNumber r) + (hhnum team) then
-            []
-        else
-            [ModifyRoom $ modifyTeam team{hhnum = hhNumber},
-            AnswerClients others ["HH_NUM", teamName, B.pack $ show hhNumber]]
+handleCmd_inRoom clID clients rooms ["HH_NUM", teamName, numberStr]
+    | not $ isMaster client = [ProtocolError "Not room master"]
+    | hhNumber < 1 || hhNumber > 8 || noSuchTeam || hhNumber > (canAddNumber + (hhnum team)) = []
+    | otherwise =
+        [ModifyRoom $ modifyTeam team{hhnum = hhNumber},
+        AnswerOthersInRoom ["HH_NUM", teamName, show hhNumber]]
     where
-        hhNumber = case B.readInt numberStr of
-                           Just (i, t) | B.null t -> fromIntegral i
-                           otherwise -> 0
-        findTeam = find (\t -> teamName == teamname t) . teams
-        canAddNumber = (-) 48 . sum . map hhnum . teams
-
+        client = clients IntMap.! clID
+        room = rooms IntMap.! (roomID client)
+        hhNumber = fromMaybe 0 (maybeRead numberStr :: Maybe Int)
+        noSuchTeam = isNothing findTeam
+        team = fromJust findTeam
+        findTeam = find (\t -> teamName == teamname t) $ teams room
+        canAddNumber = 48 - (sum . map hhnum $ teams room)
 
 
-handleCmd_inRoom ["TEAM_COLOR", teamName, newColor] = do
-    cl <- thisClient
-    others <- roomOthersChans
-    r <- thisRoom
-
-    let maybeTeam = findTeam r
-    let team = fromJust maybeTeam
-
-    return $
-        if not $ isMaster cl then
-            [ProtocolError "Not room master"]
-        else if isNothing maybeTeam then
-            []
-        else
-            [ModifyRoom $ modifyTeam team{teamcolor = newColor},
-            AnswerClients others ["TEAM_COLOR", teamName, newColor],
+handleCmd_inRoom clID clients rooms ["TEAM_COLOR", teamName, newColor]
+    | not $ isMaster client = [ProtocolError "Not room master"]
+    | noSuchTeam = []
+    | otherwise = [ModifyRoom $ modifyTeam team{teamcolor = newColor},
+            AnswerOthersInRoom ["TEAM_COLOR", teamName, newColor],
             ModifyClient2 (teamownerId team) (\c -> c{clientClan = newColor})]
     where
-        findTeam = find (\t -> teamName == teamname t) . teams
+        noSuchTeam = isNothing findTeam
+        team = fromJust findTeam
+        findTeam = find (\t -> teamName == teamname t) $ teams room
+        client = clients IntMap.! clID
+        room = rooms IntMap.! (roomID client)
 
 
-handleCmd_inRoom ["TOGGLE_READY"] = do
-    cl <- thisClient
-    chans <- roomClientsChans
-    return [
-        ModifyClient (\c -> c{isReady = not $ isReady cl}),
-        ModifyRoom (\r -> r{readyPlayers = readyPlayers r + (if isReady cl then -1 else 1)}),
-        AnswerClients chans [if isReady cl then "NOT_READY" else "READY", nick cl]
-        ]
+handleCmd_inRoom clID clients rooms ["TOGGLE_READY"] =
+    [ModifyClient (\c -> c{isReady = not $ isReady client}),
+    ModifyRoom (\r -> r{readyPlayers = readyPlayers r + (if isReady client then -1 else 1)}),
+    AnswerThisRoom [if isReady client then "NOT_READY" else "READY", nick client]]
+    where
+        client = clients IntMap.! clID
 
-handleCmd_inRoom ["START_GAME"] = do
-    cl <- thisClient
-    r <- thisRoom
-    chans <- roomClientsChans
 
-    if isMaster cl && (playersIn r == readyPlayers r) && (not $ gameinprogress r) then
-        if enoughClans r then
-            return [
-                ModifyRoom
+handleCmd_inRoom clID clients rooms ["START_GAME"] =
+    if isMaster client && (playersIn room == readyPlayers room) && (not . gameinprogress) room then
+        if enoughClans then
+            [ModifyRoom
                     (\r -> r{
                         gameinprogress = True,
                         roundMsgs = empty,
                         leftTeams = [],
                         teamsAtStart = teams r}
                     ),
-                AnswerClients chans ["RUN_GAME"]
-                ]
-            else
-            return [Warning "Less than two clans!"]
+            AnswerThisRoom ["RUN_GAME"]]
         else
-        return []
+            [Warning "Less than two clans!"]
+    else
+        []
     where
-        enoughClans = not . null . drop 1 . group . map teamcolor . teams
+        client = clients IntMap.! clID
+        room = rooms IntMap.! (roomID client)
+        enoughClans = not $ null $ drop 1 $ group $ map teamcolor $ teams room
 
 
-handleCmd_inRoom ["EM", msg] = do
-    cl <- thisClient
-    r <- thisRoom
-    chans <- roomOthersChans
-    
-    if (teamsInGame cl > 0) && isLegal then
-        return $ (AnswerClients chans ["EM", msg]) : [ModifyRoom (\r -> r{roundMsgs = roundMsgs r |> msg}) | not isKeepAlive]
-        else
-        return []
+handleCmd_inRoom clID clients rooms ["EM", msg] =
+    if (teamsInGame client > 0) && isLegal then
+        (AnswerOthersInRoom ["EM", msg]) : [ModifyRoom (\r -> r{roundMsgs = roundMsgs r |> msg}) | not isKeepAlive]
+    else
+        []
     where
+        client = clients IntMap.! clID
         (isLegal, isKeepAlive) = checkNetCmd msg
 
-
-handleCmd_inRoom ["ROUNDFINISHED"] = do
-    cl <- thisClient
-    r <- thisRoom
-    chans <- roomClientsChans
-
-    if isMaster cl && (gameinprogress r) then
-        return $ (ModifyRoom
+handleCmd_inRoom clID clients rooms ["ROUNDFINISHED"] =
+    if isMaster client then
+        [ModifyRoom
                 (\r -> r{
                     gameinprogress = False,
                     readyPlayers = 0,
                     roundMsgs = empty,
                     leftTeams = [],
                     teamsAtStart = []}
-                ))
-            : UnreadyRoomClients
-            : answerRemovedTeams chans r
-        else
-        return []
+                ),
+        UnreadyRoomClients
+        ] ++ answerRemovedTeams
+    else
+        []
     where
-        answerRemovedTeams chans = map (\t -> AnswerClients chans ["REMOVE_TEAM", t]) . leftTeams
-
-handleCmd_inRoom ["TOGGLE_RESTRICT_JOINS"] = do
-    cl <- thisClient
-    return $
-        if not $ isMaster cl then
-            [ProtocolError "Not room master"]
-        else
-            [ModifyRoom (\r -> r{isRestrictedJoins = not $ isRestrictedJoins r})]
+        client = clients IntMap.! clID
+        room = rooms IntMap.! (roomID client)
+        answerRemovedTeams = map (\t -> AnswerThisRoom ["REMOVE_TEAM", t]) $ leftTeams room
 
 
-handleCmd_inRoom ["TOGGLE_RESTRICT_TEAMS"] = do
-    cl <- thisClient
-    return $
-        if not $ isMaster cl then
-            [ProtocolError "Not room master"]
-        else
-            [ModifyRoom (\r -> r{isRestrictedTeams = not $ isRestrictedTeams r})]
+handleCmd_inRoom clID clients _ ["TOGGLE_RESTRICT_JOINS"]
+    | isMaster client = [ModifyRoom (\r -> r{isRestrictedJoins = not $ isRestrictedJoins r})]
+    | otherwise = [ProtocolError "Not room master"]
+    where
+        client = clients IntMap.! clID
+
 
-{-
+handleCmd_inRoom clID clients _ ["TOGGLE_RESTRICT_TEAMS"]
+    | isMaster client = [ModifyRoom (\r -> r{isRestrictedTeams = not $ isRestrictedTeams r})]
+    | otherwise = [ProtocolError "Not room master"]
+    where
+        client = clients IntMap.! clID
+
 handleCmd_inRoom clID clients rooms ["KICK", kickNick] =
     [KickRoomClient kickID | isMaster client && not noSuchClient && (kickID /= clID) && (roomID client == roomID kickClient)]
     where
@@ -250,5 +192,5 @@
     where
         client = clients IntMap.! clID
         engineMsg = toEngineMsg $ 'b' : ((nick client) ++ "(team): " ++ msg ++ "\x20\x20")
--}
-handleCmd_inRoom _ = return [ProtocolError "Incorrect command (state: in room)"]
+
+handleCmd_inRoom clID _ _ _ = [ProtocolError "Incorrect command (state: in room)"]