equal
deleted
inserted
replaced
3 import System.IO |
3 import System.IO |
4 import Control.Concurrent.Chan |
4 import Control.Concurrent.Chan |
5 import Control.Concurrent.STM |
5 import Control.Concurrent.STM |
6 import Data.Word |
6 import Data.Word |
7 import qualified Data.Map as Map |
7 import qualified Data.Map as Map |
8 import qualified Data.IntMap as IntMap |
|
9 import qualified Data.IntSet as IntSet |
8 import qualified Data.IntSet as IntSet |
10 import Data.Sequence(Seq, empty) |
9 import Data.Sequence(Seq, empty) |
11 import Data.Time |
10 import Data.Time |
12 import Network |
11 import Network |
13 import Data.Function |
12 import Data.Function |
14 |
13 |
15 import RoomsAndClients |
14 import RoomsAndClients |
16 |
15 |
|
16 type ClientChan = Chan [String] |
|
17 |
17 data ClientInfo = |
18 data ClientInfo = |
18 ClientInfo |
19 ClientInfo |
19 { |
20 { |
20 clientUID :: !Int, |
21 sendChan :: ClientChan, |
21 sendChan :: Chan [String], |
|
22 clientHandle :: Handle, |
22 clientHandle :: Handle, |
23 host :: String, |
23 host :: String, |
24 connectTime :: UTCTime, |
24 connectTime :: UTCTime, |
25 nick :: String, |
25 nick :: String, |
26 webPassword :: String, |
26 webPassword :: String, |
34 clientClan :: String, |
34 clientClan :: String, |
35 teamsInGame :: Word |
35 teamsInGame :: Word |
36 } |
36 } |
37 |
37 |
38 instance Show ClientInfo where |
38 instance Show ClientInfo where |
39 show ci = show (clientUID ci) |
39 show ci = " nick: " ++ (nick ci) ++ " host: " ++ (host ci) |
40 ++ " nick: " ++ (nick ci) |
|
41 ++ " host: " ++ (host ci) |
|
42 |
40 |
43 instance Eq ClientInfo where |
41 instance Eq ClientInfo where |
44 (==) = (==) `on` clientHandle |
42 (==) = (==) `on` clientHandle |
45 |
43 |
46 data HedgehogInfo = |
44 data HedgehogInfo = |
68 ++ "color: " ++ (teamcolor ti) |
66 ++ "color: " ++ (teamcolor ti) |
69 |
67 |
70 data RoomInfo = |
68 data RoomInfo = |
71 RoomInfo |
69 RoomInfo |
72 { |
70 { |
73 roomUID :: !Int, |
|
74 masterID :: !Int, |
71 masterID :: !Int, |
75 name :: String, |
72 name :: String, |
76 password :: String, |
73 password :: String, |
77 roomProto :: Word16, |
74 roomProto :: Word16, |
78 teams :: [TeamInfo], |
75 teams :: [TeamInfo], |
87 teamsAtStart :: [TeamInfo], |
84 teamsAtStart :: [TeamInfo], |
88 params :: Map.Map String [String] |
85 params :: Map.Map String [String] |
89 } |
86 } |
90 |
87 |
91 instance Show RoomInfo where |
88 instance Show RoomInfo where |
92 show ri = show (roomUID ri) |
89 show ri = ", players ids: " ++ show (IntSet.size $ playersIDs ri) |
93 ++ ", players ids: " ++ show (IntSet.size $ playersIDs ri) |
|
94 ++ ", players: " ++ show (playersIn ri) |
90 ++ ", players: " ++ show (playersIn ri) |
95 ++ ", ready: " ++ show (readyPlayers ri) |
91 ++ ", ready: " ++ show (readyPlayers ri) |
96 ++ ", teams: " ++ show (teams ri) |
92 ++ ", teams: " ++ show (teams ri) |
97 |
93 |
98 instance Eq RoomInfo where |
94 newRoom :: RoomInfo |
99 (==) = (==) `on` roomUID |
|
100 |
|
101 newRoom = ( |
95 newRoom = ( |
102 RoomInfo |
96 RoomInfo |
103 0 |
|
104 0 |
97 0 |
105 "" |
98 "" |
106 "" |
99 "" |
107 0 |
100 0 |
108 [] |
101 [] |
142 coreChan :: Chan CoreMessage, |
135 coreChan :: Chan CoreMessage, |
143 dbQueries :: Chan DBQuery |
136 dbQueries :: Chan DBQuery |
144 } |
137 } |
145 |
138 |
146 instance Show ServerInfo where |
139 instance Show ServerInfo where |
147 show si = "Server Info" |
140 show _ = "Server Info" |
148 |
141 |
|
142 newServerInfo :: TMVar StatisticsInfo -> Chan CoreMessage -> Chan DBQuery -> ServerInfo |
149 newServerInfo = ( |
143 newServerInfo = ( |
150 ServerInfo |
144 ServerInfo |
151 True |
145 True |
152 "<h2><p align=center><a href=\"http://www.hedgewars.org/\">http://www.hedgewars.org/</a></p></h2>" |
146 "<h2><p align=center><a href=\"http://www.hedgewars.org/\">http://www.hedgewars.org/</a></p></h2>" |
153 "<font color=yellow><h3 align=center>Hedgewars 0.9.13 is out! Please update.</h3><p align=center><a href=http://hedgewars.org/download.html>Download page here</a></font>" |
147 "<font color=yellow><h3 align=center>Hedgewars 0.9.13 is out! Please update.</h3><p align=center><a href=http://hedgewars.org/download.html>Download page here</a></font>" |
165 | Guest |
159 | Guest |
166 | Admin |
160 | Admin |
167 deriving (Show, Read) |
161 deriving (Show, Read) |
168 |
162 |
169 data DBQuery = |
163 data DBQuery = |
170 CheckAccount Int String String |
164 CheckAccount ClientIndex String String |
171 | ClearCache |
165 | ClearCache |
172 | SendStats Int Int |
166 | SendStats Int Int |
173 deriving (Show, Read) |
167 deriving (Show, Read) |
174 |
168 |
175 data CoreMessage = |
169 data CoreMessage = |
176 Accept ClientInfo |
170 Accept ClientInfo |
177 | ClientMessage (Int, [String]) |
171 | ClientMessage (ClientIndex, [String]) |
178 | ClientAccountInfo (Int, AccountInfo) |
172 | ClientAccountInfo (ClientIndex, AccountInfo) |
179 | TimerAction Int |
173 | TimerAction Int |
180 |
174 |
181 type MRnC = MRoomsAndClients RoomInfo ClientInfo |
175 type MRnC = MRoomsAndClients RoomInfo ClientInfo |
182 type IRnC = IRoomsAndClients RoomInfo ClientInfo |
176 type IRnC = IRoomsAndClients RoomInfo ClientInfo |
183 |
177 |
184 --type ClientsTransform = [ClientInfo] -> [ClientInfo] |
|
185 --type RoomsTransform = [RoomInfo] -> [RoomInfo] |
|
186 --type HandlesSelector = ClientInfo -> [ClientInfo] -> [RoomInfo] -> [ClientInfo] |
|
187 --type Answer = ServerInfo -> (HandlesSelector, [String]) |
|
188 |
|
189 --type ClientsSelector = Clients -> Rooms -> [Int] |
|