author | koda |
Thu, 04 Apr 2013 01:38:30 +0200 | |
branch | webgl |
changeset 8850 | ae8a957c69fd |
parent 8452 | 170afc3ac39f |
child 9973 | 7589978c9912 |
permissions | -rw-r--r-- |
3458 | 1 |
module ServerState |
2 |
( |
|
3 |
module RoomsAndClients, |
|
4 |
clientRoomA, |
|
5 |
ServerState(..), |
|
3501 | 6 |
client's, |
3502 | 7 |
allClientsS, |
8452 | 8 |
allRoomsS, |
4601 | 9 |
roomClientsS, |
6541
08ed346ed341
Send full room info on room add and update events. Less(?) traffic, but current frontend doesn't behave good with this change to server.
unc0rr
parents:
4989
diff
changeset
|
10 |
sameProtoClientsS, |
4601 | 11 |
io |
3458 | 12 |
) where |
13 |
||
3741
73246d25dfe1
Add some more strictness, use unsafeThaw and unsafeFreeze functions which work at O(1)
unc0rr
parents:
3645
diff
changeset
|
14 |
import Control.Monad.State.Strict |
6541
08ed346ed341
Send full room info on room add and update events. Less(?) traffic, but current frontend doesn't behave good with this change to server.
unc0rr
parents:
4989
diff
changeset
|
15 |
import Data.Set as Set(Set) |
08ed346ed341
Send full room info on room add and update events. Less(?) traffic, but current frontend doesn't behave good with this change to server.
unc0rr
parents:
4989
diff
changeset
|
16 |
import Data.Word |
3458 | 17 |
---------------------- |
18 |
import RoomsAndClients |
|
19 |
import CoreTypes |
|
20 |
||
4989 | 21 |
data ServerState = ServerState { |
3807 | 22 |
clientIndex :: !(Maybe ClientIndex), |
4989 | 23 |
serverInfo :: !ServerInfo, |
3807 | 24 |
removedClients :: !(Set.Set ClientIndex), |
25 |
roomsClients :: !MRnC |
|
3458 | 26 |
} |
27 |
||
28 |
||
4989 | 29 |
clientRoomA :: StateT ServerState IO RoomIndex |
3458 | 30 |
clientRoomA = do |
31 |
(Just ci) <- gets clientIndex |
|
32 |
rnc <- gets roomsClients |
|
4622 | 33 |
io $ clientRoomM rnc ci |
3458 | 34 |
|
4989 | 35 |
client's :: (ClientInfo -> a) -> StateT ServerState IO a |
3501 | 36 |
client's f = do |
3458 | 37 |
(Just ci) <- gets clientIndex |
38 |
rnc <- gets roomsClients |
|
4622 | 39 |
io $ client'sM rnc f ci |
3645 | 40 |
|
4989 | 41 |
allClientsS :: StateT ServerState IO [ClientInfo] |
3502 | 42 |
allClientsS = gets roomsClients >>= liftIO . clientsM |
43 |
||
8452 | 44 |
allRoomsS :: StateT ServerState IO [RoomInfo] |
45 |
allRoomsS = gets roomsClients >>= liftIO . roomsM |
|
46 |
||
4989 | 47 |
roomClientsS :: RoomIndex -> StateT ServerState IO [ClientInfo] |
3502 | 48 |
roomClientsS ri = do |
49 |
rnc <- gets roomsClients |
|
4622 | 50 |
io $ roomClientsM rnc ri |
4601 | 51 |
|
6541
08ed346ed341
Send full room info on room add and update events. Less(?) traffic, but current frontend doesn't behave good with this change to server.
unc0rr
parents:
4989
diff
changeset
|
52 |
sameProtoClientsS :: Word16 -> StateT ServerState IO [ClientInfo] |
08ed346ed341
Send full room info on room add and update events. Less(?) traffic, but current frontend doesn't behave good with this change to server.
unc0rr
parents:
4989
diff
changeset
|
53 |
sameProtoClientsS p = liftM f allClientsS |
08ed346ed341
Send full room info on room add and update events. Less(?) traffic, but current frontend doesn't behave good with this change to server.
unc0rr
parents:
4989
diff
changeset
|
54 |
where |
08ed346ed341
Send full room info on room add and update events. Less(?) traffic, but current frontend doesn't behave good with this change to server.
unc0rr
parents:
4989
diff
changeset
|
55 |
f = filter (\c -> clientProto c == p) |
8371 | 56 |
|
4989 | 57 |
io :: IO a -> StateT ServerState IO a |
4601 | 58 |
io = liftIO |