equal
deleted
inserted
replaced
1 {-# LANGUAGE OverloadedStrings #-} |
1 {-# LANGUAGE CPP, OverloadedStrings #-} |
2 module Actions where |
2 module Actions where |
3 |
3 |
4 import Control.Concurrent |
4 import Control.Concurrent |
5 import qualified Data.Set as Set |
5 import qualified Data.Set as Set |
6 import qualified Data.Sequence as Seq |
6 import qualified Data.Sequence as Seq |
15 import qualified Data.ByteString.Char8 as B |
15 import qualified Data.ByteString.Char8 as B |
16 import Control.DeepSeq |
16 import Control.DeepSeq |
17 import Data.Unique |
17 import Data.Unique |
18 import Control.Arrow |
18 import Control.Arrow |
19 import Control.Exception |
19 import Control.Exception |
20 import OfficialServer.GameReplayStore |
|
21 import System.Process |
20 import System.Process |
22 import Network.Socket |
21 import Network.Socket |
23 ----------------------------- |
22 ----------------------------- |
|
23 import OfficialServer.GameReplayStore |
24 import CoreTypes |
24 import CoreTypes |
25 import Utils |
25 import Utils |
26 import ClientIO |
26 import ClientIO |
27 import ServerState |
27 import ServerState |
28 import Consts |
28 import Consts |
29 import ConfigFile |
29 import ConfigFile |
|
30 import EngineInteraction |
30 |
31 |
31 data Action = |
32 data Action = |
32 AnswerClients ![ClientChan] ![B.ByteString] |
33 AnswerClients ![ClientChan] ![B.ByteString] |
33 | SendServerMessage |
34 | SendServerMessage |
34 | SendServerVars |
35 | SendServerVars |
204 |
205 |
205 processAction (MoveToLobby msg) = do |
206 processAction (MoveToLobby msg) = do |
206 (Just ci) <- gets clientIndex |
207 (Just ci) <- gets clientIndex |
207 ri <- clientRoomA |
208 ri <- clientRoomA |
208 rnc <- gets roomsClients |
209 rnc <- gets roomsClients |
209 (gameProgress, playersNum) <- io $ room'sM rnc (gameinprogress &&& playersIn) ri |
210 (gameProgress, playersNum) <- io $ room'sM rnc ((isJust . gameInfo) &&& playersIn) ri |
210 ready <- client's isReady |
211 ready <- client's isReady |
211 master <- client's isMaster |
212 master <- client's isMaster |
212 -- client <- client's id |
213 -- client <- client's id |
213 clNick <- client's nick |
214 clNick <- client's nick |
214 chans <- othersChans |
215 chans <- othersChans |
296 |
297 |
297 |
298 |
298 processAction (RemoveTeam teamName) = do |
299 processAction (RemoveTeam teamName) = do |
299 rnc <- gets roomsClients |
300 rnc <- gets roomsClients |
300 ri <- clientRoomA |
301 ri <- clientRoomA |
301 inGame <- io $ room'sM rnc gameinprogress ri |
302 inGame <- io $ room'sM rnc (isJust . gameInfo) ri |
302 chans <- othersChans |
303 chans <- othersChans |
303 if not $ inGame then |
304 if not $ inGame then |
304 mapM_ processAction [ |
305 mapM_ processAction [ |
305 AnswerClients chans ["REMOVE_TEAM", teamName], |
306 AnswerClients chans ["REMOVE_TEAM", teamName], |
306 ModifyRoom (\r -> r{teams = Prelude.filter (\t -> teamName /= teamname t) $ teams r}) |
307 ModifyRoom (\r -> r{teams = Prelude.filter (\t -> teamName /= teamname t) $ teams r}) |
308 else |
309 else |
309 mapM_ processAction [ |
310 mapM_ processAction [ |
310 AnswerClients chans ["EM", rmTeamMsg], |
311 AnswerClients chans ["EM", rmTeamMsg], |
311 ModifyRoom (\r -> r{ |
312 ModifyRoom (\r -> r{ |
312 teams = Prelude.filter (\t -> teamName /= teamname t) $ teams r, |
313 teams = Prelude.filter (\t -> teamName /= teamname t) $ teams r, |
313 leftTeams = teamName : leftTeams r, |
314 gameInfo = liftM (\g -> g{ |
314 roundMsgs = roundMsgs r Seq.|> rmTeamMsg |
315 leftTeams = teamName : leftTeams g, |
|
316 roundMsgs = roundMsgs g Seq.|> rmTeamMsg |
|
317 }) $ gameInfo r |
315 }) |
318 }) |
316 ] |
319 ] |
317 where |
320 where |
318 rmTeamMsg = toEngineMsg $ 'F' `B.cons` teamName |
321 rmTeamMsg = toEngineMsg $ 'F' `B.cons` teamName |
319 |
322 |
503 noticeM "Core" "Spawning new server" |
506 noticeM "Core" "Spawning new server" |
504 _ <- createProcess (proc "./hedgewars-server" args) |
507 _ <- createProcess (proc "./hedgewars-server" args) |
505 return () |
508 return () |
506 processAction $ ModifyServerInfo (\s -> s{shutdownPending = True}) |
509 processAction $ ModifyServerInfo (\s -> s{shutdownPending = True}) |
507 |
510 |
|
511 #if defined(OFFICIAL_SERVER) |
508 processAction SaveReplay = do |
512 processAction SaveReplay = do |
509 ri <- clientRoomA |
513 ri <- clientRoomA |
510 rnc <- gets roomsClients |
514 rnc <- gets roomsClients |
511 io $ do |
515 io $ do |
512 r <- room'sM rnc id ri |
516 r <- room'sM rnc id ri |
513 saveReplay r |
517 saveReplay r |
|
518 #else |
|
519 processAction SaveReplay = return () |
|
520 #endif |