--- a/gameServer/Actions.hs Thu May 06 15:26:14 2010 +0000
+++ b/gameServer/Actions.hs Thu May 06 17:39:08 2010 +0000
@@ -1,7 +1,6 @@
module Actions where
import Control.Concurrent
-import Control.Concurrent.STM
import Control.Concurrent.Chan
import qualified Data.IntSet as IntSet
import qualified Data.Sequence as Seq
@@ -9,6 +8,7 @@
import Monad
import Data.Time
import Maybe
+import Control.Monad.Reader
-----------------------------
import CoreTypes
@@ -17,7 +17,7 @@
import RoomsAndClients
data Action =
- AnswerClients [Chan [String]] [String]
+ AnswerClients [ClientChan] [String]
| SendServerMessage
| SendServerVars
| RoomAddThisClient Int -- roomID
@@ -46,7 +46,7 @@
| PingAll
| StatsAction
-type CmdHandler = Int -> MRnC -> [String] -> [Action]
+type CmdHandler = [String] -> Reader (ClientIndex, IRnC) [Action]
replaceID a (b, c, d, e) = (a, c, d, e)
@@ -89,17 +89,16 @@
processAction (clID, serverInfo, rnc) (Warning msg) = do
writeChan (sendChan $ clients ! clID) ["WARNING", msg]
return (clID, serverInfo, rnc)
+-}
+processAction (ci, serverInfo, rnc) (ByeClient msg) = do
+ infoM "Clients" (show ci ++ " quits: " ++ msg)
-processAction (clID, serverInfo, rnc) (ByeClient msg) = do
- infoM "Clients" (show (clientUID client) ++ " quits: " ++ msg)
- (_, _, newClients, newRooms) <-
- if roomID client /= 0 then
- processAction (clID, serverInfo, rnc) $ RoomRemoveThisClient "quit"
- else
- return (clID, serverInfo, rnc)
+ ri <- clientRoomM rnc ci
+ when (ri /= lobbyId)
+ processAction (ci, serverInfo, rnc) $ RoomRemoveThisClient ("quit: " ++ msg)
- mapM_ (processAction (clID, serverInfo, newClients, newRooms)) $ answerOthersQuit ++ answerInformRoom
+ mapM_ (processAction (ci, serverInfo, rnc)) $ answerOthersQuit ++ answerInformRoom
writeChan (sendChan $ clients ! clID) ["BYE", msg]
return (
0,
@@ -130,7 +129,7 @@
[AnswerAll ["LOBBY:LEFT", clientNick]]
else
[]
-
+{-
processAction (clID, serverInfo, rnc) (ModifyClient func) =
return (clID, serverInfo, adjust func clID rnc)
@@ -357,24 +356,24 @@
room = rooms ! (roomID client)
teamsToRemove = Prelude.filter (\t -> teamowner t == nick client) $ teams room
removeTeamsActions = Prelude.map (RemoveTeam . teamname) teamsToRemove
-
+-}
-processAction (clID, serverInfo, rnc) (AddClient client) = do
- forkIO $ clientRecvLoop (clientHandle client) (coreChan serverInfo) (clientUID client)
- forkIO $ clientSendLoop (clientHandle client) (coreChan serverInfo) (sendChan client) (clientUID client)
+processAction (_, serverInfo, rnc) (AddClient client) = do
+ ci <- addClient rnc client
+ forkIO $ clientRecvLoop (clientHandle client) (coreChan serverInfo) ci
+ forkIO $ clientSendLoop (clientHandle client) (coreChan serverInfo) (sendChan client) ci
- let updatedClients = insert (clientUID client) client clients
- infoM "Clients" (show (clientUID client) ++ ": New client. Time: " ++ show (connectTime client))
+ infoM "Clients" (show ci ++ ": New client. Time: " ++ show (connectTime client))
writeChan (sendChan client) ["CONNECTED", "Hedgewars server http://www.hedgewars.org/"]
let newLogins = takeWhile (\(_ , time) -> (connectTime client) `diffUTCTime` time <= 11) $ lastLogins serverInfo
if False && (isJust $ host client `Prelude.lookup` newLogins) then
- processAction (clID, serverInfo{lastLogins = newLogins}, updatedClients, rooms) $ ByeClient "Reconnected too fast"
+ processAction (ci, serverInfo{lastLogins = newLogins}, rnc) $ ByeClient "Reconnected too fast"
else
- return (clID, serverInfo{lastLogins = (host client, connectTime client) : newLogins}, updatedClients, rooms)
+ return (ci, serverInfo)
-
+{-
processAction (clID, serverInfo, rnc) PingAll = do
(_, _, newClients, newRooms) <- foldM kickTimeouted (clID, serverInfo, rnc) $ elems clients
processAction (clID,
@@ -393,4 +392,4 @@
writeChan (dbQueries serverInfo) $ SendStats (size clients) (size rooms - 1)
return (clID, serverInfo, rnc)
--}
\ No newline at end of file
+-}