--- a/netserver/hedgewars-server.hs Tue Nov 04 17:04:54 2008 +0000
+++ b/netserver/hedgewars-server.hs Tue Nov 04 21:53:30 2008 +0000
@@ -57,7 +57,7 @@
sendAnswers [] _ clients _ = return clients
sendAnswers ((handlesFunc, answer):answers) client clients rooms = do
let recipients = handlesFunc client clients rooms
- unless (null recipients) $ putStrLn ("< " ++ (show answer))
+ --unless (null recipients) $ putStrLn ("< " ++ (show answer))
clHandles' <- forM recipients $
\ch -> Control.Exception.handle
@@ -82,7 +82,7 @@
reactCmd :: [String] -> ClientInfo -> [ClientInfo] -> [RoomInfo] -> IO ([ClientInfo], [RoomInfo])
reactCmd cmd client clients rooms = do
- putStrLn ("> " ++ show cmd)
+ --putStrLn ("> " ++ show cmd)
let (clientsFunc, roomsFunc, answers) = handleCmd client clients rooms $ cmd
let mrooms = roomsFunc rooms
@@ -91,12 +91,18 @@
clientsIn <- sendAnswers answers mclient mclients mrooms
let quitClient = find forceQuit $ clientsIn
- if isJust quitClient then reactCmd ["QUIT"] (fromJust quitClient) clientsIn mrooms else return (clientsIn, mrooms)
+ if isJust quitClient then
+ reactCmd ["QUIT"] (fromJust quitClient) clientsIn mrooms
+ else
+ return (clientsIn, mrooms)
mainLoop :: Socket -> TChan ClientInfo -> TChan [String] -> [ClientInfo] -> [RoomInfo] -> IO ()
mainLoop servSock acceptChan messagesChan clients rooms = do
- r <- atomically $ (Accept `fmap` readTChan acceptChan) `orElse` (ClientMessage `fmap` tselect clients) `orElse` (CoreMessage `fmap` readTChan messagesChan)
+ r <- atomically $
+ (Accept `fmap` readTChan acceptChan) `orElse`
+ (ClientMessage `fmap` tselect clients) `orElse`
+ (CoreMessage `fmap` readTChan messagesChan)
case r of
Accept ci ->
mainLoop servSock acceptChan messagesChan (clients ++ [ci]) rooms
@@ -106,8 +112,9 @@
let hadRooms = (not $ null rooms) && (null mrooms)
in unless ((not $ isDedicated globalOptions) && ((null clientsIn) || hadRooms)) $
mainLoop servSock acceptChan messagesChan clientsIn mrooms
- CoreMessage msg -> if not $ null $ clients then
- do
+ CoreMessage msg ->
+ if not $ null $ clients then
+ do
let client = head clients -- don't care
(clientsIn, mrooms) <- reactCmd msg client clients rooms
mainLoop servSock acceptChan messagesChan clientsIn mrooms