sheepy-clone: comparison gameServer/Actions.hs

equal deleted inserted replaced

-:a3159a410e5c
+:ad38c653b7d9
 import Monad
 import Data.Time
 import Maybe
 import Control.Monad.Reader
 import Control.Monad.State
-import Data.ByteString.Char8 as B
+import qualified Data.ByteString.Char8 as B
 -----------------------------
 import CoreTypes
 import Utils
 import ClientIO
 import ServerState
 data Action =
-AnswerClients [ClientChan] [ByteString]
+AnswerClients [ClientChan] [B.ByteString]
 | SendServerMessage
 | SendServerVars
-| RoomAddThisClient RoomIndex -- roomID
+| MoveToRoom RoomIndex
-| RoomRemoveThisClient ByteString
+| RoomRemoveThisClient B.ByteString
-| RemoveTeam ByteString
+| RemoveTeam B.ByteString
 | RemoveRoom
 | UnreadyRoomClients
-| MoveToLobby
+| JoinLobby
-| ProtocolError ByteString
+| ProtocolError B.ByteString
-| Warning ByteString
+| Warning B.ByteString
-| ByeClient ByteString
+| ByeClient B.ByteString
-| KickClient ClientIndex -- clID
+| KickClient ClientIndex
-| KickRoomClient ClientIndex -- clID
+| KickRoomClient ClientIndex
-| BanClient ByteString -- nick
+| BanClient B.ByteString -- nick
-| RemoveClientTeams ClientIndex -- clID
+| RemoveClientTeams ClientIndex
 | ModifyClient (ClientInfo -> ClientInfo)
 | ModifyClient2 ClientIndex (ClientInfo -> ClientInfo)
 | ModifyRoom (RoomInfo -> RoomInfo)
 | ModifyServerInfo (ServerInfo -> ServerInfo)
-| AddRoom ByteString ByteString
+| AddRoom B.ByteString B.ByteString
 | CheckRegistered
 | ClearAccountsCache
 | ProcessAccountInfo AccountInfo
 | Dump
 | AddClient ClientInfo
 | PingAll
 | StatsAction
-type CmdHandler = [ByteString] -> Reader (ClientIndex, IRnC) [Action]
+type CmdHandler = [B.ByteString] -> Reader (ClientIndex, IRnC) [Action]
 processAction :: Action -> StateT ServerState IO ()
 {-
 processAction (clID, serverInfo, rnc) (ModifyServerInfo func) =
 return (clID, func serverInfo, rnc)
+-}
-processAction (clID, serverInfo, rnc) (RoomAddThisClient rID) =
-processAction (
+processAction (MoveToRoom rId) = do
-clID,
+(Just ci) <- gets clientIndex
-serverInfo,
+rnc <- gets roomsClients
-adjust (\cl -> cl{roomID = rID, teamsInGame = if rID == 0 then teamsInGame cl else 0}) clID clients,
+liftIO $ do
-adjust (\r -> r{playersIDs = IntSet.insert clID (playersIDs r), playersIn = (playersIn r) + 1}) rID $
+modifyClient rnc (\cl -> cl{teamsInGame = 0}) ci
-adjust (\r -> r{playersIDs = IntSet.delete clID (playersIDs r)}) 0 rooms
+modifyRoom rnc (\r -> r{playersIn = (playersIn r) + 1}) rId
-) joinMsg
-where
+chans <- liftM (map sendChan) $ roomClientsS rId
-client = clients ! clID
+liftio movetoroom
-joinMsg = if rID == 0 then
+clNick <- client's nick
-AnswerAllOthers ["LOBBY:JOINED", nick client]
-else
+processAction $ AnswerClients chans ["JOINED", clNick]
-AnswerThisRoom ["JOINED", nick client]
+{-
 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
 )
 newRoomName = nick newMasterClient
 otherPlayersSet = IntSet.delete clID (playersIDs room)
 newMasterId = IntSet.findMin otherPlayersSet
 newMasterClient = clients ! newMasterId
