# HG changeset patch
# User unc0rr
# Date 1275850986 0
# Node ID a3159a410e5c9a87bda4548a3d4dd989c60835c4
# Parent  af8390d807d67af1d7fcec8b06687881178edac0
Reimplement more core actions

diff -r af8390d807d6 -r a3159a410e5c gameServer/Actions.hs
--- 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")
diff -r af8390d807d6 -r a3159a410e5c gameServer/ClientIO.hs
--- a/gameServer/ClientIO.hs	Sun Jun 06 15:29:33 2010 +0000
+++ b/gameServer/ClientIO.hs	Sun Jun 06 19:03:06 2010 +0000
@@ -39,7 +39,7 @@
     where
         recieveWithBufferLoop recvBuf = do
             recvBS <- recv sock 4096
-            putStrLn $ show sock ++ " got smth: " ++ (show $ B.length recvBS)
+--            putStrLn $ show sock ++ " got smth: " ++ (show $ B.length recvBS)
             unless (B.null recvBS) $ do
                 let (packets, newrecvBuf) = bs2Packets $ B.append recvBuf recvBS
                 forM_ packets sendPacket
diff -r af8390d807d6 -r a3159a410e5c gameServer/CoreTypes.hs
--- a/gameServer/CoreTypes.hs	Sun Jun 06 15:29:33 2010 +0000
+++ b/gameServer/CoreTypes.hs	Sun Jun 06 19:03:06 2010 +0000
@@ -70,7 +70,7 @@
 data RoomInfo =
     RoomInfo
     {
-        masterID :: !Int,
+        masterID :: ClientIndex,
         name :: B.ByteString,
         password :: B.ByteString,
         roomProto :: Word16,
@@ -96,7 +96,7 @@
 newRoom :: RoomInfo
 newRoom = (
     RoomInfo
-        0
+        undefined
         ""
         ""
         0
@@ -124,7 +124,7 @@
     ServerInfo
     {
         isDedicated :: Bool,
-        serverMessage :: String,
+        serverMessage :: B.ByteString,
         serverMessageForOldVersions :: B.ByteString,
         latestReleaseVersion :: Word16,
         listenPort :: PortNumber,
diff -r af8390d807d6 -r a3159a410e5c gameServer/HWProtoLobbyState.hs
--- a/gameServer/HWProtoLobbyState.hs	Sun Jun 06 15:29:33 2010 +0000
+++ b/gameServer/HWProtoLobbyState.hs	Sun Jun 06 19:03:06 2010 +0000
@@ -2,17 +2,19 @@
 module HWProtoLobbyState where
 
 import qualified Data.Map as Map
-import qualified Data.IntMap as IntMap
 import qualified Data.IntSet as IntSet
 import qualified Data.Foldable as Foldable
 import Maybe
 import Data.List
 import Data.Word
+import Control.Monad.Reader
+import qualified Data.ByteString.Char8 as B
 --------------------------------------
 import CoreTypes
 import Actions
 import Utils
 import HandlerUtils
+import RoomsAndClients
 
 {-answerAllTeams protocol teams = concatMap toAnswer teams
     where
@@ -23,32 +25,31 @@
 -}
 handleCmd_lobby :: CmdHandler
 
-{-
-handleCmd_lobby clID clients rooms ["LIST"] =
-    [AnswerThisClient ("ROOMS" : roomsInfoList)]
+
+handleCmd_lobby ["LIST"] = do
+    (ci, irnc) <- ask
+    let cl = irnc `client` ci
+    rooms <- allRoomInfos
+    let roomsInfoList = concatMap (roomInfo irnc) . filter (\r -> (roomProto r == clientProto cl) && not (isRestrictedJoins r))
+    return [AnswerClients [sendChan cl] ("ROOMS" : roomsInfoList rooms)]
     where
-        roomsInfoList = concatMap roomInfo sameProtoRooms
-        sameProtoRooms = filter (\r -> (roomProto r == protocol) && not (isRestrictedJoins r)) roomsList
-        roomsList = IntMap.elems rooms
-        protocol = clientProto client
-        client = clients IntMap.! clID
-        roomInfo room
-            | clientProto client < 28 = [
+        roomInfo irnc room
+            | roomProto room < 28 = [
                 name room,
-                show (playersIn room) ++ "(" ++ show (length $ teams room) ++ ")",
-                show $ gameinprogress room
+                B.pack $ show (playersIn room) ++ "(" ++ show (length $ teams room) ++ ")",
+                B.pack $ show $ gameinprogress room
                 ]
             | otherwise = [
-                show $ gameinprogress room,
+                showB $ gameinprogress room,
                 name room,
-                show $ playersIn room,
-                show $ length $ teams room,
-                nick $ clients IntMap.! (masterID room),
+                showB $ playersIn room,
+                showB $ length $ teams room,
+                nick $ irnc `client` (masterID room),
                 head (Map.findWithDefault ["+gen+"] "MAP" (params room)),
                 head (Map.findWithDefault ["Default"] "SCHEME" (params room)),
                 head (Map.findWithDefault ["Default"] "AMMO" (params room))
                 ]
--}
+
 
 handleCmd_lobby ["CHAT", msg] = do
     n <- clientNick
diff -r af8390d807d6 -r a3159a410e5c gameServer/HandlerUtils.hs
--- a/gameServer/HandlerUtils.hs	Sun Jun 06 15:29:33 2010 +0000
+++ b/gameServer/HandlerUtils.hs	Sun Jun 06 19:03:06 2010 +0000
@@ -28,3 +28,6 @@
 
 answerClient :: [B.ByteString] -> Reader (ClientIndex, IRnC) [Action]
 answerClient msg = thisClientChans >>= return . (: []) . flip AnswerClients msg
+
+allRoomInfos :: Reader (a, IRnC) [RoomInfo]
+allRoomInfos = liftM ((\irnc -> map (room irnc) $ allRooms irnc) . snd) ask
diff -r af8390d807d6 -r a3159a410e5c gameServer/RoomsAndClients.hs
--- a/gameServer/RoomsAndClients.hs	Sun Jun 06 15:29:33 2010 +0000
+++ b/gameServer/RoomsAndClients.hs	Sun Jun 06 19:03:06 2010 +0000
@@ -16,9 +16,12 @@
     clientRoom,
     clientRoomM,
     client,
+    room,
+    client'sM,
     clientsM,
+    withRoomsAndClients,
+    allRooms,
     allClients,
-    withRoomsAndClients,
     showRooms,
     roomClients
     ) where
@@ -89,10 +92,8 @@
 addClient :: MRoomsAndClients r c -> c -> IO ClientIndex
 addClient (MRoomsAndClients (rooms, clients)) client = do
     i <- addElem clients (Client lobbyId client)
-    modifyElem rooms (roomAddClient (ClientIndex i)) rid
+    modifyElem rooms (roomAddClient (ClientIndex i)) (unRoomIndex lobbyId)
     return $ ClientIndex i
-    where
-        rid = (\(RoomIndex i) -> i) lobbyId
 
 removeRoom :: MRoomsAndClients r c -> RoomIndex -> IO ()
 removeRoom rnc@(MRoomsAndClients (rooms, _)) room@(RoomIndex ri) 
@@ -136,9 +137,11 @@
 clientRoomM :: MRoomsAndClients r c -> ClientIndex -> IO RoomIndex
 clientRoomM (MRoomsAndClients (_, clients)) (ClientIndex ci) = liftM clientRoom' (clients `readElem` ci)
 
-clientsM :: MRoomsAndClients r c -> (c -> a) -> ClientIndex -> IO a
-clientsM (MRoomsAndClients (_, clients)) f (ClientIndex ci) = liftM (f . client') (clients `readElem` ci)
+client'sM :: MRoomsAndClients r c -> (c -> a) -> ClientIndex -> IO a
+client'sM (MRoomsAndClients (_, clients)) f (ClientIndex ci) = liftM (f . client') (clients `readElem` ci)
 
+clientsM :: MRoomsAndClients r c -> IO [c]
+clientsM (MRoomsAndClients (_, clients)) = indicesM clients >>= mapM (\ci -> liftM client' $ readElem clients ci)
 
 withRoomsAndClients :: MRoomsAndClients r c -> (IRoomsAndClients r c -> a) -> IO a
 withRoomsAndClients (MRoomsAndClients (rooms, clients)) f =
@@ -160,12 +163,14 @@
 allClients :: IRoomsAndClients r c -> [ClientIndex]
 allClients (IRoomsAndClients (_, clients)) = map ClientIndex $ indices clients
 
-
 clientRoom :: IRoomsAndClients r c -> ClientIndex -> RoomIndex
 clientRoom (IRoomsAndClients (_, clients)) (ClientIndex ci) = clientRoom' (clients ! ci)
 
 client :: IRoomsAndClients r c -> ClientIndex -> c
 client (IRoomsAndClients (_, clients)) (ClientIndex ci) = client' (clients ! ci)
 
+room :: IRoomsAndClients r c -> RoomIndex -> r
+room (IRoomsAndClients (rooms, _)) (RoomIndex ri) = room' (rooms ! ri)
+
 roomClients :: IRoomsAndClients r c -> RoomIndex -> [ClientIndex]
 roomClients (IRoomsAndClients (rooms, _)) (RoomIndex ri) = roomClients' $ (rooms ! ri)
diff -r af8390d807d6 -r a3159a410e5c gameServer/ServerState.hs
--- a/gameServer/ServerState.hs	Sun Jun 06 15:29:33 2010 +0000
+++ b/gameServer/ServerState.hs	Sun Jun 06 19:03:06 2010 +0000
@@ -3,7 +3,8 @@
     module RoomsAndClients,
     clientRoomA,
     ServerState(..),
-    clients
+    client's,
+    allClientsS
     ) where
 
 import Control.Monad.State
@@ -24,9 +25,11 @@
     rnc <- gets roomsClients
     liftIO $ clientRoomM rnc ci
 
-clients :: (ClientInfo -> a) -> StateT ServerState IO a
-clients f = do
+client's :: (ClientInfo -> a) -> StateT ServerState IO a
+client's f = do
     (Just ci) <- gets clientIndex
     rnc <- gets roomsClients
-    liftIO $ clientsM rnc f ci
-    
\ No newline at end of file
+    liftIO $ client'sM rnc f ci
+    
+allClientsS :: StateT ServerState IO [ClientInfo]
+allClientsS = gets roomsClients >>= liftIO . clientsM
\ No newline at end of file
diff -r af8390d807d6 -r a3159a410e5c gameServer/Store.hs
--- a/gameServer/Store.hs	Sun Jun 06 15:29:33 2010 +0000
+++ b/gameServer/Store.hs	Sun Jun 06 19:03:06 2010 +0000
@@ -9,6 +9,7 @@
     writeElem,
     modifyElem,
     firstIndex,
+    indicesM,
     withIStore,
     withIStore2,
     (!),
@@ -94,6 +95,12 @@
     IOA.readArray arr n >>= (IOA.writeArray arr n) . f
 
 
+indicesM :: MStore e -> IO [ElemIndex]
+indicesM (MStore ref) = do
+    (busy, _, _) <- readIORef ref
+    return $ map ElemIndex $ IntSet.toList busy
+
+
 -- A way to use see MStore elements in pure code via IStore
 m2i :: MStore e -> IO (IStore e)
 m2i (MStore ref) = do
@@ -101,6 +108,7 @@
     c <- IOA.unsafeFreeze c'
     return $ IStore (a, c)
 
+
 withIStore :: MStore e -> (IStore e -> a) -> IO a
 withIStore m f = liftM f (m2i m)
 
diff -r af8390d807d6 -r a3159a410e5c gameServer/Utils.hs
--- a/gameServer/Utils.hs	Sun Jun 06 15:29:33 2010 +0000
+++ b/gameServer/Utils.hs	Sun Jun 06 19:03:06 2010 +0000
@@ -119,3 +119,6 @@
     case f b of
         Right (a, new_b) -> let (a', b') = unfoldrE f new_b in (a : a', b')
         Left new_b       -> ([], new_b)
+
+showB :: Show a => a -> B.ByteString
+showB = B.pack .show