--- 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"