+-}
-processAction (clID, serverInfo, rnc) (AddRoom roomName roomPassword) = do
+processAction (AddRoom roomName roomPassword) = do
-let newServerInfo = serverInfo {nextRoomID = newID}
+(ServerState (Just clId) _ rnc) <- get
+proto <- liftIO $ client'sM rnc clientProto clId
 let room = newRoom{
-roomUID = newID,
+masterID = clId,
-masterID = clID,
 name = roomName,
 password = roomPassword,
-roomProto = (clientProto client)
+roomProto = proto
 }
-processAction (clID, serverInfo, rnc) $ AnswerLobby ["ROOM", "ADD", roomName]
+rId <- liftIO $ addRoom rnc room
-processAction (
+chans <- liftM (map sendChan) $ roomClientsS lobbyId
-clID,
-newServerInfo,
+mapM_ processAction [
-adjust (\cl -> cl{isMaster = True}) clID clients,
+AnswerClients chans ["ROOM", "ADD", roomName]
-insert newID room rooms
+, ModifyClient (\cl -> cl{isMaster = True})
-) $ RoomAddThisClient newID
+, MoveToRoom rId]
-where
-newID = (nextRoomID serverInfo) - 1
+{-
-client = clients ! clID
 processAction (clID, serverInfo, rnc) (RemoveRoom) = do
 processAction (clID, serverInfo, rnc) $ AnswerLobby ["ROOM", "DEL", name room]
 processAction (clID, serverInfo, rnc) $ AnswerOthersInRoom ["ROOMABANDONED", name room]
 return (clID,
 serverInfo,
 case info of
 HasAccount passwd isAdmin -> do
 chan <- client's sendChan
 liftIO $ writeChan chan ["ASKPASSWORD"]
 Guest -> do
-mapM_ processAction [ModifyClient (\cl -> cl{logonPassed = True}), MoveToLobby]
+processAction JoinLobby
 Admin -> do
-mapM processAction [ModifyClient (\cl -> cl{logonPassed = True, isAdministrator = True}), MoveToLobby]
+mapM processAction [ModifyClient (\cl -> cl{isAdministrator = True}), JoinLobby]
 chan <- client's sendChan
 liftIO $ writeChan chan ["ADMIN_ACCESS"]
-processAction MoveToLobby = do
+processAction JoinLobby = do
 chan <- client's sendChan
-lobbyNicks <- liftM (Prelude.map nick . Prelude.filter logonPassed) allClientsS
+clientNick <- client's nick
+(lobbyNicks, clientsChans) <- liftM (unzip . Prelude.map (\c -> (nick c, sendChan c)) . Prelude.filter logonPassed) allClientsS
 mapM_ processAction $
---        (RoomAddThisClient 0)
+(AnswerClients clientsChans ["LOBBY:JOINED", clientNick])
-[AnswerClients [chan] ("LOBBY:JOINED" : lobbyNicks) | not $ Prelude.null lobbyNicks]
+: [AnswerClients [chan] ("LOBBY:JOINED" : lobbyNicks) | not $ Prelude.null lobbyNicks]
-++ [SendServerMessage]
+++ [ModifyClient (\cl -> cl{logonPassed = True}), SendServerMessage]
 {-
+processAction (clID, serverInfo, rnc) (RoomAddThisClient rID) =
+processAction (
+clID,
+serverInfo,
+adjust (\cl -> cl{roomID = rID, teamsInGame = if rID == 0 then teamsInGame cl else 0}) clID clients,
+adjust (\r -> r{playersIDs = IntSet.insert clID (playersIDs r), playersIn = (playersIn r) + 1}) rID $
+adjust (\r -> r{playersIDs = IntSet.delete clID (playersIDs r)}) 0 rooms
+) joinMsg
+where
+client = clients ! clID
+joinMsg = if rID == 0 then
+AnswerAllOthers ["LOBBY:JOINED", nick client]
+else
+AnswerThisRoom ["JOINED", nick client]
 processAction (clID, serverInfo, rnc) (KickClient kickID) =
 liftM2 replaceID (return clID) (processAction (kickID, serverInfo, rnc) $ ByeClient "Kicked")

changeset 3502	ad38c653b7d9
parent 3501	a3159a410e5c
child 3531	66c403badff6