--- a/gameServer/HWProtoCore.hs Sat Jan 29 21:33:24 2011 +0300
+++ b/gameServer/HWProtoCore.hs Sun Jan 30 20:32:23 2011 +0300
@@ -3,7 +3,6 @@
import Control.Monad.Reader
import Data.Maybe
-import Data.List
import qualified Data.ByteString.Char8 as B
--------------------------------------
import CoreTypes
@@ -43,8 +42,7 @@
handleCmd_loggedin ["INFO", asknick] = do
(_, rnc) <- ask
- let allClientIDs = allClients rnc
- let maybeClientId = find (\clId -> asknick == nick (client rnc clId)) allClientIDs
+ maybeClientId <- clientByNick asknick
let noSuchClient = isNothing maybeClientId
let clientId = fromJust maybeClientId
let cl = rnc `client` fromJust maybeClientId
--- a/gameServer/HWProtoInRoomState.hs Sat Jan 29 21:33:24 2011 +0300
+++ b/gameServer/HWProtoInRoomState.hs Sun Jan 30 20:32:23 2011 +0300
@@ -1,9 +1,8 @@
{-# LANGUAGE OverloadedStrings #-}
module HWProtoInRoomState where
-import qualified Data.Foldable as Foldable
import qualified Data.Map as Map
-import Data.Sequence(Seq, (|>), (><), fromList, empty)
+import Data.Sequence((|>), empty)
import Data.List
import Data.Maybe
import qualified Data.ByteString.Char8 as B
@@ -234,21 +233,22 @@
else
[ModifyRoom (\r -> r{isRestrictedTeams = not $ isRestrictedTeams r})]
-{-
-handleCmd_inRoom clID clients rooms ["KICK", kickNick] =
- [KickRoomClient kickID | isMaster client && not noSuchClient && (kickID /= clID) && (roomID client == roomID kickClient)]
- where
- client = clients IntMap.! clID
- maybeClient = Foldable.find (\cl -> kickNick == nick cl) clients
- noSuchClient = isNothing maybeClient
- kickClient = fromJust maybeClient
- kickID = clientUID kickClient
+
+handleCmd_inRoom ["KICK", kickNick] = do
+ (thisClientId, rnc) <- ask
+ maybeClientId <- clientByNick kickNick
+ master <- liftM isMaster thisClient
+ let kickId = fromJust maybeClientId
+ let sameRoom = (clientRoom rnc thisClientId) == (clientRoom rnc kickId)
+ return
+ [KickRoomClient kickId | master && isJust maybeClientId && (kickId /= thisClientId) && sameRoom]
-handleCmd_inRoom clID clients _ ["TEAMCHAT", msg] =
- [AnswerSameClan ["EM", engineMsg]]
+handleCmd_inRoom ["TEAMCHAT", msg] = do
+ cl <- thisClient
+ chans <- roomSameClanChans
+ return [AnswerClients chans ["EM", engineMsg cl]]
where
- client = clients IntMap.! clID
- engineMsg = toEngineMsg $ 'b' : ((nick client) ++ "(team): " ++ msg ++ "\x20\x20")
--}
+ engineMsg cl = toEngineMsg $ "b" `B.append` (nick cl) `B.append` "(team): " `B.append` msg `B.append` "\x20\x20"
+
handleCmd_inRoom _ = return [ProtocolError "Incorrect command (state: in room)"]
--- a/gameServer/HandlerUtils.hs Sat Jan 29 21:33:24 2011 +0300
+++ b/gameServer/HandlerUtils.hs Sun Jan 30 20:32:23 2011 +0300
@@ -2,6 +2,7 @@
import Control.Monad.Reader
import qualified Data.ByteString.Char8 as B
+import Data.List
import RoomsAndClients
import CoreTypes
@@ -27,6 +28,18 @@
let ri = clientRoom rnc ci
return $ map (sendChan . client rnc) $ filter (/= ci) (roomClients rnc ri)
+roomSameClanChans :: Reader (ClientIndex, IRnC) [ClientChan]
+roomSameClanChans = do
+ (ci, rnc) <- ask
+ let ri = clientRoom rnc ci
+ let otherRoomClients = map (client rnc) . filter (/= ci) $ roomClients rnc ri
+ let cl = rnc `client` ci
+ let thisClan = clientClan cl
+ let sameClanClients = Prelude.filter (\c -> teamsInGame cl > 0 && clientClan c == thisClan) otherRoomClients
+ let spectators = Prelude.filter (\c -> teamsInGame c == 0) otherRoomClients
+ let sameClanOrSpec = if teamsInGame cl > 0 then sameClanClients else spectators
+ return $ map sendChan sameClanOrSpec
+
roomClientsChans :: Reader (ClientIndex, IRnC) [ClientChan]
roomClientsChans = do
(ci, rnc) <- ask
@@ -43,3 +56,10 @@
allRoomInfos :: Reader (a, IRnC) [RoomInfo]
allRoomInfos = liftM ((\irnc -> map (room irnc) $ allRooms irnc) . snd) ask
+
+clientByNick :: B.ByteString -> Reader (ClientIndex, IRnC) (Maybe ClientIndex)
+clientByNick n = do
+ (_, rnc) <- ask
+ let allClientIDs = allClients rnc
+ return $ find (\clId -> n == nick (client rnc clId)) allClientIDs
+