--- a/gameServer/Actions.hs Thu Mar 20 22:14:30 2014 +0400
+++ b/gameServer/Actions.hs Sun Mar 23 23:35:33 2014 +0400
@@ -34,9 +34,7 @@
import ConfigFile
import EngineInteraction
import FloodDetection
-
-
-type CmdHandler = [B.ByteString] -> Reader (ClientIndex, IRnC) [Action]
+import HWProtoCore
othersChans :: StateT ServerState IO [ClientChan]
@@ -798,3 +796,10 @@
processAction (RegisterEvent e) = do
actions <- registerEvent e
mapM_ processAction actions
+
+
+processAction (ReactCmd cmd) = do
+ (Just ci) <- gets clientIndex
+ rnc <- gets roomsClients
+ actions <- liftIO $ withRoomsAndClients rnc (\irnc -> runReader (handleCmd cmd) (ci, irnc))
+ forM_ (actions `deepseq` actions) processAction
--- a/gameServer/CoreTypes.hs Thu Mar 20 22:14:30 2014 +0400
+++ b/gameServer/CoreTypes.hs Sun Mar 23 23:35:33 2014 +0400
@@ -81,6 +81,7 @@
| RegisterEvent Event
| SaveRoom B.ByteString
| LoadRoom B.ByteString
+ | ReactCmd [B.ByteString]
data Event = LobbyChatMessage
@@ -91,7 +92,7 @@
newEventsInfo :: EventsInfo
newEventsInfo = []
-
+
type ClientChan = Chan [B.ByteString]
data CheckInfo =
--- a/gameServer/HWProtoChecker.hs Thu Mar 20 22:14:30 2014 +0400
+++ b/gameServer/HWProtoChecker.hs Sun Mar 23 23:35:33 2014 +0400
@@ -5,7 +5,6 @@
import Control.Monad.Reader
--------------------------------------
import CoreTypes
-import Actions
import HandlerUtils
--- a/gameServer/HWProtoCore.hs Thu Mar 20 22:14:30 2014 +0400
+++ b/gameServer/HWProtoCore.hs Sun Mar 23 23:35:33 2014 +0400
@@ -6,7 +6,6 @@
import qualified Data.ByteString.Char8 as B
--------------------------------------
import CoreTypes
-import Actions
import HWProtoNEState
import HWProtoLobbyState
import HWProtoInRoomState
--- a/gameServer/HWProtoInRoomState.hs Thu Mar 20 22:14:30 2014 +0400
+++ b/gameServer/HWProtoInRoomState.hs Sun Mar 23 23:35:33 2014 +0400
@@ -9,7 +9,6 @@
import Control.Monad.Reader
--------------------------------------
import CoreTypes
-import Actions
import Utils
import HandlerUtils
import RoomsAndClients
@@ -398,6 +397,12 @@
return [AnswerClients [sendChan cl] ["CHAT", "[server]", "callvote kick: no such user"]]
+handleCmd_inRoom ["CALLVOTE", "MAP"] = do
+ cl <- thisClient
+ s <- liftM (Map.keys . roomSaves) thisRoom
+ return [AnswerClients [sendChan cl] ["CHAT", "[server]", B.concat ["callvote map: ", B.intercalate ", " s]]]
+
+
handleCmd_inRoom ["CALLVOTE", "MAP", roomSave] = do
cl <- thisClient
rm <- thisRoom
--- a/gameServer/HWProtoLobbyState.hs Thu Mar 20 22:14:30 2014 +0400
+++ b/gameServer/HWProtoLobbyState.hs Sun Mar 23 23:35:33 2014 +0400
@@ -7,7 +7,6 @@
import qualified Data.ByteString.Char8 as B
--------------------------------------
import CoreTypes
-import Actions
import Utils
import HandlerUtils
import RoomsAndClients
--- a/gameServer/HWProtoNEState.hs Thu Mar 20 22:14:30 2014 +0400
+++ b/gameServer/HWProtoNEState.hs Sun Mar 23 23:35:33 2014 +0400
@@ -7,9 +7,9 @@
import Data.Digest.Pure.SHA
--------------------------------------
import CoreTypes
-import Actions
import Utils
import RoomsAndClients
+import HandlerUtils
handleCmd_NotEntered :: CmdHandler
--- a/gameServer/HandlerUtils.hs Thu Mar 20 22:14:30 2014 +0400
+++ b/gameServer/HandlerUtils.hs Sun Mar 23 23:35:33 2014 +0400
@@ -8,6 +8,8 @@
import CoreTypes
+type CmdHandler = [B.ByteString] -> Reader (ClientIndex, IRnC) [Action]
+
thisClient :: Reader (ClientIndex, IRnC) ClientInfo
thisClient = do
(ci, rnc) <- ask
--- a/gameServer/ServerCore.hs Thu Mar 20 22:14:30 2014 +0400
+++ b/gameServer/ServerCore.hs Sun Mar 23 23:35:33 2014 +0400
@@ -6,14 +6,11 @@
import Control.Monad.Reader
import Control.Monad.State.Strict
import Data.Set as Set
-import qualified Data.ByteString.Char8 as B
-import Control.DeepSeq
import Data.Unique
import Data.Maybe
--------------------------------------
import CoreTypes
import NetRoutines
-import HWProtoCore
import Actions
import OfficialServer.DBInteraction
import ServerState
@@ -23,13 +20,6 @@
timerLoop tick messagesChan = threadDelay 30000000 >> writeChan messagesChan (TimerAction tick) >> timerLoop (tick + 1) messagesChan
-reactCmd :: [B.ByteString] -> StateT ServerState IO ()
-reactCmd cmd = do
- (Just ci) <- gets clientIndex
- rnc <- gets roomsClients
- actions <- liftIO $ withRoomsAndClients rnc (\irnc -> runReader (handleCmd cmd) (ci, irnc))
- forM_ (actions `deepseq` actions) processAction
-
mainLoop :: StateT ServerState IO ()
mainLoop = forever $ do
-- get >>= \s -> put $! s
@@ -46,7 +36,7 @@
removed <- gets removedClients
unless (ci `Set.member` removed) $ do
modify (\s -> s{clientIndex = Just ci})
- reactCmd cmd
+ processAction $ ReactCmd cmd
Remove ci ->
processAction (DeleteClient ci)
--- a/gameServer/Votes.hs Thu Mar 20 22:14:30 2014 +0400
+++ b/gameServer/Votes.hs Sun Mar 23 23:35:33 2014 +0400
@@ -31,7 +31,7 @@
where
actOnVoting :: Voting -> Reader (ClientIndex, IRnC) [Action]
actOnVoting vt = do
- let (contra, pro) = L.partition snd $ votes vt
+ let (pro, contra) = L.partition snd $ votes vt
let v = (length $ entitledToVote vt) `div` 2 + 1
if length contra >= v then
@@ -67,7 +67,7 @@
let rs = Map.lookup roomSave (roomSaves rm)
case rs of
Nothing -> return []
- Just (mp, p) -> return [ModifyRoom $ \r -> r{params = p, mapParams = mp}]
+ Just (mp, p) -> return [Warning "ye!", ModifyRoom $ \r -> r{params = p, mapParams = mp}]
startVote :: VoteType -> Reader (ClientIndex, IRnC) [Action]
@@ -82,9 +82,11 @@
if isJust $ voting rm then
return []
else
- liftM ([ModifyRoom (\r -> r{voting = Just (newVoting vt){entitledToVote = uids}})
- , AnswerClients chans ["CHAT", "[server]", B.concat [loc "New voting started", ": ", voteInfo vt]]
- ] ++ ) $ voted True
+ return [
+ ModifyRoom (\r -> r{voting = Just (newVoting vt){entitledToVote = uids}})
+ , AnswerClients chans ["CHAT", "[server]", B.concat [loc "New voting started", ": ", voteInfo vt]]
+ , ReactCmd ["VOTE", "YES"]
+ ]
checkVotes :: StateT ServerState IO ()