author | sheepluva |
Mon, 15 Dec 2014 15:24:26 +0100 | |
changeset 10674 | fddbab2eecea |
parent 10460 | 8dcea9087d75 |
child 11046 | 47a8c19ecb60 |
permissions | -rw-r--r-- |
10460
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
9973
diff
changeset
|
1 |
{- |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
9973
diff
changeset
|
2 |
* Hedgewars, a free turn based strategy game |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
9973
diff
changeset
|
3 |
* Copyright (c) 2004-2014 Andrey Korotaev <unC0Rr@gmail.com> |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
9973
diff
changeset
|
4 |
* |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
9973
diff
changeset
|
5 |
* This program is free software; you can redistribute it and/or modify |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
9973
diff
changeset
|
6 |
* it under the terms of the GNU General Public License as published by |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
9973
diff
changeset
|
7 |
* the Free Software Foundation; version 2 of the License |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
9973
diff
changeset
|
8 |
* |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
9973
diff
changeset
|
9 |
* This program is distributed in the hope that it will be useful, |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
9973
diff
changeset
|
10 |
* but WITHOUT ANY WARRANTY; without even the implied warranty of |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
9973
diff
changeset
|
11 |
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
9973
diff
changeset
|
12 |
* GNU General Public License for more details. |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
9973
diff
changeset
|
13 |
* |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
9973
diff
changeset
|
14 |
* You should have received a copy of the GNU General Public License |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
9973
diff
changeset
|
15 |
* along with this program; if not, write to the Free Software |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
9973
diff
changeset
|
16 |
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
9973
diff
changeset
|
17 |
\-} |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
9973
diff
changeset
|
18 |
|
3458 | 19 |
module ServerState |
20 |
( |
|
21 |
module RoomsAndClients, |
|
9973
7589978c9912
Stub for joins monitor which is a replacement to plain ban for 10 seconds system after join
unc0rr
parents:
8452
diff
changeset
|
22 |
module JoinsMonitor, |
3458 | 23 |
clientRoomA, |
24 |
ServerState(..), |
|
3501 | 25 |
client's, |
3502 | 26 |
allClientsS, |
8452 | 27 |
allRoomsS, |
4601 | 28 |
roomClientsS, |
6541
08ed346ed341
Send full room info on room add and update events. Less(?) traffic, but current frontend doesn't behave good with this change to server.
unc0rr
parents:
4989
diff
changeset
|
29 |
sameProtoClientsS, |
4601 | 30 |
io |
3458 | 31 |
) where |
32 |
||
3741
73246d25dfe1
Add some more strictness, use unsafeThaw and unsafeFreeze functions which work at O(1)
unc0rr
parents:
3645
diff
changeset
|
33 |
import Control.Monad.State.Strict |
6541
08ed346ed341
Send full room info on room add and update events. Less(?) traffic, but current frontend doesn't behave good with this change to server.
unc0rr
parents:
4989
diff
changeset
|
34 |
import Data.Set as Set(Set) |
08ed346ed341
Send full room info on room add and update events. Less(?) traffic, but current frontend doesn't behave good with this change to server.
unc0rr
parents:
4989
diff
changeset
|
35 |
import Data.Word |
3458 | 36 |
---------------------- |
37 |
import RoomsAndClients |
|
38 |
import CoreTypes |
|
9973
7589978c9912
Stub for joins monitor which is a replacement to plain ban for 10 seconds system after join
unc0rr
parents:
8452
diff
changeset
|
39 |
import JoinsMonitor |
3458 | 40 |
|
4989 | 41 |
data ServerState = ServerState { |
3807 | 42 |
clientIndex :: !(Maybe ClientIndex), |
4989 | 43 |
serverInfo :: !ServerInfo, |
3807 | 44 |
removedClients :: !(Set.Set ClientIndex), |
9973
7589978c9912
Stub for joins monitor which is a replacement to plain ban for 10 seconds system after join
unc0rr
parents:
8452
diff
changeset
|
45 |
roomsClients :: !MRnC, |
7589978c9912
Stub for joins monitor which is a replacement to plain ban for 10 seconds system after join
unc0rr
parents:
8452
diff
changeset
|
46 |
joinsMonitor :: !JoinsMonitor |
3458 | 47 |
} |
48 |
||
49 |
||
4989 | 50 |
clientRoomA :: StateT ServerState IO RoomIndex |
3458 | 51 |
clientRoomA = do |
52 |
(Just ci) <- gets clientIndex |
|
53 |
rnc <- gets roomsClients |
|
4622 | 54 |
io $ clientRoomM rnc ci |
3458 | 55 |
|
4989 | 56 |
client's :: (ClientInfo -> a) -> StateT ServerState IO a |
3501 | 57 |
client's f = do |
3458 | 58 |
(Just ci) <- gets clientIndex |
59 |
rnc <- gets roomsClients |
|
4622 | 60 |
io $ client'sM rnc f ci |
3645 | 61 |
|
4989 | 62 |
allClientsS :: StateT ServerState IO [ClientInfo] |
3502 | 63 |
allClientsS = gets roomsClients >>= liftIO . clientsM |
64 |
||
8452 | 65 |
allRoomsS :: StateT ServerState IO [RoomInfo] |
66 |
allRoomsS = gets roomsClients >>= liftIO . roomsM |
|
67 |
||
4989 | 68 |
roomClientsS :: RoomIndex -> StateT ServerState IO [ClientInfo] |
3502 | 69 |
roomClientsS ri = do |
70 |
rnc <- gets roomsClients |
|
4622 | 71 |
io $ roomClientsM rnc ri |
4601 | 72 |
|
6541
08ed346ed341
Send full room info on room add and update events. Less(?) traffic, but current frontend doesn't behave good with this change to server.
unc0rr
parents:
4989
diff
changeset
|
73 |
sameProtoClientsS :: Word16 -> StateT ServerState IO [ClientInfo] |
08ed346ed341
Send full room info on room add and update events. Less(?) traffic, but current frontend doesn't behave good with this change to server.
unc0rr
parents:
4989
diff
changeset
|
74 |
sameProtoClientsS p = liftM f allClientsS |
08ed346ed341
Send full room info on room add and update events. Less(?) traffic, but current frontend doesn't behave good with this change to server.
unc0rr
parents:
4989
diff
changeset
|
75 |
where |
08ed346ed341
Send full room info on room add and update events. Less(?) traffic, but current frontend doesn't behave good with this change to server.
unc0rr
parents:
4989
diff
changeset
|
76 |
f = filter (\c -> clientProto c == p) |
8371 | 77 |
|
4989 | 78 |
io :: IO a -> StateT ServerState IO a |
4601 | 79 |
io = liftIO |