| author | Vittorio Giovara <vittorio.giovara@gmail.com> |
| Fri, 03 Jan 2014 05:58:18 -0800 | |
| changeset 9918 | ca90e470333b |
| parent 9433 | f0a8ac191839 |
| child 10194 | 7025bd3c3131 |
| permissions | -rw-r--r-- |
| 3435 | 1 |
module HandlerUtils where |
2 |
||
3 |
import Control.Monad.Reader |
|
|
3500
af8390d807d6
Use sockets instead of handles, use bytestrings instead of strings
unc0rr
parents:
3435
diff
changeset
|
4 |
import qualified Data.ByteString.Char8 as B |
| 4614 | 5 |
import Data.List |
| 3435 | 6 |
|
7 |
import RoomsAndClients |
|
8 |
import CoreTypes |
|
|
9109
878f06e9c484
- Fix issue 521 by resending FULLMAPCONFIG on game finish to those who joined mid-game. Semitested.
unc0rr
parents:
6541
diff
changeset
|
9 |
|
| 3435 | 10 |
|
11 |
thisClient :: Reader (ClientIndex, IRnC) ClientInfo |
|
12 |
thisClient = do |
|
13 |
(ci, rnc) <- ask |
|
14 |
return $ rnc `client` ci |
|
15 |
||
| 3568 | 16 |
thisRoom :: Reader (ClientIndex, IRnC) RoomInfo |
17 |
thisRoom = do |
|
18 |
(ci, rnc) <- ask |
|
19 |
let ri = clientRoom rnc ci |
|
20 |
return $ rnc `room` ri |
|
21 |
||
|
3500
af8390d807d6
Use sockets instead of handles, use bytestrings instead of strings
unc0rr
parents:
3435
diff
changeset
|
22 |
clientNick :: Reader (ClientIndex, IRnC) B.ByteString |
| 3435 | 23 |
clientNick = liftM nick thisClient |
24 |
||
25 |
roomOthersChans :: Reader (ClientIndex, IRnC) [ClientChan] |
|
26 |
roomOthersChans = do |
|
27 |
(ci, rnc) <- ask |
|
28 |
let ri = clientRoom rnc ci |
|
| 3542 | 29 |
return $ map (sendChan . client rnc) $ filter (/= ci) (roomClients rnc ri) |
| 3435 | 30 |
|
| 4614 | 31 |
roomSameClanChans :: Reader (ClientIndex, IRnC) [ClientChan] |
32 |
roomSameClanChans = do |
|
33 |
(ci, rnc) <- ask |
|
34 |
let ri = clientRoom rnc ci |
|
35 |
let otherRoomClients = map (client rnc) . filter (/= ci) $ roomClients rnc ri |
|
36 |
let cl = rnc `client` ci |
|
|
4986
33fe91b2bcbf
Use Maybe for storing client's clan, allows less error-prone spectator checks
unc0rr
parents:
4975
diff
changeset
|
37 |
let sameClanClients = Prelude.filter (\c -> clientClan c == clientClan cl) otherRoomClients |
|
33fe91b2bcbf
Use Maybe for storing client's clan, allows less error-prone spectator checks
unc0rr
parents:
4975
diff
changeset
|
38 |
return $ map sendChan sameClanClients |
| 4614 | 39 |
|
| 3543 | 40 |
roomClientsChans :: Reader (ClientIndex, IRnC) [ClientChan] |
41 |
roomClientsChans = do |
|
42 |
(ci, rnc) <- ask |
|
43 |
let ri = clientRoom rnc ci |
|
44 |
return $ map (sendChan . client rnc) (roomClients rnc ri) |
|
45 |
||
| 3435 | 46 |
thisClientChans :: Reader (ClientIndex, IRnC) [ClientChan] |
47 |
thisClientChans = do |
|
48 |
(ci, rnc) <- ask |
|
| 4932 | 49 |
return [sendChan (rnc `client` ci)] |
| 3435 | 50 |
|
|
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
|
51 |
sameProtoChans :: Reader (ClientIndex, IRnC) [ClientChan] |
|
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 |
sameProtoChans = do |
|
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 |
(ci, rnc) <- ask |
|
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 |
let p = clientProto (rnc `client` ci) |
|
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 |
return . map sendChan . filter (\c -> clientProto c == p) . map (client rnc) $ allClients rnc |
|
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
|
56 |
|
| 4989 | 57 |
answerClient :: [B.ByteString] -> Reader (ClientIndex, IRnC) [Action] |
| 4932 | 58 |
answerClient msg = liftM ((: []) . flip AnswerClients msg) thisClientChans |
| 3501 | 59 |
|
60 |
allRoomInfos :: Reader (a, IRnC) [RoomInfo] |
|
61 |
allRoomInfos = liftM ((\irnc -> map (room irnc) $ allRooms irnc) . snd) ask |
|
| 4614 | 62 |
|
63 |
clientByNick :: B.ByteString -> Reader (ClientIndex, IRnC) (Maybe ClientIndex) |
|
64 |
clientByNick n = do |
|
65 |
(_, rnc) <- ask |
|
66 |
let allClientIDs = allClients rnc |
|
| 9433 | 67 |
return $ find (\clId -> let cl = client rnc clId in n == nick cl && not (isChecker cl)) allClientIDs |
| 4614 | 68 |