gameServer/HandlerUtils.hs
author nemo
Sat, 01 Mar 2014 14:52:36 -0500
changeset 10171 00f41ff0bf2d
parent 9433 f0a8ac191839
child 10194 7025bd3c3131
permissions -rw-r--r--
Script might well override a static map, but can't risk it not doing it, and preview completely failing. Better to just not try it for static maps. Some script cfg might help. Could also avoid unnnecessary preview regenerations even if the script was doing nothing at all.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
3435
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
     1
module HandlerUtils where
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
     2
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
     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
26661bf28dd5 Reimplement some more protocol commands
unc0rr
parents: 3568
diff changeset
     5
import Data.List
3435
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
     6
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
     7
import RoomsAndClients
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
     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
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    10
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    11
thisClient :: Reader (ClientIndex, IRnC) ClientInfo
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    12
thisClient = do
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    13
    (ci, rnc) <- ask
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    14
    return $ rnc `client` ci
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    15
3568
ae89cf0735dc A bunch of reimplemented commands
unc0rr
parents: 3543
diff changeset
    16
thisRoom :: Reader (ClientIndex, IRnC) RoomInfo
ae89cf0735dc A bunch of reimplemented commands
unc0rr
parents: 3543
diff changeset
    17
thisRoom = do
ae89cf0735dc A bunch of reimplemented commands
unc0rr
parents: 3543
diff changeset
    18
    (ci, rnc) <- ask
ae89cf0735dc A bunch of reimplemented commands
unc0rr
parents: 3543
diff changeset
    19
    let ri = clientRoom rnc ci
ae89cf0735dc A bunch of reimplemented commands
unc0rr
parents: 3543
diff changeset
    20
    return $ rnc `room` ri
ae89cf0735dc A bunch of reimplemented commands
unc0rr
parents: 3543
diff changeset
    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
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    23
clientNick = liftM nick thisClient
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    24
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    25
roomOthersChans :: Reader (ClientIndex, IRnC) [ClientChan]
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    26
roomOthersChans = do
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    27
    (ci, rnc) <- ask
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    28
    let ri = clientRoom rnc ci
3542
f216b24aeb7f - Fix a function
unc0rr
parents: 3501
diff changeset
    29
    return $ map (sendChan . client rnc) $ filter (/= ci) (roomClients rnc ri)
3435
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    30
4614
26661bf28dd5 Reimplement some more protocol commands
unc0rr
parents: 3568
diff changeset
    31
roomSameClanChans :: Reader (ClientIndex, IRnC) [ClientChan]
26661bf28dd5 Reimplement some more protocol commands
unc0rr
parents: 3568
diff changeset
    32
roomSameClanChans = do
26661bf28dd5 Reimplement some more protocol commands
unc0rr
parents: 3568
diff changeset
    33
    (ci, rnc) <- ask
26661bf28dd5 Reimplement some more protocol commands
unc0rr
parents: 3568
diff changeset
    34
    let ri = clientRoom rnc ci
26661bf28dd5 Reimplement some more protocol commands
unc0rr
parents: 3568
diff changeset
    35
    let otherRoomClients = map (client rnc) . filter (/= ci) $ roomClients rnc ri
26661bf28dd5 Reimplement some more protocol commands
unc0rr
parents: 3568
diff changeset
    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
26661bf28dd5 Reimplement some more protocol commands
unc0rr
parents: 3568
diff changeset
    39
3543
d84a93b985c1 Reimplement TOGGLE_READY command
unc0rr
parents: 3542
diff changeset
    40
roomClientsChans :: Reader (ClientIndex, IRnC) [ClientChan]
d84a93b985c1 Reimplement TOGGLE_READY command
unc0rr
parents: 3542
diff changeset
    41
roomClientsChans = do
d84a93b985c1 Reimplement TOGGLE_READY command
unc0rr
parents: 3542
diff changeset
    42
    (ci, rnc) <- ask
d84a93b985c1 Reimplement TOGGLE_READY command
unc0rr
parents: 3542
diff changeset
    43
    let ri = clientRoom rnc ci
d84a93b985c1 Reimplement TOGGLE_READY command
unc0rr
parents: 3542
diff changeset
    44
    return $ map (sendChan . client rnc) (roomClients rnc ri)
d84a93b985c1 Reimplement TOGGLE_READY command
unc0rr
parents: 3542
diff changeset
    45
3435
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    46
thisClientChans :: Reader (ClientIndex, IRnC) [ClientChan]
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    47
thisClientChans = do
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    48
    (ci, rnc) <- ask
4932
f11d80bac7ed - Take into account hlint suggestions
unc0rr
parents: 4614
diff changeset
    49
    return [sendChan (rnc `client` ci)]
3435
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    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
4771fed9272e - Write server config into .ini file on change
unc0rr
parents: 4986
diff changeset
    57
answerClient :: [B.ByteString] -> Reader (ClientIndex, IRnC) [Action]
4932
f11d80bac7ed - Take into account hlint suggestions
unc0rr
parents: 4614
diff changeset
    58
answerClient msg = liftM ((: []) . flip AnswerClients msg) thisClientChans
3501
a3159a410e5c Reimplement more core actions
unc0rr
parents: 3500
diff changeset
    59
a3159a410e5c Reimplement more core actions
unc0rr
parents: 3500
diff changeset
    60
allRoomInfos :: Reader (a, IRnC) [RoomInfo]
a3159a410e5c Reimplement more core actions
unc0rr
parents: 3500
diff changeset
    61
allRoomInfos = liftM ((\irnc -> map (room irnc) $ allRooms irnc) . snd) ask
4614
26661bf28dd5 Reimplement some more protocol commands
unc0rr
parents: 3568
diff changeset
    62
26661bf28dd5 Reimplement some more protocol commands
unc0rr
parents: 3568
diff changeset
    63
clientByNick :: B.ByteString -> Reader (ClientIndex, IRnC) (Maybe ClientIndex)
26661bf28dd5 Reimplement some more protocol commands
unc0rr
parents: 3568
diff changeset
    64
clientByNick n = do
26661bf28dd5 Reimplement some more protocol commands
unc0rr
parents: 3568
diff changeset
    65
    (_, rnc) <- ask
26661bf28dd5 Reimplement some more protocol commands
unc0rr
parents: 3568
diff changeset
    66
    let allClientIDs = allClients rnc
9433
f0a8ac191839 Push demo to idle checker on game finish
unc0rr
parents: 9109
diff changeset
    67
    return $ find (\clId -> let cl = client rnc clId in n == nick cl && not (isChecker cl)) allClientIDs
4614
26661bf28dd5 Reimplement some more protocol commands
unc0rr
parents: 3568
diff changeset
    68