gameServer/HandlerUtils.hs
author sheepluva
Wed, 16 Jun 2010 21:14:23 +0200
changeset 3508 a7ca07614a2d
parent 3501 a3159a410e5c
child 3542 f216b24aeb7f
permissions -rw-r--r--
correct cake sit-down animation so that it doesn't sit down in mid-air anymore
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
3435
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
     5
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
     6
import RoomsAndClients
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
     7
import CoreTypes
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
     8
import Actions
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
     9
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    10
thisClient :: Reader (ClientIndex, IRnC) ClientInfo
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    11
thisClient = do
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    12
    (ci, rnc) <- ask
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    13
    return $ rnc `client` ci
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    14
3500
af8390d807d6 Use sockets instead of handles, use bytestrings instead of strings
unc0rr
parents: 3435
diff changeset
    15
clientNick :: Reader (ClientIndex, IRnC) B.ByteString
3435
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    16
clientNick = liftM nick thisClient
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    17
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    18
roomOthersChans :: Reader (ClientIndex, IRnC) [ClientChan]
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    19
roomOthersChans = do
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    20
    (ci, rnc) <- ask
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    21
    let ri = clientRoom rnc ci
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    22
    return $ map (sendChan . client rnc) (roomClients rnc ri)
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    23
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    24
thisClientChans :: Reader (ClientIndex, IRnC) [ClientChan]
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    25
thisClientChans = do
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    26
    (ci, rnc) <- ask
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    27
    return $ [sendChan (rnc `client` ci)]
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    28
3500
af8390d807d6 Use sockets instead of handles, use bytestrings instead of strings
unc0rr
parents: 3435
diff changeset
    29
answerClient :: [B.ByteString] -> Reader (ClientIndex, IRnC) [Action]
3435
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    30
answerClient msg = thisClientChans >>= return . (: []) . flip AnswerClients msg
3501
a3159a410e5c Reimplement more core actions
unc0rr
parents: 3500
diff changeset
    31
a3159a410e5c Reimplement more core actions
unc0rr
parents: 3500
diff changeset
    32
allRoomInfos :: Reader (a, IRnC) [RoomInfo]
a3159a410e5c Reimplement more core actions
unc0rr
parents: 3500
diff changeset
    33
allRoomInfos = liftM ((\irnc -> map (room irnc) $ allRooms irnc) . snd) ask