|
1 module CoreTypes where |
|
2 |
|
3 import System.IO |
|
4 import Control.Concurrent.Chan |
|
5 import Control.Concurrent.STM |
|
6 import Data.Word |
|
7 import qualified Data.Map as Map |
|
8 import qualified Data.IntMap as IntMap |
|
9 import qualified Data.IntSet as IntSet |
|
10 import Data.Sequence(Seq, empty) |
|
11 import Network |
|
12 |
|
13 data ClientInfo = |
|
14 ClientInfo |
|
15 { |
|
16 clientUID :: Int, |
|
17 sendChan :: Chan [String], |
|
18 clientHandle :: Handle, |
|
19 host :: String, |
|
20 nick :: String, |
|
21 clientProto :: Word16, |
|
22 roomID :: Int, |
|
23 isMaster :: Bool, |
|
24 isReady :: Bool, |
|
25 forceQuit :: Bool, |
|
26 partRoom :: Bool |
|
27 } |
|
28 |
|
29 instance Show ClientInfo where |
|
30 show ci = show $ clientUID ci |
|
31 |
|
32 instance Eq ClientInfo where |
|
33 a1 == a2 = clientHandle a1 == clientHandle a2 |
|
34 |
|
35 data HedgehogInfo = |
|
36 HedgehogInfo String String |
|
37 |
|
38 data TeamInfo = |
|
39 TeamInfo |
|
40 { |
|
41 teamowner :: String, |
|
42 teamname :: String, |
|
43 teamcolor :: String, |
|
44 teamgrave :: String, |
|
45 teamfort :: String, |
|
46 teamvoicepack :: String, |
|
47 difficulty :: Int, |
|
48 hhnum :: Int, |
|
49 hedgehogs :: [HedgehogInfo] |
|
50 } |
|
51 |
|
52 data RoomInfo = |
|
53 RoomInfo |
|
54 { |
|
55 roomUID :: Int, |
|
56 name :: String, |
|
57 password :: String, |
|
58 roomProto :: Word16, |
|
59 teams :: [TeamInfo], |
|
60 gameinprogress :: Bool, |
|
61 playersIn :: !Int, |
|
62 readyPlayers :: Int, |
|
63 playersIDs :: IntSet.IntSet, |
|
64 isRestrictedJoins :: Bool, |
|
65 isRestrictedTeams :: Bool, |
|
66 roundMsgs :: Seq String, |
|
67 leftTeams :: [String], |
|
68 teamsAtStart :: [TeamInfo], |
|
69 params :: Map.Map String [String] |
|
70 } |
|
71 |
|
72 instance Show RoomInfo where |
|
73 show ri = (show $ roomUID ri) |
|
74 ++ ", players ids: " ++ (show $ IntSet.size $ playersIDs ri) |
|
75 ++ ", players: " ++ (show $ playersIn ri) |
|
76 |
|
77 instance Eq RoomInfo where |
|
78 a1 == a2 = roomUID a1 == roomUID a2 |
|
79 |
|
80 newRoom = ( |
|
81 RoomInfo |
|
82 0 |
|
83 "" |
|
84 "" |
|
85 0 |
|
86 [] |
|
87 False |
|
88 0 |
|
89 0 |
|
90 IntSet.empty |
|
91 False |
|
92 False |
|
93 Data.Sequence.empty |
|
94 [] |
|
95 [] |
|
96 (Map.singleton "MAP" ["+rnd+"]) |
|
97 ) |
|
98 |
|
99 data StatisticsInfo = |
|
100 StatisticsInfo |
|
101 { |
|
102 playersNumber :: Int, |
|
103 roomsNumber :: Int |
|
104 } |
|
105 |
|
106 data DBQuery = |
|
107 HasRegistered String |
|
108 | CheckPassword String |
|
109 |
|
110 data ServerInfo = |
|
111 ServerInfo |
|
112 { |
|
113 isDedicated :: Bool, |
|
114 serverMessage :: String, |
|
115 adminPassword :: String, |
|
116 listenPort :: PortNumber, |
|
117 loginsNumber :: Int, |
|
118 nextRoomID :: Int, |
|
119 stats :: TMVar StatisticsInfo |
|
120 --dbQueries :: TChan DBQuery |
|
121 } |
|
122 |
|
123 instance Show ServerInfo where |
|
124 show si = "Logins: " ++ (show $ loginsNumber si) |
|
125 |
|
126 newServerInfo = ( |
|
127 ServerInfo |
|
128 True |
|
129 "<h2><p align=center><a href=\"http://www.hedgewars.org/\">http://www.hedgewars.org/</a></p></h2>" |
|
130 "" |
|
131 46631 |
|
132 0 |
|
133 0 |
|
134 ) |
|
135 |
|
136 data CoreMessage = |
|
137 Accept ClientInfo |
|
138 | ClientMessage (Int, [String]) |
|
139 -- | CoreMessage String |
|
140 -- | TimerTick |
|
141 |
|
142 |
|
143 type Clients = IntMap.IntMap ClientInfo |
|
144 type Rooms = IntMap.IntMap RoomInfo |
|
145 |
|
146 --type ClientsTransform = [ClientInfo] -> [ClientInfo] |
|
147 --type RoomsTransform = [RoomInfo] -> [RoomInfo] |
|
148 --type HandlesSelector = ClientInfo -> [ClientInfo] -> [RoomInfo] -> [ClientInfo] |
|
149 --type Answer = ServerInfo -> (HandlesSelector, [String]) |
|
150 |
|
151 type ClientsSelector = Clients -> Rooms -> [Int] |