gameServer/ServerState.hs
author unc0rr
Mon, 10 May 2010 17:48:06 +0000
changeset 3458 11cd56019f00
child 3501 a3159a410e5c
permissions -rw-r--r--
Make some more protocol commands work
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
3458
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
     1
module ServerState
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
     2
    (
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
     3
    module RoomsAndClients,
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
     4
    clientRoomA,
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
     5
    ServerState(..),
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
     6
    clients
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
     7
    ) where
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
     8
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
     9
import Control.Monad.State
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    10
----------------------
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    11
import RoomsAndClients
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    12
import CoreTypes
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    13
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    14
data ServerState = ServerState {
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    15
        clientIndex :: Maybe ClientIndex,
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    16
        serverInfo :: ServerInfo,
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    17
        roomsClients :: MRnC
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    18
    }
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    19
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    20
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    21
clientRoomA :: StateT ServerState IO RoomIndex
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    22
clientRoomA = do
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    23
    (Just ci) <- gets clientIndex
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    24
    rnc <- gets roomsClients
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    25
    liftIO $ clientRoomM rnc ci
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    26
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    27
clients :: (ClientInfo -> a) -> StateT ServerState IO a
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    28
clients f = do
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    29
    (Just ci) <- gets clientIndex
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    30
    rnc <- gets roomsClients
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    31
    liftIO $ clientsM rnc f ci
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    32