gameServer/Actions.hs
branchwebgl
changeset 9160 fc46e75f6b72
parent 9127 e350500c4edb
parent 9109 878f06e9c484
child 9197 e4e366013e9a
equal deleted inserted replaced
9136:78f087fd3e5b 9160:fc46e75f6b72
   160 processAction (MoveToRoom ri) = do
   160 processAction (MoveToRoom ri) = do
   161     (Just ci) <- gets clientIndex
   161     (Just ci) <- gets clientIndex
   162     rnc <- gets roomsClients
   162     rnc <- gets roomsClients
   163 
   163 
   164     io $ do
   164     io $ do
   165         modifyClient rnc (\cl -> cl{teamsInGame = 0, isReady = False, isMaster = False, isInGame = False, clientClan = Nothing}) ci
   165         modifyClient rnc (
       
   166             \cl -> cl{teamsInGame = 0
       
   167                 , isReady = False
       
   168                 , isMaster = False
       
   169                 , isInGame = False
       
   170                 , isJoinedMidGame = False
       
   171                 , clientClan = Nothing}) ci
   166         modifyRoom rnc (\r -> r{playersIn = playersIn r + 1}) ri
   172         modifyRoom rnc (\r -> r{playersIn = playersIn r + 1}) ri
   167         moveClientToRoom rnc ri ci
   173         moveClientToRoom rnc ri ci
   168 
   174 
   169     chans <- liftM (map sendChan) $ roomClientsS ri
   175     chans <- liftM (map sendChan) $ roomClientsS ri
   170     clNick <- client's nick
   176     clNick <- client's nick
   288     ri <- clientRoomA
   294     ri <- clientRoomA
   289     roomPlayers <- roomClientsS ri
   295     roomPlayers <- roomClientsS ri
   290     pr <- client's clientProto
   296     pr <- client's clientProto
   291     mapM_ processAction [
   297     mapM_ processAction [
   292         AnswerClients (map sendChan roomPlayers) $ notReadyMessage pr . map nick . filter (not . isMaster) $ roomPlayers
   298         AnswerClients (map sendChan roomPlayers) $ notReadyMessage pr . map nick . filter (not . isMaster) $ roomPlayers
   293         , ModifyRoomClients (\cl -> cl{isReady = isMaster cl})
   299         , ModifyRoomClients (\cl -> cl{isReady = isMaster cl, isJoinedMidGame = False})
   294         , ModifyRoom (\r -> r{readyPlayers = 1})
   300         , ModifyRoom (\r -> r{readyPlayers = 1})
   295         ]
   301         ]
   296     where
   302     where
   297         notReadyMessage p nicks = if p < 38 then "NOT_READY" : nicks else "CLIENT_FLAGS" : "-r" : nicks
   303         notReadyMessage p nicks = if p < 38 then "NOT_READY" : nicks else "CLIENT_FLAGS" : "-r" : nicks
   298 
   304 
   299 
   305 
   300 processAction FinishGame = do
   306 processAction FinishGame = do
   301     rnc <- gets roomsClients
   307     rnc <- gets roomsClients
   302     ri <- clientRoomA
   308     ri <- clientRoomA
   303     thisRoomChans <- liftM (map sendChan) $ roomClientsS ri
   309     thisRoomChans <- liftM (map sendChan) $ roomClientsS ri
       
   310     joinedMidGame <- liftM (filter isJoinedMidGame) $ roomClientsS ri
   304     answerRemovedTeams <- io $
   311     answerRemovedTeams <- io $
   305          room'sM rnc (map (\t -> AnswerClients thisRoomChans ["REMOVE_TEAM", t]) . leftTeams . fromJust . gameInfo) ri
   312          room'sM rnc (\r -> let gi = fromJust $ gameInfo r in 
   306 
   313                         concatMap (\c -> 
   307     mapM_ processAction $
   314                             (answerFullConfigParams c (mapParams r) (params r))
       
   315                             ++
       
   316                             (map (\t -> AnswerClients [sendChan c] ["REMOVE_TEAM", t]) $ leftTeams gi) 
       
   317                         ) joinedMidGame
       
   318                      ) ri
       
   319 
       
   320     mapM_ processAction $ (
   308         SaveReplay
   321         SaveReplay
   309         : ModifyRoom
   322         : ModifyRoom
   310             (\r -> r{
   323             (\r -> r{
   311                 gameInfo = Nothing,
   324                 gameInfo = Nothing,
   312                 readyPlayers = 0
   325                 readyPlayers = 0
   313                 }
   326                 }
   314             )
   327             )
   315         : UnreadyRoomClients
       
   316         : SendUpdateOnThisRoom
   328         : SendUpdateOnThisRoom
   317         : AnswerClients thisRoomChans ["ROUND_FINISHED"]
   329         : AnswerClients thisRoomChans ["ROUND_FINISHED"]
   318         : answerRemovedTeams
   330         : answerRemovedTeams
       
   331         )
       
   332         ++ [UnreadyRoomClients]
   319 
   333 
   320 
   334 
   321 processAction (SendTeamRemovalMessage teamName) = do
   335 processAction (SendTeamRemovalMessage teamName) = do
   322     chans <- othersChans
   336     chans <- othersChans
   323     mapM_ processAction [
   337     mapM_ processAction [