gameServer/NetRoutines.hs
changeset 2867 9be6693c78cb
parent 2403 6c5d504af2ba
child 3425 ead2ed20dfd4
equal deleted inserted replaced
2866:450ca0afcd58 2867:9be6693c78cb
    14 import ClientIO
    14 import ClientIO
    15 import Utils
    15 import Utils
    16 
    16 
    17 acceptLoop :: Socket -> Chan CoreMessage -> Int -> IO ()
    17 acceptLoop :: Socket -> Chan CoreMessage -> Int -> IO ()
    18 acceptLoop servSock coreChan clientCounter = do
    18 acceptLoop servSock coreChan clientCounter = do
    19 	Exception.handle
    19     Exception.handle
    20 		(\(_ :: Exception.IOException) -> putStrLn "exception on connect") $
    20         (\(_ :: Exception.IOException) -> putStrLn "exception on connect") $
    21 		do
    21         do
    22 		(socket, sockAddr) <- Network.Socket.accept servSock
    22         (socket, sockAddr) <- Network.Socket.accept servSock
    23 
    23 
    24 		cHandle <- socketToHandle socket ReadWriteMode
    24         cHandle <- socketToHandle socket ReadWriteMode
    25 		hSetBuffering cHandle LineBuffering
    25         hSetBuffering cHandle LineBuffering
    26 		clientHost <- sockAddr2String sockAddr
    26         clientHost <- sockAddr2String sockAddr
    27 
    27 
    28 		currentTime <- getCurrentTime
    28         currentTime <- getCurrentTime
    29 		
    29         
    30 		sendChan <- newChan
    30         sendChan <- newChan
    31 
    31 
    32 		let newClient =
    32         let newClient =
    33 				(ClientInfo
    33                 (ClientInfo
    34 					nextID
    34                     nextID
    35 					sendChan
    35                     sendChan
    36 					cHandle
    36                     cHandle
    37 					clientHost
    37                     clientHost
    38 					currentTime
    38                     currentTime
    39 					""
    39                     ""
    40 					""
    40                     ""
    41 					False
    41                     False
    42 					0
    42                     0
    43 					0
    43                     0
    44 					0
    44                     0
    45 					False
    45                     False
    46 					False
    46                     False
    47 					False
    47                     False
    48 					undefined
    48                     undefined
    49 					undefined
    49                     undefined
    50 					)
    50                     )
    51 
    51 
    52 		writeChan coreChan $ Accept newClient
    52         writeChan coreChan $ Accept newClient
    53 
    53 
    54 		forkIO $ clientRecvLoop cHandle coreChan nextID
    54         forkIO $ clientRecvLoop cHandle coreChan nextID
    55 		forkIO $ clientSendLoop cHandle coreChan sendChan nextID
    55         forkIO $ clientSendLoop cHandle coreChan sendChan nextID
    56 		return ()
    56         return ()
    57 
    57 
    58 	acceptLoop servSock coreChan nextID
    58     acceptLoop servSock coreChan nextID
    59 	where
    59     where
    60 		nextID = clientCounter + 1
    60         nextID = clientCounter + 1