netserver/newhwserv.hs
changeset 890 1d8c4a5ec622
parent 889 3bf9dc791f45
child 891 701f86df9b4c
--- a/netserver/newhwserv.hs	Wed Apr 30 16:50:28 2008 +0000
+++ b/netserver/newhwserv.hs	Wed Apr 30 19:44:54 2008 +0000
@@ -6,8 +6,10 @@
 import Control.Concurrent
 import Control.Concurrent.STM
 import Control.Exception (finally)
-import Control.Monad (forM, filterM, liftM)
+import Control.Monad (forM, forM_, filterM, liftM)
+import Data.List
 import Miscutils
+import HWProto
 
 acceptLoop :: Socket -> TChan ClientInfo -> IO ()
 acceptLoop servSock acceptChan = do
@@ -36,15 +38,21 @@
 	case r of
 		Left ci -> do
 			mainLoop servSock acceptChan (ci:clients) rooms
-		Right (line, clhandle) -> do
-			--handleCmd handle line
-			clients' <- forM clients $
+		Right (line, client) -> do
+			let (doQuit, toMe, strs) = handleCmd client sameRoom rooms line
+
+			clients' <- forM sameRoom $
 					\ci -> do
-						hPutStrLn (handle ci) line
-						hFlush (handle ci)
-						return [ci]
-					`catch` const (hClose (handle ci) >> return [])
-			mainLoop servSock acceptChan (concat clients') rooms
+						if (handle ci /= handle client) || toMe then do
+							forM_ strs (\str -> hPutStrLn (handle ci) str)
+							hFlush (handle ci)
+							return []
+							else if doQuit then return [ci] else return []
+					`catch` const (hClose (handle ci) >> return [ci])
+
+			mainLoop servSock acceptChan (deleteFirstsBy (\ a b -> handle a == handle b) clients (concat clients')) rooms
+			where
+				sameRoom = filter (\cl -> room cl == room client) clients
 
 startServer serverSocket = do
 	acceptChan <- atomically newTChan