gameServer/ServerState.hs
author smaxx
Thu, 12 Aug 2010 23:15:11 +0200
changeset 3736 d8982f9e7e2c
parent 3645 c0b3f1bb9316
child 3741 73246d25dfe1
permissions -rw-r--r--
Engine: * Added script access to current zoom level
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
3566
772a46ef8288 Properly handle client exit
unc0rr
parents: 3502
diff changeset
    12
import Data.Set as Set
3458
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    13
----------------------
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    14
import RoomsAndClients
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    15
import CoreTypes
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    16
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    17
data ServerState = ServerState {
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    18
        clientIndex :: Maybe ClientIndex,
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    19
        serverInfo :: ServerInfo,
3566
772a46ef8288 Properly handle client exit
unc0rr
parents: 3502
diff changeset
    20
        removedClients :: Set.Set ClientIndex,
3458
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    21
        roomsClients :: MRnC
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    22
    }
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    23
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    24
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    25
clientRoomA :: StateT ServerState IO RoomIndex
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    26
clientRoomA = do
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    27
    (Just ci) <- gets clientIndex
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    28
    rnc <- gets roomsClients
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    29
    liftIO $ clientRoomM rnc ci
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    30
3501
a3159a410e5c Reimplement more core actions
unc0rr
parents: 3458
diff changeset
    31
client's :: (ClientInfo -> a) -> StateT ServerState IO a
a3159a410e5c Reimplement more core actions
unc0rr
parents: 3458
diff changeset
    32
client's f = do
3458
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    33
    (Just ci) <- gets clientIndex
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    34
    rnc <- gets roomsClients
3501
a3159a410e5c Reimplement more core actions
unc0rr
parents: 3458
diff changeset
    35
    liftIO $ client'sM rnc f ci
3645
c0b3f1bb9316 Reimplement REMOVE_TEAM
unc0rr
parents: 3566
diff changeset
    36
3501
a3159a410e5c Reimplement more core actions
unc0rr
parents: 3458
diff changeset
    37
allClientsS :: StateT ServerState IO [ClientInfo]
3502
ad38c653b7d9 Some more progress
unc0rr
parents: 3501
diff changeset
    38
allClientsS = gets roomsClients >>= liftIO . clientsM
ad38c653b7d9 Some more progress
unc0rr
parents: 3501
diff changeset
    39
ad38c653b7d9 Some more progress
unc0rr
parents: 3501
diff changeset
    40
roomClientsS :: RoomIndex -> StateT ServerState IO [ClientInfo]
ad38c653b7d9 Some more progress
unc0rr
parents: 3501
diff changeset
    41
roomClientsS ri = do
ad38c653b7d9 Some more progress
unc0rr
parents: 3501
diff changeset
    42
    rnc <- gets roomsClients
ad38c653b7d9 Some more progress
unc0rr
parents: 3501
diff changeset
    43
    liftIO $ roomClientsM rnc ri