gameServer/HandlerUtils.hs
author koda
Thu, 24 Mar 2011 17:28:36 +0100
changeset 5046 fc6639d56799
parent 4989 4771fed9272e
child 6541 08ed346ed341
permissions -rw-r--r--
this brings compatibility up with SDL HEAD (5504), but maybe breaks compatibility with sdl 1.2 so please test! still has problems with keyboard input and rendered ttf textures
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
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
4989
4771fed9272e - Write server config into .ini file on change
unc0rr
parents: 4986
diff changeset
    51
answerClient :: [B.ByteString] -> Reader (ClientIndex, IRnC) [Action]
4932
f11d80bac7ed - Take into account hlint suggestions
unc0rr
parents: 4614
diff changeset
    52
answerClient msg = liftM ((: []) . flip AnswerClients msg) thisClientChans
3501
a3159a410e5c Reimplement more core actions
unc0rr
parents: 3500
diff changeset
    53
a3159a410e5c Reimplement more core actions
unc0rr
parents: 3500
diff changeset
    54
allRoomInfos :: Reader (a, IRnC) [RoomInfo]
a3159a410e5c Reimplement more core actions
unc0rr
parents: 3500
diff changeset
    55
allRoomInfos = liftM ((\irnc -> map (room irnc) $ allRooms irnc) . snd) ask
4614
26661bf28dd5 Reimplement some more protocol commands
unc0rr
parents: 3568
diff changeset
    56
26661bf28dd5 Reimplement some more protocol commands
unc0rr
parents: 3568
diff changeset
    57
clientByNick :: B.ByteString -> Reader (ClientIndex, IRnC) (Maybe ClientIndex)
26661bf28dd5 Reimplement some more protocol commands
unc0rr
parents: 3568
diff changeset
    58
clientByNick n = do
26661bf28dd5 Reimplement some more protocol commands
unc0rr
parents: 3568
diff changeset
    59
    (_, rnc) <- ask
26661bf28dd5 Reimplement some more protocol commands
unc0rr
parents: 3568
diff changeset
    60
    let allClientIDs = allClients rnc
26661bf28dd5 Reimplement some more protocol commands
unc0rr
parents: 3568
diff changeset
    61
    return $ find (\clId -> n == nick (client rnc clId)) allClientIDs
26661bf28dd5 Reimplement some more protocol commands
unc0rr
parents: 3568
diff changeset
    62