--- a/gameServer/Actions.hs Thu Mar 20 13:12:05 2014 -0400
+++ b/gameServer/Actions.hs Sat Mar 29 14:02:05 2014 -0400
@@ -34,10 +34,8 @@
import ConfigFile
import EngineInteraction
import FloodDetection
-
-
-type CmdHandler = [B.ByteString] -> Reader (ClientIndex, IRnC) [Action]
-
+import HWProtoCore
+import Votes
othersChans :: StateT ServerState IO [ClientChan]
othersChans = do
@@ -798,3 +796,13 @@
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
+
+processAction CheckVotes =
+ checkVotes >>= mapM_ processAction
\ No newline at end of file
--- a/gameServer/CoreTypes.hs Thu Mar 20 13:12:05 2014 -0400
+++ b/gameServer/CoreTypes.hs Sat Mar 29 14:02:05 2014 -0400
@@ -81,6 +81,8 @@
| RegisterEvent Event
| SaveRoom B.ByteString
| LoadRoom B.ByteString
+ | ReactCmd [B.ByteString]
+ | CheckVotes
data Event = LobbyChatMessage
@@ -91,7 +93,7 @@
newEventsInfo :: EventsInfo
newEventsInfo = []
-
+
type ClientChan = Chan [B.ByteString]
data CheckInfo =
--- a/gameServer/HWProtoChecker.hs Thu Mar 20 13:12:05 2014 -0400
+++ b/gameServer/HWProtoChecker.hs Sat Mar 29 14:02:05 2014 -0400
@@ -5,7 +5,6 @@
import Control.Monad.Reader
--------------------------------------
import CoreTypes
-import Actions
import HandlerUtils
--- a/gameServer/HWProtoCore.hs Thu Mar 20 13:12:05 2014 -0400
+++ b/gameServer/HWProtoCore.hs Sat Mar 29 14:02:05 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 13:12:05 2014 -0400
+++ b/gameServer/HWProtoInRoomState.hs Sat Mar 29 14:02:05 2014 -0400
@@ -9,7 +9,6 @@
import Control.Monad.Reader
--------------------------------------
import CoreTypes
-import Actions
import Utils
import HandlerUtils
import RoomsAndClients
@@ -389,7 +388,7 @@
let kickId = fromJust maybeClientId
let sameRoom = clientRoom rnc thisClientId == clientRoom rnc kickId
- if isNothing $ masterID rm then
+ if isJust $ masterID rm then
return []
else
if isJust maybeClientId && sameRoom then
@@ -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
@@ -429,7 +434,6 @@
handleCmd_inRoom ["LOADROOM", fileName] = serverAdminOnly $ do
return [LoadRoom fileName]
-
handleCmd_inRoom ["LIST"] = return [] -- for old clients (<= 0.9.17)
handleCmd_inRoom (s:_) = return [ProtocolError $ "Incorrect command '" `B.append` s `B.append` "' (state: in room)"]
--- a/gameServer/HWProtoLobbyState.hs Thu Mar 20 13:12:05 2014 -0400
+++ b/gameServer/HWProtoLobbyState.hs Sat Mar 29 14:02:05 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 13:12:05 2014 -0400
+++ b/gameServer/HWProtoNEState.hs Sat Mar 29 14:02:05 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 13:12:05 2014 -0400
+++ b/gameServer/HandlerUtils.hs Sat Mar 29 14:02:05 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/RoomsAndClients.hs Thu Mar 20 13:12:05 2014 -0400
+++ b/gameServer/RoomsAndClients.hs Sat Mar 29 14:02:05 2014 -0400
@@ -22,6 +22,7 @@
client'sM,
room'sM,
allClientsM,
+ allRoomsM,
clientsM,
roomsM,
roomClientsM,
@@ -158,6 +159,9 @@
allClientsM :: MRoomsAndClients r c -> IO [ClientIndex]
allClientsM (MRoomsAndClients (_, clients)) = liftM (map ClientIndex) $ indicesM clients
+allRoomsM :: MRoomsAndClients r c -> IO [RoomIndex]
+allRoomsM (MRoomsAndClients (rooms, _)) = liftM (map RoomIndex) $ indicesM rooms
+
clientsM :: MRoomsAndClients r c -> IO [c]
clientsM (MRoomsAndClients (_, clients)) = indicesM clients >>= mapM (liftM client' . readElem clients)
--- a/gameServer/ServerCore.hs Thu Mar 20 13:12:05 2014 -0400
+++ b/gameServer/ServerCore.hs Sat Mar 29 14:02:05 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)
@@ -63,6 +53,7 @@
TimerAction tick ->
mapM_ processAction $
PingAll
+ : CheckVotes
: [StatsAction | even tick]
++ [Cleanup | tick `mod` 100 == 0]
--- a/gameServer/Votes.hs Thu Mar 20 13:12:05 2014 -0400
+++ b/gameServer/Votes.hs Sat Mar 29 14:02:05 2014 -0400
@@ -2,7 +2,7 @@
module Votes where
import Control.Monad.Reader
-import Control.Monad.State
+import Control.Monad.State.Strict
import ServerState
import qualified Data.ByteString.Char8 as B
import qualified Data.List as L
@@ -31,14 +31,15 @@
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
closeVoting
else if length pro >= v then do
- act $ voteType vt
- closeVoting
+ a <- act $ voteType vt
+ c <- closeVoting
+ return $ c ++ a
else
return [ModifyRoom $ \r -> r{voting = Just vt}]
@@ -67,7 +68,17 @@
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) -> do
+ cl <- thisClient
+ chans <- roomClientsChans
+ let a = map (replaceChans chans) $ answerFullConfigParams cl mp p
+ return $
+ (ModifyRoom $ \r -> r{params = p, mapParams = mp})
+ : SendUpdateOnThisRoom
+ : a
+ where
+ replaceChans chans (AnswerClients _ msg) = AnswerClients chans msg
+ replaceChans _ a = a
startVote :: VoteType -> Reader (ClientIndex, IRnC) [Action]
@@ -82,13 +93,31 @@
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 ()
-checkVotes = undefined
+checkVotes :: StateT ServerState IO [Action]
+checkVotes = do
+ rnc <- gets roomsClients
+ liftM concat $ io $ do
+ ris <- allRoomsM rnc
+ mapM (check rnc) ris
+ where
+ check rnc ri = do
+ e <- room'sM rnc voting ri
+ case e of
+ Just rv -> do
+ modifyRoom rnc (\r -> r{voting = if voteTTL rv == 0 then Nothing else Just rv{voteTTL = voteTTL rv - 1}}) ri
+ if voteTTL rv == 0 then do
+ chans <- liftM (map sendChan) $ roomClientsM rnc ri
+ return [AnswerClients chans ["CHAT", "[server]", loc "Voting expired"]]
+ else
+ return []
+ Nothing -> return []
voteInfo :: VoteType -> B.ByteString
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/misc/OfficialChallenges/racer_#5.hwmap Sat Mar 29 14:02:05 2014 -0400
@@ -0,0 +1,1 @@
+AAAAtHicFc6xDsFQHIXxc3tv+48oHUw2kRKv4Am8hYjFC4hGYjuLwWRi6+QVDDazxGbpYpHYPEL1LL9845cVVsD9/BrdjR/Cju4Cv6oHSM8Ndk32sDL0gYVVzN5WQahyZJXlRNlUdIq/FLBb/KJAp44fFAjTcKBAMvFbCrR2fkmBdBbmFAgWjSngnm5EgfY96lE0f/hQ4A+Rki/Q
\ No newline at end of file
--- a/share/hedgewars/Data/Scripts/Multiplayer/Highlander.lua Thu Mar 20 13:12:05 2014 -0400
+++ b/share/hedgewars/Data/Scripts/Multiplayer/Highlander.lua Sat Mar 29 14:02:05 2014 -0400
@@ -89,6 +89,7 @@
HedgewarsScriptLoad("/Scripts/Locale.lua")
HedgewarsScriptLoad("/Scripts/Tracker.lua")
+HedgewarsScriptLoad("/Scripts/Params.lua")
-- These define weps allowed by the script. At present Tardis and Resurrection is banned for example
-- These were arbitrarily defined out-of-order in initial script, so that was preserved here, resulting
@@ -132,6 +133,13 @@
local someHog = nil -- just for looking up the weps
+local mode = nil
+
+function onParameters()
+ parseParams()
+ mode = params["mode"]
+end
+
function CheckForWeaponSwap()
if GetCurAmmoType() ~= lastWep then
shotsFired = 0
@@ -212,7 +220,7 @@
for w,c in pairs(wepArray) do
val = getGearValue(gear,w)
- if val ~= 0 and wepArray[w] ~= 9 and getGearValue(CurrentHedgehog, w) == 0 then
+ if val ~= 0 and (mode == "orig" or (wepArray[w] ~= 9 and getGearValue(CurrentHedgehog, w) == 0)) then
setGearValue(CurrentHedgehog, w, val)
-- if you are using multi-shot weapon, gimme one more
--- a/share/hedgewars/Data/Scripts/OfficialChallenges.lua Thu Mar 20 13:12:05 2014 -0400
+++ b/share/hedgewars/Data/Scripts/OfficialChallenges.lua Sat Mar 29 14:02:05 2014 -0400
@@ -1,13 +1,19 @@
function detectMap()
if RopePercent == 100 and MinesNum == 0 then
- if LandDigest == "M838018718Scripts/Multiplayer/Racer.lua" then
- return("Racer Challenge #1")
- elseif LandDigest == "M-490229244Scripts/Multiplayer/Racer.lua" then
- return("Racer Challenge #2")
- elseif LandDigest == "M806689586Scripts/Multiplayer/Racer.lua" then
- return("Racer Challenge #3")
+-- challenges with border
+ if band(GameFlags, gfBorder) ~= 0 then
+ if LandDigest == "M838018718Scripts/Multiplayer/Racer.lua" then
+ return("Racer Challenge #1")
+ elseif LandDigest == "M-490229244Scripts/Multiplayer/Racer.lua" then
+ return("Racer Challenge #2")
+ elseif LandDigest == "M806689586Scripts/Multiplayer/Racer.lua" then
+ return("Racer Challenge #3")
+ end
+-- challenges without border
elseif LandDigest == "M-134869715Scripts/Multiplayer/Racer.lua" then
return("Racer Challenge #4")
+ elseif LandDigest == "M-661895109Scripts/Multiplayer/Racer.lua" then
+ return("Racer Challenge #5")
end
end
end