gameServer/NetRoutines.hs
changeset 4588 5ef5415c4ee1
parent 4568 f85243bf890e
child 4905 7842d085acf4
--- a/gameServer/NetRoutines.hs	Tue Dec 14 22:32:47 2010 +0100
+++ b/gameServer/NetRoutines.hs	Thu Dec 23 17:47:50 2010 +0100
@@ -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