gameServer/ServerState.hs
author sheepluva
Wed, 16 Jun 2010 21:14:23 +0200
changeset 3508 a7ca07614a2d
parent 3502 ad38c653b7d9
child 3566 772a46ef8288
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:
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(..),
3501
a3159a410e5c Reimplement more core actions
unc0rr
parents: 3458
diff changeset
     6
    client's,
3502
ad38c653b7d9 Some more progress
unc0rr
parents: 3501
diff changeset
     7
    allClientsS,
ad38c653b7d9 Some more progress
unc0rr
parents: 3501
diff changeset
     8
    roomClientsS
3458
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
     9
    ) where
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 Control.Monad.State
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    12
----------------------
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    13
import RoomsAndClients
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    14
import CoreTypes
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    15
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    16
data ServerState = ServerState {
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    17
        clientIndex :: Maybe ClientIndex,
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    18
        serverInfo :: ServerInfo,
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    19
        roomsClients :: MRnC
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    20
    }
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    21
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    22
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    23
clientRoomA :: StateT ServerState IO RoomIndex
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    24
clientRoomA = do
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    25
    (Just ci) <- gets clientIndex
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    26
    rnc <- gets roomsClients
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    27
    liftIO $ clientRoomM rnc ci
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    28
3501
a3159a410e5c Reimplement more core actions
unc0rr
parents: 3458
diff changeset
    29
client's :: (ClientInfo -> a) -> StateT ServerState IO a
a3159a410e5c Reimplement more core actions
unc0rr
parents: 3458
diff changeset
    30
client's f = do
3458
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    31
    (Just ci) <- gets clientIndex
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    32
    rnc <- gets roomsClients
3501
a3159a410e5c Reimplement more core actions
unc0rr
parents: 3458
diff changeset
    33
    liftIO $ client'sM rnc f ci
a3159a410e5c Reimplement more core actions
unc0rr
parents: 3458
diff changeset
    34
    
a3159a410e5c Reimplement more core actions
unc0rr
parents: 3458
diff changeset
    35
allClientsS :: StateT ServerState IO [ClientInfo]
3502
ad38c653b7d9 Some more progress
unc0rr
parents: 3501
diff changeset
    36
allClientsS = gets roomsClients >>= liftIO . clientsM
ad38c653b7d9 Some more progress
unc0rr
parents: 3501
diff changeset
    37
ad38c653b7d9 Some more progress
unc0rr
parents: 3501
diff changeset
    38
roomClientsS :: RoomIndex -> StateT ServerState IO [ClientInfo]
ad38c653b7d9 Some more progress
unc0rr
parents: 3501
diff changeset
    39
roomClientsS ri = do
ad38c653b7d9 Some more progress
unc0rr
parents: 3501
diff changeset
    40
    rnc <- gets roomsClients
ad38c653b7d9 Some more progress
unc0rr
parents: 3501
diff changeset
    41
    liftIO $ roomClientsM rnc ri
ad38c653b7d9 Some more progress
unc0rr
parents: 3501
diff changeset
    42