6 import Control.Concurrent |
6 import Control.Concurrent |
7 import Control.Concurrent.STM |
7 import Control.Concurrent.STM |
8 import Control.Exception (finally) |
8 import Control.Exception (finally) |
9 import Miscutils |
9 import Miscutils |
10 |
10 |
11 data ClientInfo = |
|
12 ClientInfo |
|
13 { |
|
14 handle :: Handle, |
|
15 nick :: String, |
|
16 game :: String, |
|
17 isMaster :: Bool |
|
18 } |
|
19 |
|
20 data RoomInfo = |
|
21 RoomInfo |
|
22 { |
|
23 name :: String, |
|
24 password :: String |
|
25 } |
|
26 |
|
27 |
11 |
28 handleCmd :: Handle -> TVar[ClientInfo] -> TVar[RoomInfo] -> (String, [String]) -> IO() |
12 handleCmd :: Handle -> TVar[ClientInfo] -> TVar[RoomInfo] -> (String, [String]) -> IO() |
29 handleCmd clientHandle clientsList roomsList ("SAY", param) = do |
13 handleCmd clientHandle clientsList roomsList ("SAY", param) = do |
30 ls <- atomically(readTVar clientsList) |
14 ls <- atomically(readTVar clientsList) |
31 sendOthers (map (\x -> handle x) ls) clientHandle (concat param) |
15 sendOthers (map (\x -> handle x) ls) clientHandle (concat param) |
32 return () |
16 return () |
33 |
17 |
34 handleCmd clientHandle clientsList roomsList ("CREATE", [roomname]) = do |
18 handleCmd clientHandle clientsList roomsList ("CREATE", [roomname]) = do |
35 manipState roomsList (\x -> (RoomInfo roomname ""):x) |
19 manipState2 clientsList roomsList (hcCreate) |
36 manipState clientsList (\x -> map (\xc -> if (clientHandle == handle xc) then xc{isMaster = True, game = roomname} else xc) x) |
|
37 sendMsg clientHandle ("JOINED " ++ roomname) |
20 sendMsg clientHandle ("JOINED " ++ roomname) |
|
21 where |
|
22 hcCreate ci ri = if (null $ filter (\ xr -> roomname == name xr) ri) then |
|
23 (map |
|
24 (\ xc |
|
25 -> if (clientHandle == handle xc) then |
|
26 xc {isMaster = True, room = roomname} |
|
27 else |
|
28 xc) |
|
29 ci, |
|
30 (RoomInfo roomname "") : ri) |
|
31 else |
|
32 (ci, ri) |
38 |
33 |
39 handleCmd clientHandle clientsList roomsList ("LIST", []) = do |
34 handleCmd clientHandle clientsList roomsList ("LIST", []) = do |
40 rl <- atomically $ readTVar roomsList |
35 rl <- atomically $ readTVar roomsList |
41 sendMsg clientHandle (unlines $ map (\x -> name x) rl) |
36 sendMsg clientHandle (unlines $ map (\x -> name x) rl) |
42 |
37 |
55 |
50 |
56 main = do |
51 main = do |
57 clientsList <- atomically $ newTVar[] |
52 clientsList <- atomically $ newTVar[] |
58 roomsList <- atomically $ newTVar[] |
53 roomsList <- atomically $ newTVar[] |
59 bracket |
54 bracket |
60 (listenOn $ PortNumber 46631) |
55 (listenOn $ Service "hedgewars") |
61 (sClose) |
56 (sClose) |
62 (loop clientsList roomsList) |
57 (loop clientsList roomsList) |
63 where |
58 where |
64 loop clist rlist sock = accept sock >>= addClient clist rlist >> loop clist rlist sock |
59 loop clist rlist sock = accept sock >>= addClient clist rlist >> loop clist rlist sock |
65 |
60 |