gameServer/ServerState.hs
author nemo
Mon, 06 Sep 2010 18:22:48 -0400
changeset 3837 47a623d9cdaa
parent 3807 7e4f7ed41790
child 4601 08ae94dd4c0d
permissions -rw-r--r--
Fix selection while in UFO
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
3741
73246d25dfe1 Add some more strictness, use unsafeThaw and unsafeFreeze functions which work at O(1)
unc0rr
parents: 3645
diff changeset
    11
import Control.Monad.State.Strict
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 {
3807
7e4f7ed41790 zero span is undefined, use -1 instead
unc0rr
parents: 3741
diff changeset
    18
        clientIndex :: !(Maybe ClientIndex),
7e4f7ed41790 zero span is undefined, use -1 instead
unc0rr
parents: 3741
diff changeset
    19
        serverInfo :: !ServerInfo,
7e4f7ed41790 zero span is undefined, use -1 instead
unc0rr
parents: 3741
diff changeset
    20
        removedClients :: !(Set.Set ClientIndex),
7e4f7ed41790 zero span is undefined, use -1 instead
unc0rr
parents: 3741
diff changeset
    21
        roomsClients :: !MRnC
3458
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