gameServer/HandlerUtils.hs
author koda
Sat, 05 Feb 2011 22:22:16 +0100
changeset 4924 616b618814b5
parent 4614 26661bf28dd5
child 4932 f11d80bac7ed
permissions -rw-r--r--
show dual head mode some love
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
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
     9
import Actions
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
26661bf28dd5 Reimplement some more protocol commands
unc0rr
parents: 3568
diff changeset
    37
    let thisClan = clientClan cl
26661bf28dd5 Reimplement some more protocol commands
unc0rr
parents: 3568
diff changeset
    38
    let sameClanClients = Prelude.filter (\c -> teamsInGame cl > 0 && clientClan c == thisClan) otherRoomClients
26661bf28dd5 Reimplement some more protocol commands
unc0rr
parents: 3568
diff changeset
    39
    let spectators = Prelude.filter (\c -> teamsInGame c == 0) otherRoomClients
26661bf28dd5 Reimplement some more protocol commands
unc0rr
parents: 3568
diff changeset
    40
    let sameClanOrSpec = if teamsInGame cl > 0 then sameClanClients else spectators
26661bf28dd5 Reimplement some more protocol commands
unc0rr
parents: 3568
diff changeset
    41
    return $ map sendChan sameClanOrSpec
26661bf28dd5 Reimplement some more protocol commands
unc0rr
parents: 3568
diff changeset
    42
3543
d84a93b985c1 Reimplement TOGGLE_READY command
unc0rr
parents: 3542
diff changeset
    43
roomClientsChans :: Reader (ClientIndex, IRnC) [ClientChan]
d84a93b985c1 Reimplement TOGGLE_READY command
unc0rr
parents: 3542
diff changeset
    44
roomClientsChans = do
d84a93b985c1 Reimplement TOGGLE_READY command
unc0rr
parents: 3542
diff changeset
    45
    (ci, rnc) <- ask
d84a93b985c1 Reimplement TOGGLE_READY command
unc0rr
parents: 3542
diff changeset
    46
    let ri = clientRoom rnc ci
d84a93b985c1 Reimplement TOGGLE_READY command
unc0rr
parents: 3542
diff changeset
    47
    return $ map (sendChan . client rnc) (roomClients rnc ri)
d84a93b985c1 Reimplement TOGGLE_READY command
unc0rr
parents: 3542
diff changeset
    48
3435
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    49
thisClientChans :: Reader (ClientIndex, IRnC) [ClientChan]
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    50
thisClientChans = do
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    51
    (ci, rnc) <- ask
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    52
    return $ [sendChan (rnc `client` ci)]
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    53
3500
af8390d807d6 Use sockets instead of handles, use bytestrings instead of strings
unc0rr
parents: 3435
diff changeset
    54
answerClient :: [B.ByteString] -> Reader (ClientIndex, IRnC) [Action]
3435
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    55
answerClient msg = thisClientChans >>= return . (: []) . flip AnswerClients msg
3501
a3159a410e5c Reimplement more core actions
unc0rr
parents: 3500
diff changeset
    56
a3159a410e5c Reimplement more core actions
unc0rr
parents: 3500
diff changeset
    57
allRoomInfos :: Reader (a, IRnC) [RoomInfo]
a3159a410e5c Reimplement more core actions
unc0rr
parents: 3500
diff changeset
    58
allRoomInfos = liftM ((\irnc -> map (room irnc) $ allRooms irnc) . snd) ask
4614
26661bf28dd5 Reimplement some more protocol commands
unc0rr
parents: 3568
diff changeset
    59
26661bf28dd5 Reimplement some more protocol commands
unc0rr
parents: 3568
diff changeset
    60
clientByNick :: B.ByteString -> Reader (ClientIndex, IRnC) (Maybe ClientIndex)
26661bf28dd5 Reimplement some more protocol commands
unc0rr
parents: 3568
diff changeset
    61
clientByNick n = do
26661bf28dd5 Reimplement some more protocol commands
unc0rr
parents: 3568
diff changeset
    62
    (_, rnc) <- ask
26661bf28dd5 Reimplement some more protocol commands
unc0rr
parents: 3568
diff changeset
    63
    let allClientIDs = allClients rnc
26661bf28dd5 Reimplement some more protocol commands
unc0rr
parents: 3568
diff changeset
    64
    return $ find (\clId -> n == nick (client rnc clId)) allClientIDs
26661bf28dd5 Reimplement some more protocol commands
unc0rr
parents: 3568
diff changeset
    65