Some work on newhwserv
authorunc0rr
Wed, 30 Apr 2008 16:50:28 +0000
changeset 889 3bf9dc791f45
parent 888 9b2abea1071f
child 890 1d8c4a5ec622
Some work on newhwserv
CMakeLists.txt
hedgewars/hwengine.dpr
netserver/Miscutils.hs
netserver/newhwserv.hs
--- a/CMakeLists.txt	Sun Apr 27 16:51:28 2008 +0000
+++ b/CMakeLists.txt	Wed Apr 30 16:50:28 2008 +0000
@@ -73,6 +73,7 @@
 	"^${PROJECT_SOURCE_DIR}/bin/[a-z]"
 	"^${PROJECT_SOURCE_DIR}/tools"
 	"^${PROJECT_SOURCE_DIR}/doc"
+	"^${PROJECT_SOURCE_DIR}/netserver"
 	"^${PROJECT_SOURCE_DIR}/misc"
 	"^${PROJECT_SOURCE_DIR}/templates"
 	"^${PROJECT_SOURCE_DIR}/Graphics"
--- a/hedgewars/hwengine.dpr	Sun Apr 27 16:51:28 2008 +0000
+++ b/hedgewars/hwengine.dpr	Wed Apr 30 16:50:28 2008 +0000
@@ -177,7 +177,7 @@
 
 ////////////////////
 procedure GetParams;
-var 
+var
 {$IFDEF DEBUGFILE}
     i: LongInt;
 {$ENDIF}
--- a/netserver/Miscutils.hs	Sun Apr 27 16:51:28 2008 +0000
+++ b/netserver/Miscutils.hs	Wed Apr 30 16:50:28 2008 +0000
@@ -9,6 +9,7 @@
 data ClientInfo =
 	ClientInfo
 	{
+		chan :: TChan String,
 		handle :: Handle,
 		nick :: String,
 		room :: String,
@@ -51,4 +52,7 @@
 			writeTVar state1 ol1
 			writeTVar state2 ol2
 			return res
-	
+
+tselect :: [ClientInfo] -> STM (String, Handle)
+tselect = foldl orElse retry . map (\ci -> (flip (,) (handle ci)) `fmap` readTChan (chan ci))
+
--- a/netserver/newhwserv.hs	Sun Apr 27 16:51:28 2008 +0000
+++ b/netserver/newhwserv.hs	Wed Apr 30 16:50:28 2008 +0000
@@ -9,14 +9,12 @@
 import Control.Monad (forM, filterM, liftM)
 import Miscutils
 
-type Client = (TChan String, Handle)
-
-acceptLoop :: Socket -> TChan Client -> IO ()
+acceptLoop :: Socket -> TChan ClientInfo -> IO ()
 acceptLoop servSock acceptChan = do
 	(cHandle, host, port) <- accept servSock
 	cChan <- atomically newTChan
 	forkIO $ clientLoop cHandle cChan
-	atomically $ writeTChan acceptChan (cChan, cHandle)
+	atomically $ writeTChan acceptChan (ClientInfo cChan cHandle "" "" False)
 	acceptLoop servSock acceptChan
 
 listenLoop :: Handle -> TChan String -> IO ()
@@ -32,28 +30,26 @@
 		`finally` hClose handle
 	where clientOff = atomically $ writeTChan chan "QUIT"
 
-mainLoop :: Socket -> TChan Client -> [Client] -> IO ()
-mainLoop servSock acceptChan clients = do
+mainLoop :: Socket -> TChan ClientInfo -> [ClientInfo] -> [RoomInfo] -> IO ()
+mainLoop servSock acceptChan clients rooms = do
 	r <- atomically $ (Left `fmap` readTChan acceptChan) `orElse` (Right `fmap` tselect clients)
 	case r of
-		Left (ch, h) -> do
-			mainLoop servSock acceptChan $ (ch, h):clients
-		Right (line, handle) -> do
+		Left ci -> do
+			mainLoop servSock acceptChan (ci:clients) rooms
+		Right (line, clhandle) -> do
+			--handleCmd handle line
 			clients' <- forM clients $
-					\(ch, h) -> do
-						hPutStrLn h line
-						hFlush h
-						return [(ch,h)]
-					`catch` const (hClose h >> return [])
-			mainLoop servSock acceptChan $ concat clients'
-
-tselect :: [(TChan a, t)] -> STM (a, t)
-tselect = foldl orElse retry . map (\(ch, ty) -> (flip (,) ty) `fmap` readTChan ch)
+					\ci -> do
+						hPutStrLn (handle ci) line
+						hFlush (handle ci)
+						return [ci]
+					`catch` const (hClose (handle ci) >> return [])
+			mainLoop servSock acceptChan (concat clients') rooms
 
 startServer serverSocket = do
 	acceptChan <- atomically newTChan
 	forkIO $ acceptLoop serverSocket acceptChan
-	mainLoop serverSocket acceptChan []
+	mainLoop serverSocket acceptChan [] []
 
 main = withSocketsDo $ do
 	serverSocket <- listenOn $ Service "hedgewars"