gameServer/ServerState.hs
author nemo
Sat, 04 Dec 2010 11:30:54 -0500
changeset 4455 a0c8779713f2
parent 3807 7e4f7ed41790
child 4601 08ae94dd4c0d
permissions -rw-r--r--
In AI survival mode, have the AI score when it kills humans, instead of its own team, clear poison on an AI kill, and reset AI health using InitialHealth instead of 100.
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