Reimplement room creating
authorunC0Rr@gmail.com
Mon, 21 Jun 2010 21:41:14 +0400
changeset 3531 66c403badff6
parent 3530 390e5048d39c
child 3532 04e2fea3e83a
Reimplement room creating
gameServer/Actions.hs
gameServer/HWProtoInRoomState.hs
--- a/gameServer/Actions.hs	Mon Jun 21 16:52:14 2010 +0200
+++ b/gameServer/Actions.hs	Mon Jun 21 21:41:14 2010 +0400
@@ -23,7 +23,7 @@
     | SendServerMessage
     | SendServerVars
     | MoveToRoom RoomIndex
-    | RoomRemoveThisClient B.ByteString
+    | MoveToLobby B.ByteString
     | RemoveTeam B.ByteString
     | RemoveRoom
     | UnreadyRoomClients
@@ -97,7 +97,7 @@
     rnc <- gets roomsClients
     ri <- clientRoomA
     when (ri /= lobbyId) $ do
-        processAction $ RoomRemoveThisClient ("quit: " `B.append` msg)
+        processAction $ MoveToLobby ("quit: " `B.append` msg)
         return ()
 
     chan <- client's sendChan
@@ -156,23 +156,29 @@
 
 -}
 
-processAction (MoveToRoom rId) = do
+processAction (MoveToRoom ri) = do
     (Just ci) <- gets clientIndex
     rnc <- gets roomsClients
     liftIO $ do
         modifyClient rnc (\cl -> cl{teamsInGame = 0}) ci
-        modifyRoom rnc (\r -> r{playersIn = (playersIn r) + 1}) rId
-        
-    chans <- liftM (map sendChan) $ roomClientsS rId
-     liftio movetoroom
+        modifyRoom rnc (\r -> r{playersIn = (playersIn r) + 1}) ri
+
+    liftIO $ moveClientToRoom rnc ri ci
+
+    chans <- liftM (map sendChan) $ roomClientsS ri
     clNick <- client's nick
     
     processAction $ AnswerClients chans ["JOINED", clNick]
 
+processAction (MoveToLobby msg) = do
+    (Just ci) <- gets clientIndex
+    --ri <- clientRoomA
+    rnc <- gets roomsClients
+
+    liftIO $ moveClientToLobby rnc ci
+
 {-
-processAction (clID, serverInfo, rnc) (RoomRemoveThisClient msg) = do
     (_, _, newClients, newRooms) <-
-        if roomID client /= 0 then
             if isMaster client then
                 if (gameinprogress room) && (playersIn room > 1) then
                     (changeMaster >>= (\state -> foldM processAction state
@@ -187,8 +193,7 @@
                         (clID, serverInfo, rnc)
                         [AnswerOthersInRoom ["LEFT", nick client, msg],
                         RemoveClientTeams clID]
-        else -- in lobby
-            return (clID, serverInfo, rnc)
+
 
     return (
         clID,
--- a/gameServer/HWProtoInRoomState.hs	Mon Jun 21 16:52:14 2010 +0200
+++ b/gameServer/HWProtoInRoomState.hs	Mon Jun 21 21:41:14 2010 +0400
@@ -6,6 +6,7 @@
 import Data.Sequence(Seq, (|>), (><), fromList, empty)
 import Data.List
 import Maybe
+import qualified Data.ByteString.Char8 as B
 --------------------------------------
 import CoreTypes
 import Actions
@@ -20,12 +21,10 @@
     s <- roomOthersChans
     return [AnswerClients s ["CHAT", n, msg]]
 
+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 clID clients rooms ("CFG" : paramName : paramStrs)
     | null paramStrs = [ProtocolError "Empty config entry"]
@@ -194,6 +193,5 @@
     where
         client = clients IntMap.! clID
         engineMsg = toEngineMsg $ 'b' : ((nick client) ++ "(team): " ++ msg ++ "\x20\x20")
-
-handleCmd_inRoom clID _ _ _ = [ProtocolError "Incorrect command (state: in room)"]
--}
\ No newline at end of file
+-}
+handleCmd_inRoom _ = return [ProtocolError "Incorrect command (state: in room)"]