gameServer/Actions.hs
changeset 3501 a3159a410e5c
parent 3500 af8390d807d6
child 3502 ad38c653b7d9
--- a/gameServer/Actions.hs	Sun Jun 06 15:29:33 2010 +0000
+++ b/gameServer/Actions.hs	Sun Jun 06 19:03:06 2010 +0000
@@ -58,16 +58,16 @@
     liftIO $ mapM_ (flip writeChan msg) chans
 
 
-{-
-processAction (clID, serverInfo, rnc) SendServerMessage = do
-    writeChan (sendChan $ clients ! clID) ["SERVER_MESSAGE", message serverInfo]
-    return (clID, serverInfo, rnc)
-    where
-        client = clients ! clID
-        message si = if clientProto client < latestReleaseVersion si then
+processAction SendServerMessage = do
+    chan <- client's sendChan
+    protonum <- client's clientProto
+    si <- liftM serverInfo get
+    let message = if protonum < latestReleaseVersion si then
             serverMessageForOldVersions si
             else
             serverMessage si
+    liftIO $ writeChan chan ["SERVER_MESSAGE", message]
+{-
 
 processAction (clID, serverInfo, rnc) SendServerVars = do
     writeChan (sendChan $ clients ! clID) ("SERVER_VARS" : vars)
@@ -81,15 +81,16 @@
             ]
 
 
-processAction (clID, serverInfo, rnc) (ProtocolError msg) = do
-    writeChan (sendChan $ clients ! clID) ["ERROR", msg]
-    return (clID, serverInfo, rnc)
+-}
+
+processAction (ProtocolError msg) = do
+    chan <- client's sendChan
+    liftIO $ writeChan chan ["ERROR", msg]
 
 
-processAction (clID, serverInfo, rnc) (Warning msg) = do
-    writeChan (sendChan $ clients ! clID) ["WARNING", msg]
-    return (clID, serverInfo, rnc)
--}
+processAction (Warning msg) = do
+    chan <- client's sendChan
+    liftIO $ writeChan chan ["WARNING", msg]
 
 processAction (ByeClient msg) = do
     (Just ci) <- gets clientIndex
@@ -99,7 +100,7 @@
         processAction $ RoomRemoveThisClient ("quit: " `B.append` msg)
         return ()
 
-    chan <- clients sendChan
+    chan <- client's sendChan
 
     liftIO $ do
         infoM "Clients" (show ci ++ " quits: " ++ (B.unpack msg))
@@ -297,8 +298,8 @@
 
 processAction CheckRegistered = do
     (Just ci) <- gets clientIndex
-    n <- clients nick
-    h <- clients host
+    n <- client's nick
+    h <- client's host
     db <- gets (dbQueries . serverInfo)
     liftIO $ writeChan db $ CheckAccount ci n h
     return ()
@@ -314,33 +315,29 @@
 processAction (clID, serverInfo, rnc) (Dump) = do
     writeChan (sendChan $ clients ! clID) ["DUMP", show serverInfo, showTree clients, showTree rooms]
     return (clID, serverInfo, rnc)
-
+-}
 
-processAction (clID, serverInfo, rnc) (ProcessAccountInfo info) =
+processAction (ProcessAccountInfo info) =
     case info of
         HasAccount passwd isAdmin -> do
-            infoM "Clients" $ show clID ++ " has account"
-            writeChan (sendChan $ clients ! clID) ["ASKPASSWORD"]
-            return (clID, serverInfo, adjust (\cl -> cl{webPassword = passwd, isAdministrator = isAdmin}) clID rnc)
+            chan <- client's sendChan
+            liftIO $ writeChan chan ["ASKPASSWORD"]
         Guest -> do
-            infoM "Clients" $ show clID ++ " is guest"
-            processAction (clID, serverInfo, adjust (\cl -> cl{logonPassed = True}) clID rnc) MoveToLobby
+            mapM_ processAction [ModifyClient (\cl -> cl{logonPassed = True}), MoveToLobby]
         Admin -> do
-            infoM "Clients" $ show clID ++ " is admin"
-            foldM processAction (clID, serverInfo, adjust (\cl -> cl{logonPassed = True, isAdministrator = True}) clID rnc) [MoveToLobby, AnswerThisClient ["ADMIN_ACCESS"]]
-
+            mapM processAction [ModifyClient (\cl -> cl{logonPassed = True, isAdministrator = True}), MoveToLobby]
+            chan <- client's sendChan
+            liftIO $ writeChan chan ["ADMIN_ACCESS"]
 
-processAction (clID, serverInfo, rnc) (MoveToLobby) =
-    foldM processAction (clID, serverInfo, rnc) $
-        (RoomAddThisClient 0)
-        : answerLobbyNicks
+processAction MoveToLobby = do
+    chan <- client's sendChan
+    lobbyNicks <- liftM (Prelude.map nick . Prelude.filter logonPassed) allClientsS
+    mapM_ processAction $
+--        (RoomAddThisClient 0)
+        [AnswerClients [chan] ("LOBBY:JOINED" : lobbyNicks) | not $ Prelude.null lobbyNicks]
         ++ [SendServerMessage]
 
-        -- ++ (answerServerMessage client clients)
-    where
-        lobbyNicks = Prelude.map nick $ Prelude.filter logonPassed $ elems clients
-        answerLobbyNicks = [AnswerThisClient ("LOBBY:JOINED": lobbyNicks) | not $ Prelude.null lobbyNicks]
-
+{-
 
 processAction (clID, serverInfo, rnc) (KickClient kickID) =
     liftM2 replaceID (return clID) (processAction (kickID, serverInfo, rnc) $ ByeClient "Kicked")