gameServer/Actions.hs
changeset 15900 fc3cb23fd26f
parent 15810 acf70c44065b
--- a/gameServer/Actions.hs	Fri Sep 23 12:47:47 2022 -0400
+++ b/gameServer/Actions.hs	Tue Sep 27 14:59:03 2022 +0300
@@ -24,6 +24,7 @@
 import qualified Data.Set as Set
 import qualified Data.Map as Map
 import qualified Data.List as L
+import Data.Word
 import qualified Control.Exception as Exception
 import System.Log.Logger
 import Control.Monad
@@ -65,6 +66,12 @@
     ri <- clientRoomA
     liftM (map sendChan . filter (/= cl)) $ roomClientsS ri
 
+othersChansProto :: StateT ServerState IO [(ClientChan, Word16)]
+othersChansProto = do
+    cl <- client's id
+    ri <- clientRoomA
+    map (\ci -> (sendChan ci, clientProto ci)) . filter (/= cl) <$> roomClientsS ri
+
 processAction :: Action -> StateT ServerState IO ()
 
 
@@ -72,6 +79,10 @@
     io $ mapM_ (`writeChan` (msg `deepseq` msg)) (chans `deepseq` chans)
 
 
+processAction (AnswerClientsByProto chansProto msgFunc) =
+    io $ mapM_ (\(chan, proto) -> writeChan chan (msgFunc proto)) chansProto
+
+
 processAction SendServerMessage = do
     chan <- client's sendChan
     protonum <- client's clientProto
@@ -279,8 +290,9 @@
                 )
 
     newRoom' <- io $ room'sM rnc id ri
-    chans <- liftM (map sendChan) $! sameProtoClientsS proto
-    processAction $ AnswerClients chans ("ROOM" : "UPD" : oldRoomName : roomInfo proto (maybeNick newMaster) newRoom')
+    chansProto <- fmap (map (\c -> (sendChan c, clientProto c))) $! allClientsS
+    let oldRoomNameByProto = roomNameByProto oldRoomName (roomProto newRoom')
+    processAction $ AnswerClientsByProto chansProto (\p -> "ROOM" : "UPD" : oldRoomNameByProto p : roomInfo p (maybeNick newMaster) newRoom')
 
 
 processAction (AddRoom roomName roomPassword) = do
@@ -300,10 +312,10 @@
 
     processAction $ MoveToRoom rId
 
-    chans <- liftM (map sendChan) $! sameProtoClientsS proto
+    chansProto <- fmap (map (\c -> (sendChan c, clientProto c))) $! allClientsS
 
     mapM_ processAction [
-      AnswerClients chans ("ROOM" : "ADD" : roomInfo proto n rm{playersIn = 1})
+      AnswerClientsByProto chansProto (\p -> "ROOM" : "ADD" : roomInfo p n rm{playersIn = 1})
         ]
 
 
@@ -312,13 +324,13 @@
     rnc <- gets roomsClients
     ri <- io $ clientRoomM rnc clId
     roomName <- io $ room'sM rnc name ri
-    others <- othersChans
-    proto <- client's clientProto
-    chans <- liftM (map sendChan) $! sameProtoClientsS proto
+    roomProto <- io $ room'sM rnc roomProto ri
+    others <- othersChansProto
+    chansProto <- fmap (map (\c -> (sendChan c, clientProto c))) $! allClientsS
 
     mapM_ processAction [
-            AnswerClients chans ["ROOM", "DEL", roomName],
-            AnswerClients others ["ROOMABANDONED", roomName]
+            AnswerClientsByProto chansProto (\p -> ["ROOM", "DEL", roomNameByProto roomName roomProto p]),
+            AnswerClientsByProto others (\p -> ["ROOMABANDONED", roomNameByProto roomName roomProto p])
         ]
 
     io $ removeRoom rnc ri
@@ -331,8 +343,9 @@
     ri <- io $ clientRoomM rnc clId
     rm <- io $ room'sM rnc id ri
     masterCl <- io $ client'sM rnc id `DT.mapM` (masterID rm)
-    chans <- liftM (map sendChan) $! sameProtoClientsS proto
-    processAction $ AnswerClients chans ("ROOM" : "UPD" : name rm : roomInfo proto (maybeNick masterCl) rm)
+    chansProto <- fmap (map (\c -> (sendChan c, clientProto c))) $! allClientsS
+    let thisRoomNameByProto = roomNameByProto (name rm) (roomProto rm)
+    processAction $ AnswerClientsByProto chansProto (\p -> "ROOM" : "UPD" : thisRoomNameByProto p : roomInfo p (maybeNick masterCl) rm)
 
 
 processAction UnreadyRoomClients = do
@@ -536,7 +549,7 @@
         rooms <- roomsM rnc
         mapM (\r -> (mapM (client'sM rnc id) $ masterID r)
             >>= \cn -> return $ roomInfo clProto (maybeNick cn) r)
-            $ filter (\r -> (roomProto r == clProto)) rooms
+            $ filter ((/=) 0 . roomProto) rooms
 
     mapM_ processAction . concat $ [
         [AnswerClients clientsChans ["LOBBY:JOINED", clientNick]]