gameServer/NetRoutines.hs
branch0.9.14
changeset 4242 5e3c5fe2cb14
parent 3502 ad38c653b7d9
child 4295 1f5604cd99be
--- a/gameServer/NetRoutines.hs	Thu Nov 11 11:04:24 2010 -0500
+++ b/gameServer/NetRoutines.hs	Thu Nov 11 22:17:54 2010 +0300
@@ -1,41 +1,46 @@
-{-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 module NetRoutines where
 
+import Network
 import Network.Socket
 import System.IO
+import Control.Concurrent
 import Control.Concurrent.Chan
+import Control.Concurrent.STM
 import qualified Control.Exception as Exception
 import Data.Time
-import Control.Monad
 -----------------------------
 import CoreTypes
+import ClientIO
 import Utils
-import RoomsAndClients
 
-acceptLoop :: Socket -> Chan CoreMessage -> IO ()
-acceptLoop servSock chan = forever $ do
+acceptLoop :: Socket -> Chan CoreMessage -> Int -> IO ()
+acceptLoop servSock coreChan clientCounter = do
     Exception.handle
         (\(_ :: Exception.IOException) -> putStrLn "exception on connect") $
         do
-        (sock, sockAddr) <- Network.Socket.accept servSock
+        (socket, sockAddr) <- Network.Socket.accept servSock
 
+        cHandle <- socketToHandle socket ReadWriteMode
+        hSetBuffering cHandle LineBuffering
         clientHost <- sockAddr2String sockAddr
 
         currentTime <- getCurrentTime
-
-        sendChan' <- newChan
+        
+        sendChan <- newChan
 
         let newClient =
                 (ClientInfo
-                    sendChan'
-                    sock
+                    nextID
+                    sendChan
+                    cHandle
                     clientHost
                     currentTime
                     ""
                     ""
                     False
                     0
-                    lobbyId
+                    0
                     0
                     False
                     False
@@ -44,5 +49,12 @@
                     undefined
                     )
 
-        writeChan chan $ Accept newClient
+        writeChan coreChan $ Accept newClient
+
+        forkIO $ clientRecvLoop cHandle coreChan nextID
+        forkIO $ clientSendLoop cHandle coreChan sendChan nextID
         return ()
+
+    acceptLoop servSock coreChan nextID
+    where
+        nextID = clientCounter + 1