--- a/gameServer/Actions.hs Sun Feb 06 18:59:53 2011 +0300
+++ b/gameServer/Actions.hs Sun Feb 06 21:50:29 2011 +0300
@@ -2,8 +2,6 @@
module Actions where
import Control.Concurrent
-import Control.Concurrent.Chan
-import qualified Data.IntSet as IntSet
import qualified Data.Set as Set
import qualified Data.Sequence as Seq
import System.Log.Logger
@@ -14,9 +12,8 @@
import Control.Monad.State.Strict
import qualified Data.ByteString.Char8 as B
import Control.DeepSeq
-import Data.Time
-import Text.Printf
import Data.Unique
+import Control.Arrow
-----------------------------
import CoreTypes
import Utils
@@ -65,6 +62,8 @@
instance NFData B.ByteString
instance NFData (Chan a)
+
+othersChans :: StateT ServerState IO [ClientChan]
othersChans = do
cl <- client's id
ri <- clientRoomA
@@ -73,8 +72,8 @@
processAction :: Action -> StateT ServerState IO ()
-processAction (AnswerClients chans msg) = do
- io $ mapM_ (flip writeChan (msg `deepseq` msg)) (chans `deepseq` chans)
+processAction (AnswerClients chans msg) =
+ io $ mapM_ (`writeChan` (msg `deepseq` msg)) (chans `deepseq` chans)
processAction SendServerMessage = do
@@ -115,7 +114,6 @@
processAction (ByeClient msg) = do
(Just ci) <- gets clientIndex
- rnc <- gets roomsClients
ri <- clientRoomA
chan <- client's sendChan
@@ -126,8 +124,8 @@
return ()
clientsChans <- liftM (Prelude.map sendChan . Prelude.filter logonPassed) $! allClientsS
- io $ do
- infoM "Clients" (show ci ++ " quits: " ++ (B.unpack msg))
+ io $
+ infoM "Clients" (show ci ++ " quits: " ++ B.unpack msg)
processAction $ AnswerClients [chan] ["BYE", msg]
processAction $ AnswerClients clientsChans ["LOBBY:LEFT", clNick, msg]
@@ -171,7 +169,7 @@
io $ do
modifyClient rnc (\cl -> cl{teamsInGame = 0, isReady = False, isMaster = False}) ci
- modifyRoom rnc (\r -> r{playersIn = (playersIn r) + 1}) ri
+ modifyRoom rnc (\r -> r{playersIn = playersIn r + 1}) ri
moveClientToRoom rnc ri ci
chans <- liftM (map sendChan) $ roomClientsS ri
@@ -184,7 +182,7 @@
(Just ci) <- gets clientIndex
ri <- clientRoomA
rnc <- gets roomsClients
- (gameProgress, playersNum) <- io $ room'sM rnc (\r -> (gameinprogress r, playersIn r)) ri
+ (gameProgress, playersNum) <- io $ room'sM rnc (gameinprogress &&& playersIn) ri
ready <- client's isReady
master <- client's isMaster
-- client <- client's id
@@ -201,7 +199,7 @@
io $ do
modifyRoom rnc (\r -> r{
- playersIn = (playersIn r) - 1,
+ playersIn = playersIn r - 1,
readyPlayers = if ready then readyPlayers r - 1 else readyPlayers r
}) ri
moveClientToLobby rnc ci
@@ -223,14 +221,14 @@
rnc <- gets roomsClients
proto <- io $ client'sM rnc clientProto clId
- let room = newRoom{
+ let rm = newRoom{
masterID = clId,
name = roomName,
password = roomPassword,
roomProto = proto
}
- rId <- io $ addRoom rnc room
+ rId <- io $ addRoom rnc rm
processAction $ MoveToRoom rId
@@ -270,7 +268,6 @@
processAction (RemoveTeam teamName) = do
rnc <- gets roomsClients
- cl <- client's id
ri <- clientRoomA
inGame <- io $ room'sM rnc gameinprogress ri
chans <- othersChans
@@ -289,7 +286,7 @@
})
]
where
- rmTeamMsg = toEngineMsg $ (B.singleton 'F') `B.append` teamName
+ rmTeamMsg = toEngineMsg $ B.singleton 'F' `B.append` teamName
processAction (RemoveClientTeams clId) = do
@@ -326,10 +323,10 @@
HasAccount passwd isAdmin -> do
chan <- client's sendChan
mapM_ processAction [AnswerClients [chan] ["ASKPASSWORD"], ModifyClient (\c -> c{webPassword = passwd, isAdministrator = isAdmin})]
- Guest -> do
+ Guest ->
processAction JoinLobby
Admin -> do
- mapM processAction [ModifyClient (\cl -> cl{isAdministrator = True}), JoinLobby]
+ mapM_ processAction [ModifyClient (\cl -> cl{isAdministrator = True}), JoinLobby]
chan <- client's sendChan
processAction $ AnswerClients [chan] ["ADMIN_ACCESS"]
@@ -337,11 +334,11 @@
processAction JoinLobby = do
chan <- client's sendChan
clientNick <- client's nick
- (lobbyNicks, clientsChans) <- liftM (unzip . Prelude.map (\c -> (nick c, sendChan c)) . Prelude.filter logonPassed) $! allClientsS
+ (lobbyNicks, clientsChans) <- liftM (unzip . Prelude.map (nick &&& sendChan) . Prelude.filter logonPassed) $! allClientsS
mapM_ processAction $
- (AnswerClients clientsChans ["LOBBY:JOINED", clientNick])
- : [AnswerClients [chan] ("LOBBY:JOINED" : clientNick : lobbyNicks)]
- ++ [ModifyClient (\cl -> cl{logonPassed = True}), SendServerMessage]
+ AnswerClients clientsChans ["LOBBY:JOINED", clientNick]
+ : AnswerClients [chan] ("LOBBY:JOINED" : clientNick : lobbyNicks)
+ : [ModifyClient (\cl -> cl{logonPassed = True}), SendServerMessage]
{-
processAction (clID, serverInfo, rnc) (RoomAddThisClient rID) =
@@ -367,10 +364,10 @@
processAction (BanClient seconds reason banId) = do
modify (\s -> s{clientIndex = Just banId})
clHost <- client's host
- currentTime <- io $ getCurrentTime
- let msg = "Ban for " `B.append` (B.pack . show $ seconds) `B.append` "seconds (" `B.append` msg` B.append` ")"
+ currentTime <- io getCurrentTime
+ let msg = "Ban for " `B.append` (B.pack . show $ seconds) `B.append` "seconds (" `B.append` reason ` B.append` ")"
mapM_ processAction [
- ModifyServerInfo (\s -> s{lastLogins = (clHost, (addUTCTime seconds $ currentTime, msg)) : lastLogins s})
+ ModifyServerInfo (\s -> s{lastLogins = (clHost, (addUTCTime seconds currentTime, msg)) : lastLogins s})
, KickClient banId
]
@@ -387,7 +384,7 @@
newClId <- io $ do
ci <- addClient rnc cl
t <- forkIO $ clientRecvLoop (clientSocket cl) (coreChan si) ci
- forkIO $ clientSendLoop (clientSocket cl) t (coreChan si) (sendChan cl) ci
+ _ <- forkIO $ clientSendLoop (clientSocket cl) t (coreChan si) (sendChan cl) ci
infoM "Clients" (show ci ++ ": New client. Time: " ++ show (connectTime cl))
@@ -396,8 +393,7 @@
modify (\s -> s{clientIndex = Just newClId})
processAction $ AnswerClients [sendChan cl] ["CONNECTED", "Hedgewars server http://www.hedgewars.org/"]
- si <- gets serverInfo
- let newLogins = takeWhile (\(_ , (time, _)) -> (connectTime cl) `diffUTCTime` time <= 0) $ lastLogins si
+ let newLogins = takeWhile (\(_ , (time, _)) -> connectTime cl `diffUTCTime` time <= 0) $ lastLogins si
let info = host cl `Prelude.lookup` newLogins
if isJust info then
mapM_ processAction [ModifyServerInfo (\s -> s{lastLogins = newLogins}), ByeClient (snd . fromJust $ info)]
@@ -423,10 +419,10 @@
processAction StatsAction = do
rnc <- gets roomsClients
si <- gets serverInfo
- (roomsNum, clientsNum) <- io $ withRoomsAndClients rnc stats
+ (roomsNum, clientsNum) <- io $ withRoomsAndClients rnc st
io $ writeChan (dbQueries si) $ SendStats clientsNum (roomsNum - 1)
where
- stats irnc = (length $ allRooms irnc, length $ allClients irnc)
+ st irnc = (length $ allRooms irnc, length $ allClients irnc)
-processAction (RestartServer useForce) = do
+processAction (RestartServer _) =
return ()
\ No newline at end of file
--- a/gameServer/ClientIO.hs Sun Feb 06 18:59:53 2011 +0300
+++ b/gameServer/ClientIO.hs Sun Feb 06 21:50:29 2011 +0300
@@ -5,7 +5,6 @@
import Control.Concurrent.Chan
import Control.Concurrent
import Control.Monad
-import System.IO
import Network
import Network.Socket.ByteString
import qualified Data.ByteString.Char8 as B
@@ -19,10 +18,10 @@
pDelim = B.pack "\n\n"
bs2Packets :: B.ByteString -> ([[B.ByteString]], B.ByteString)
-bs2Packets buf = unfoldrE extractPackets buf
+bs2Packets = unfoldrE extractPackets
where
extractPackets :: B.ByteString -> Either B.ByteString ([B.ByteString], B.ByteString)
- extractPackets buf =
+ extractPackets buf =
let buf' = until (not . B.isPrefixOf pDelim) (B.drop 2) buf in
let (bsPacket, bufTail) = B.breakSubstring pDelim buf' in
if B.null bufTail then
@@ -58,23 +57,23 @@
clientSendLoop :: Socket -> ThreadId -> Chan CoreMessage -> Chan [B.ByteString] -> ClientIndex -> IO ()
-clientSendLoop s tId coreChan chan ci = do
+clientSendLoop s tId cChan chan ci = do
answer <- readChan chan
Exception.handle
- (\(e :: Exception.IOException) -> when (not $ isQuit answer) $ sendQuit e) $ do
- sendAll s $ (B.unlines answer) `B.append` (B.singleton '\n')
+ (\(e :: Exception.IOException) -> unless (isQuit answer) $ sendQuit e) $
+ sendAll s $ B.unlines answer `B.append` B.singleton '\n'
- if (isQuit answer) then
+ if isQuit answer then
do
Exception.handle (\(_ :: Exception.IOException) -> putStrLn "error on sClose") $ sClose s
killThread tId
- writeChan coreChan $ Remove ci
+ writeChan cChan $ Remove ci
else
- clientSendLoop s tId coreChan chan ci
+ clientSendLoop s tId cChan chan ci
where
sendQuit e = do
- putStrLn $ show e
- writeChan coreChan $ ClientMessage (ci, ["QUIT", B.pack $ show e])
- isQuit ("BYE":xs) = True
+ print e
+ writeChan cChan $ ClientMessage (ci, ["QUIT", B.pack $ show e])
+ isQuit ("BYE":_) = True
isQuit _ = False
--- a/gameServer/CoreTypes.hs Sun Feb 06 18:59:53 2011 +0300
+++ b/gameServer/CoreTypes.hs Sun Feb 06 21:50:29 2011 +0300
@@ -1,13 +1,10 @@
{-# LANGUAGE OverloadedStrings #-}
module CoreTypes where
-import System.IO
import Control.Concurrent
-import Control.Concurrent.Chan
import Control.Concurrent.STM
import Data.Word
import qualified Data.Map as Map
-import qualified Data.IntSet as IntSet
import Data.Sequence(Seq, empty)
import Data.Time
import Network
@@ -41,7 +38,7 @@
}
instance Show ClientInfo where
- show ci = " nick: " ++ (unpack $ nick ci) ++ " host: " ++ (unpack $ host ci)
+ show ci = " nick: " ++ unpack (nick ci) ++ " host: " ++ unpack (host ci)
instance Eq ClientInfo where
(==) = (==) `on` clientSocket
@@ -66,9 +63,9 @@
}
instance Show TeamInfo where
- show ti = "owner: " ++ (unpack $ teamowner ti)
- ++ "name: " ++ (unpack $ teamname ti)
- ++ "color: " ++ (unpack $ teamcolor ti)
+ show ti = "owner: " ++ unpack (teamowner ti)
+ ++ "name: " ++ unpack (teamname ti)
+ ++ "color: " ++ unpack (teamcolor ti)
data RoomInfo =
RoomInfo
@@ -95,7 +92,7 @@
++ ", teams: " ++ show (teams ri)
newRoom :: RoomInfo
-newRoom = (
+newRoom =
RoomInfo
undefined
""
@@ -111,7 +108,6 @@
[]
[]
(Map.singleton "MAP" ["+rnd+"])
- )
data StatisticsInfo =
StatisticsInfo
@@ -142,7 +138,7 @@
show _ = "Server Info"
newServerInfo :: TMVar StatisticsInfo -> Chan CoreMessage -> Chan DBQuery -> ServerInfo
-newServerInfo = (
+newServerInfo =
ServerInfo
True
"<h2><p align=center><a href=\"http://www.hedgewars.org/\">http://www.hedgewars.org/</a></p></h2>"
@@ -154,7 +150,6 @@
""
""
[]
- )
data AccountInfo =
HasAccount B.ByteString Bool
--- a/gameServer/HWProtoCore.hs Sun Feb 06 18:59:53 2011 +0300
+++ b/gameServer/HWProtoCore.hs Sun Feb 06 21:50:29 2011 +0300
@@ -50,7 +50,7 @@
let clRoom = room rnc roomId
let roomMasterSign = if isMaster cl then "@" else ""
let adminSign = if isAdministrator cl then "@" else ""
- let roomInfo = if roomId /= lobbyId then roomMasterSign `B.append` "room " `B.append` (name clRoom) else adminSign `B.append` "lobby"
+ let roomInfo = if roomId /= lobbyId then roomMasterSign `B.append` "room " `B.append` name clRoom else adminSign `B.append` "lobby"
let roomStatus = if gameinprogress clRoom then
if teamsInGame cl > 0 then "(playing)" else "(spectating)"
else
--- a/gameServer/HWProtoInRoomState.hs Sun Feb 06 18:59:53 2011 +0300
+++ b/gameServer/HWProtoInRoomState.hs Sun Feb 06 21:50:29 2011 +0300
@@ -38,46 +38,46 @@
else
return [ProtocolError "Not room master"]
-handleCmd_inRoom ("ADD_TEAM" : name : color : grave : fort : voicepack : flag : difStr : hhsInfo)
+handleCmd_inRoom ("ADD_TEAM" : tName : color : grave : fort : voicepack : flag : difStr : hhsInfo)
| length hhsInfo /= 16 = return [ProtocolError "Corrupted hedgehogs info"]
| otherwise = do
- (ci, rnc) <- ask
- r <- thisRoom
+ (ci, _) <- ask
+ rm <- thisRoom
clNick <- clientNick
clChan <- thisClientChans
- othersChans <- roomOthersChans
+ othChans <- roomOthersChans
return $
- if not . null . drop 5 $ teams r then
+ if not . null . drop 5 $ teams rm then
[Warning "too many teams"]
- else if canAddNumber r <= 0 then
+ else if canAddNumber rm <= 0 then
[Warning "too many hedgehogs"]
- else if isJust $ findTeam r then
+ else if isJust $ findTeam rm then
[Warning "There's already a team with same name in the list"]
- else if gameinprogress r then
+ else if gameinprogress rm then
[Warning "round in progress"]
- else if isRestrictedTeams r then
+ else if isRestrictedTeams rm then
[Warning "restricted"]
else
[ModifyRoom (\r -> r{teams = teams r ++ [newTeam ci clNick r]}),
ModifyClient (\c -> c{teamsInGame = teamsInGame c + 1, clientClan = color}),
- AnswerClients clChan ["TEAM_ACCEPTED", name],
- AnswerClients othersChans $ teamToNet $ newTeam ci clNick r,
- AnswerClients othersChans ["TEAM_COLOR", name, color]
+ AnswerClients clChan ["TEAM_ACCEPTED", tName],
+ AnswerClients othChans $ teamToNet $ newTeam ci clNick rm,
+ AnswerClients othChans ["TEAM_COLOR", tName, color]
]
where
canAddNumber r = 48 - (sum . map hhnum $ teams r)
- findTeam = find (\t -> name == teamname t) . teams
- newTeam ci clNick r = (TeamInfo ci clNick name color grave fort voicepack flag difficulty (newTeamHHNum r) (hhsList hhsInfo))
- difficulty = case B.readInt difStr of
- Just (i, t) | B.null t -> fromIntegral i
- otherwise -> 0
+ findTeam = find (\t -> tName == teamname t) . teams
+ newTeam ci clNick r = TeamInfo ci clNick tName color grave fort voicepack flag dif (newTeamHHNum r) (hhsList hhsInfo)
+ dif = case B.readInt difStr of
+ Just (i, t) | B.null t -> fromIntegral i
+ _ -> 0
hhsList [] = []
hhsList [_] = error "Hedgehogs list with odd elements number"
hhsList (n:h:hhs) = HedgehogInfo n h : hhsList hhs
newTeamHHNum r = min 4 (canAddNumber r)
-handleCmd_inRoom ["REMOVE_TEAM", name] = do
- (ci, rnc) <- ask
+handleCmd_inRoom ["REMOVE_TEAM", tName] = do
+ (ci, _) <- ask
r <- thisRoom
clNick <- clientNick
@@ -90,7 +90,7 @@
else if clNick /= teamowner team then
[ProtocolError "Not team owner!"]
else
- [RemoveTeam name,
+ [RemoveTeam tName,
ModifyClient
(\c -> c{
teamsInGame = teamsInGame c - 1,
@@ -99,7 +99,7 @@
]
where
anotherTeamClan ci = teamcolor . fromJust . find (\t -> teamownerId t == ci) . teams
- findTeam = find (\t -> name == teamname t) . teams
+ findTeam = find (\t -> tName == teamname t) . teams
handleCmd_inRoom ["HH_NUM", teamName, numberStr] = do
@@ -113,7 +113,7 @@
return $
if not $ isMaster cl then
[ProtocolError "Not room master"]
- else if hhNumber < 1 || hhNumber > 8 || isNothing maybeTeam || hhNumber > (canAddNumber r) + (hhnum team) then
+ else if hhNumber < 1 || hhNumber > 8 || isNothing maybeTeam || hhNumber > canAddNumber r + hhnum team then
[]
else
[ModifyRoom $ modifyTeam team{hhnum = hhNumber},
@@ -121,7 +121,7 @@
where
hhNumber = case B.readInt numberStr of
Just (i, t) | B.null t -> fromIntegral i
- otherwise -> 0
+ _ -> 0
findTeam = find (\t -> teamName == teamname t) . teams
canAddNumber = (-) 48 . sum . map hhnum . teams
@@ -159,11 +159,11 @@
handleCmd_inRoom ["START_GAME"] = do
cl <- thisClient
- r <- thisRoom
+ rm <- thisRoom
chans <- roomClientsChans
- if isMaster cl && (playersIn r == readyPlayers r) && (not $ gameinprogress r) then
- if enoughClans r then
+ if isMaster cl && playersIn rm == readyPlayers rm && not (gameinprogress rm) then
+ if enoughClans rm then
return [
ModifyRoom
(\r -> r{
@@ -184,11 +184,11 @@
handleCmd_inRoom ["EM", msg] = do
cl <- thisClient
- r <- thisRoom
+ rm <- thisRoom
chans <- roomOthersChans
- if (teamsInGame cl > 0) && (gameinprogress r) && isLegal then
- return $ (AnswerClients chans ["EM", msg]) : [ModifyRoom (\r -> r{roundMsgs = roundMsgs r |> msg}) | not isKeepAlive]
+ if teamsInGame cl > 0 && gameinprogress rm && isLegal then
+ return $ AnswerClients chans ["EM", msg] : [ModifyRoom (\r -> r{roundMsgs = roundMsgs r |> msg}) | not isKeepAlive]
else
return []
where
@@ -197,20 +197,20 @@
handleCmd_inRoom ["ROUNDFINISHED", _] = do
cl <- thisClient
- r <- thisRoom
+ rm <- thisRoom
chans <- roomClientsChans
- if isMaster cl && (gameinprogress r) then
- return $ (ModifyRoom
+ if isMaster cl && gameinprogress rm then
+ return $ ModifyRoom
(\r -> r{
gameinprogress = False,
readyPlayers = 0,
roundMsgs = empty,
leftTeams = [],
teamsAtStart = []}
- ))
+ )
: UnreadyRoomClients
- : answerRemovedTeams chans r
+ : answerRemovedTeams chans rm
else
return []
where
@@ -239,7 +239,7 @@
maybeClientId <- clientByNick kickNick
master <- liftM isMaster thisClient
let kickId = fromJust maybeClientId
- let sameRoom = (clientRoom rnc thisClientId) == (clientRoom rnc kickId)
+ let sameRoom = clientRoom rnc thisClientId == clientRoom rnc kickId
return
[KickRoomClient kickId | master && isJust maybeClientId && (kickId /= thisClientId) && sameRoom]
@@ -249,6 +249,6 @@
chans <- roomSameClanChans
return [AnswerClients chans ["EM", engineMsg cl]]
where
- engineMsg cl = toEngineMsg $ "b" `B.append` (nick cl) `B.append` "(team): " `B.append` msg `B.append` "\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/HWProtoLobbyState.hs Sun Feb 06 18:59:53 2011 +0300
+++ b/gameServer/HWProtoLobbyState.hs Sun Feb 06 21:50:29 2011 +0300
@@ -2,14 +2,11 @@
module HWProtoLobbyState where
import qualified Data.Map as Map
-import qualified Data.IntSet as IntSet
import qualified Data.Foldable as Foldable
import Data.Maybe
import Data.List
-import Data.Word
import Control.Monad.Reader
import qualified Data.ByteString.Char8 as B
-import Control.DeepSeq
--------------------------------------
import CoreTypes
import Actions
@@ -17,6 +14,8 @@
import HandlerUtils
import RoomsAndClients
+
+answerAllTeams :: ClientInfo -> [TeamInfo] -> [Action]
answerAllTeams cl = concatMap toAnswer
where
clChan = sendChan cl
@@ -35,15 +34,15 @@
let roomsInfoList = concatMap (roomInfo irnc) . filter (\r -> (roomProto r == clientProto cl) && not (isRestrictedJoins r))
return [AnswerClients [sendChan cl] ("ROOMS" : roomsInfoList rooms)]
where
- roomInfo irnc room = [
- showB $ gameinprogress room,
- name room,
- showB $ playersIn room,
- showB $ length $ teams room,
- nick $ irnc `client` masterID room,
- head (Map.findWithDefault ["+gen+"] "MAP" (params room)),
- head (Map.findWithDefault ["Default"] "SCHEME" (params room)),
- head (Map.findWithDefault ["Default"] "AMMO" (params room))
+ roomInfo irnc r = [
+ showB $ gameinprogress r,
+ name r,
+ showB $ playersIn r,
+ showB $ length $ teams r,
+ nick $ irnc `client` masterID r,
+ head (Map.findWithDefault ["+gen+"] "MAP" (params r)),
+ head (Map.findWithDefault ["Default"] "SCHEME" (params r)),
+ head (Map.findWithDefault ["Default"] "AMMO" (params r))
]
@@ -52,26 +51,26 @@
s <- roomOthersChans
return [AnswerClients s ["CHAT", n, msg]]
-handleCmd_lobby ["CREATE_ROOM", newRoom, roomPassword]
- | illegalName newRoom = return [Warning "Illegal room name"]
+handleCmd_lobby ["CREATE_ROOM", rName, roomPassword]
+ | illegalName rName = return [Warning "Illegal room name"]
| otherwise = do
rs <- allRoomInfos
cl <- thisClient
- return $ if isJust $ find (\room -> newRoom == name room) rs then
+ return $ if isJust $ find (\r -> rName == name r) rs then
[Warning "Room exists"]
else
[
- AddRoom newRoom roomPassword,
+ AddRoom rName roomPassword,
AnswerClients [sendChan cl] ["CLIENT_FLAGS", "-r", nick cl]
]
-handleCmd_lobby ["CREATE_ROOM", newRoom] =
- handleCmd_lobby ["CREATE_ROOM", newRoom, ""]
+handleCmd_lobby ["CREATE_ROOM", rName] =
+ handleCmd_lobby ["CREATE_ROOM", rName, ""]
handleCmd_lobby ["JOIN_ROOM", roomName, roomPassword] = do
- (ci, irnc) <- ask
+ (_, irnc) <- ask
let ris = allRooms irnc
cl <- thisClient
let maybeRI = find (\ri -> roomName == name (irnc `room` ri)) ris
@@ -93,19 +92,19 @@
AnswerClients [sendChan cl] $ "JOINED" : nicks,
AnswerClients chans ["CLIENT_FLAGS", "-r", nick cl]
]
- ++ (map (readynessMessage cl) jRoomClients)
- ++ (answerFullConfig cl $ params jRoom)
- ++ (answerTeams cl jRoom)
- ++ (watchRound cl jRoom)
+ ++ map (readynessMessage cl) jRoomClients
+ ++ answerFullConfig cl (params jRoom)
+ ++ answerTeams cl jRoom
+ ++ watchRound cl jRoom
where
readynessMessage cl c = AnswerClients [sendChan cl] ["CLIENT_FLAGS", if isReady c then "+r" else "-r", nick c]
toAnswer cl (paramName, paramStrs) = AnswerClients [sendChan cl] $ "CFG" : paramName : paramStrs
- answerFullConfig cl params = map (toAnswer cl) (leftConfigPart ++ rightConfigPart)
+ answerFullConfig cl pr = map (toAnswer cl) (leftConfigPart ++ rightConfigPart)
where
- (leftConfigPart, rightConfigPart) = partition (\(p, _) -> p /= "MAP") $ Map.toList params
+ (leftConfigPart, rightConfigPart) = partition (\(p, _) -> p /= "MAP") $ Map.toList pr
answerTeams cl jRoom = let f = if gameinprogress jRoom then teamsAtStart else teams in answerAllTeams cl $ f jRoom
@@ -161,7 +160,7 @@
where
readNum = case B.readInt protoNum of
Just (i, t) | B.null t -> fromIntegral i
- otherwise -> 0
+ _ -> 0
handleCmd_lobby ["GET_SERVER_VAR"] = do
cl <- thisClient
--- a/gameServer/HWProtoNEState.hs Sun Feb 06 18:59:53 2011 +0300
+++ b/gameServer/HWProtoNEState.hs Sun Feb 06 21:50:29 2011 +0300
@@ -1,10 +1,8 @@
{-# LANGUAGE OverloadedStrings #-}
module HWProtoNEState where
-import qualified Data.IntMap as IntMap
import Data.Maybe
import Data.List
-import Data.Word
import Control.Monad.Reader
import qualified Data.ByteString.Char8 as B
--------------------------------------
@@ -45,7 +43,7 @@
where
parsedProto = case B.readInt protoNum of
Just (i, t) | B.null t -> fromIntegral i
- otherwise -> 0
+ _ -> 0
handleCmd_NotEntered ["PASSWORD", passwd] = do
--- a/gameServer/HandlerUtils.hs Sun Feb 06 18:59:53 2011 +0300
+++ b/gameServer/HandlerUtils.hs Sun Feb 06 21:50:29 2011 +0300
@@ -49,10 +49,10 @@
thisClientChans :: Reader (ClientIndex, IRnC) [ClientChan]
thisClientChans = do
(ci, rnc) <- ask
- return $ [sendChan (rnc `client` ci)]
+ return [sendChan (rnc `client` ci)]
answerClient :: [B.ByteString] -> Reader (ClientIndex, IRnC) [Action]
-answerClient msg = thisClientChans >>= return . (: []) . flip AnswerClients msg
+answerClient msg = liftM ((: []) . flip AnswerClients msg) thisClientChans
allRoomInfos :: Reader (a, IRnC) [RoomInfo]
allRoomInfos = liftM ((\irnc -> map (room irnc) $ allRooms irnc) . snd) ask
--- a/gameServer/NetRoutines.hs Sun Feb 06 18:59:53 2011 +0300
+++ b/gameServer/NetRoutines.hs Sun Feb 06 21:50:29 2011 +0300
@@ -13,7 +13,7 @@
import RoomsAndClients
acceptLoop :: Socket -> Chan CoreMessage -> IO ()
-acceptLoop servSock chan = forever $ do
+acceptLoop servSock chan = forever $
Exception.handle
(\(_ :: Exception.IOException) -> putStrLn "exception on connect") $
do
--- a/gameServer/OfficialServer/DBInteraction.hs Sun Feb 06 18:59:53 2011 +0300
+++ b/gameServer/OfficialServer/DBInteraction.hs Sun Feb 06 21:50:29 2011 +0300
@@ -5,32 +5,38 @@
) where
import Prelude hiding (catch);
+import Control.Concurrent
+import Control.Monad
+import Data.List as L
+import Data.ByteString.Char8 as B
+#if defined(OFFICIAL_SERVER)
import System.Process
import System.IO as SIO
-import Control.Concurrent
import qualified Control.Exception as Exception
-import Control.Monad
import qualified Data.Map as Map
import Data.Maybe
+import Data.Time
import System.Log.Logger
-import Data.Time
-import Data.ByteString.Char8 as B
-import Data.List as L
+#endif
------------------------
import CoreTypes
+#if defined(OFFICIAL_SERVER)
import Utils
+#endif
+localAddressList :: [B.ByteString]
localAddressList = ["127.0.0.1", "0:0:0:0:0:0:0:1", "0:0:0:0:0:ffff:7f00:1"]
+fakeDbConnection :: forall b. ServerInfo -> IO b
fakeDbConnection serverInfo = forever $ do
q <- readChan $ dbQueries serverInfo
case q of
- CheckAccount clId clUid _ clHost -> do
+ CheckAccount clId clUid _ clHost ->
writeChan (coreChan serverInfo) $ ClientAccountInfo clId clUid (if clHost `L.elem` localAddressList then Admin else Guest)
ClearCache -> return ()
SendStats {} -> return ()
-
+dbConnectionLoop :: forall b. ServerInfo -> IO b
#if defined(OFFICIAL_SERVER)
pipeDbConnectionLoop queries coreChan hIn hOut accountsCache =
Exception.handle (\(e :: Exception.IOException) -> warningM "Database" (show e) >> return accountsCache) $
@@ -97,5 +103,6 @@
dbConnectionLoop = fakeDbConnection
#endif
+startDBConnection :: ServerInfo -> IO ()
startDBConnection serverInfo =
- forkIO $ dbConnectionLoop serverInfo
+ forkIO (dbConnectionLoop serverInfo) >> return ()
--- a/gameServer/OfficialServer/extdbinterface.hs Sun Feb 06 18:59:53 2011 +0300
+++ b/gameServer/OfficialServer/extdbinterface.hs Sun Feb 06 21:50:29 2011 +0300
@@ -6,7 +6,7 @@
import Control.Monad
import Control.Exception
import System.IO
-import Maybe
+import Data.Maybe
import Database.HDBC
import Database.HDBC.MySQL
--------------------------
@@ -20,13 +20,13 @@
"UPDATE gameserver_stats SET players = ?, rooms = ?, last_update = UNIX_TIMESTAMP()"
dbInteractionLoop dbConn = forever $ do
- q <- (getLine >>= return . read)
+ q <- liftM read getLine
hPutStrLn stderr $ show q
case q of
CheckAccount clId clUid clNick _ -> do
statement <- prepare dbConn dbQueryAccount
- execute statement [SqlByteString $ clNick]
+ execute statement [SqlByteString clNick]
passAndRole <- fetchRow statement
finish statement
let response =
@@ -35,12 +35,12 @@
clId,
clUid,
HasAccount
- (fromSql $ head $ fromJust $ passAndRole)
- ((fromSql $ last $ fromJust $ passAndRole) == (Just (3 :: Int)))
+ (fromSql . head . fromJust $ passAndRole)
+ (fromSql (last . fromJust $ passAndRole) == Just (3 :: Int))
)
else
(clId, clUid, Guest)
- putStrLn (show response)
+ print response
hFlush stdout
SendStats clients rooms ->
@@ -51,8 +51,8 @@
Control.Exception.handle (\(e :: IOException) -> hPutStrLn stderr $ show e) $ handleSqlError $
bracket
(connectMySQL mySQLConnectionInfo)
- (disconnect)
- (dbInteractionLoop)
+ disconnect
+ dbInteractionLoop
--processRequest :: DBQuery -> IO String
--- a/gameServer/Opts.hs Sun Feb 06 18:59:53 2011 +0300
+++ b/gameServer/Opts.hs Sun Feb 06 21:50:29 2011 +0300
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
module Opts
(
getOpts,
@@ -5,36 +6,44 @@
import System.Environment
import System.Console.GetOpt
+import Data.Maybe ( fromMaybe )
+#if defined(OFFICIAL_SERVER)
+import qualified Data.ByteString.Char8 as B
import Network
-import Data.Maybe ( fromMaybe )
-import qualified Data.ByteString.Char8 as B
-
+#endif
+-------------------
import CoreTypes
import Utils
options :: [OptDescr (ServerInfo -> ServerInfo)]
options = [
- Option ['p'] ["port"] (ReqArg readListenPort "PORT") "listen on PORT",
- Option ['d'] ["dedicated"] (ReqArg readDedicated "BOOL") "start as dedicated (True or False)"
+ Option "p" ["port"] (ReqArg readListenPort "PORT") "listen on PORT",
+ Option "d" ["dedicated"] (ReqArg readDedicated "BOOL") "start as dedicated (True or False)"
]
-readListenPort,
- readDedicated,
- readDbLogin,
- readDbPassword,
- readDbHost :: String -> ServerInfo -> ServerInfo
+readListenPort
+ , readDedicated
+#if defined(OFFICIAL_SERVER)
+ , readDbLogin
+ , readDbPassword
+ readDbHost
+#endif
+ :: String -> ServerInfo -> ServerInfo
+
readListenPort str opts = opts{listenPort = readPort}
where
readPort = fromInteger $ fromMaybe 46631 (maybeRead str :: Maybe Integer)
-readDedicated str opts = opts{isDedicated = readDedicated}
+readDedicated str opts = opts{isDedicated = readDed}
where
- readDedicated = fromMaybe True (maybeRead str :: Maybe Bool)
+ readDed = fromMaybe True (maybeRead str :: Maybe Bool)
+#if defined(OFFICIAL_SERVER)
readDbLogin str opts = opts{dbLogin = B.pack str}
readDbPassword str opts = opts{dbPassword = B.pack str}
readDbHost str opts = opts{dbHost = B.pack str}
+#endif
getOpts :: ServerInfo -> IO ServerInfo
getOpts opts = do
--- a/gameServer/RoomsAndClients.hs Sun Feb 06 18:59:53 2011 +0300
+++ b/gameServer/RoomsAndClients.hs Sun Feb 06 21:50:29 2011 +0300
@@ -82,27 +82,27 @@
roomAddClient :: ClientIndex -> Room r -> Room r
-roomAddClient cl room = let cls = cl : roomClients' room; nr = room{roomClients' = cls} in cls `seq` nr `seq` nr
+roomAddClient cl rm = let cls = cl : roomClients' rm; nr = rm{roomClients' = cls} in cls `seq` nr
roomRemoveClient :: ClientIndex -> Room r -> Room r
-roomRemoveClient cl room = let cls = filter (/= cl) $ roomClients' room; nr = room{roomClients' = cls} in cls `seq` nr `seq` nr
+roomRemoveClient cl rm = let cls = filter (/= cl) $ roomClients' rm; nr = rm{roomClients' = cls} in cls `seq` nr
addRoom :: MRoomsAndClients r c -> r -> IO RoomIndex
-addRoom (MRoomsAndClients (rooms, _)) room = do
- i <- addElem rooms (Room [] room)
+addRoom (MRoomsAndClients (rooms, _)) rm = do
+ i <- addElem rooms (Room [] rm)
return $ RoomIndex i
addClient :: MRoomsAndClients r c -> c -> IO ClientIndex
-addClient (MRoomsAndClients (rooms, clients)) client = do
- i <- addElem clients (Client lobbyId client)
+addClient (MRoomsAndClients (rooms, clients)) cl = do
+ i <- addElem clients (Client lobbyId cl)
modifyElem rooms (roomAddClient (ClientIndex i)) (unRoomIndex lobbyId)
return $ ClientIndex i
removeRoom :: MRoomsAndClients r c -> RoomIndex -> IO ()
-removeRoom rnc@(MRoomsAndClients (rooms, _)) room@(RoomIndex ri)
- | room == lobbyId = error "Cannot delete lobby"
+removeRoom rnc@(MRoomsAndClients (rooms, _)) rm@(RoomIndex ri)
+ | rm == lobbyId = error "Cannot delete lobby"
| otherwise = do
clIds <- liftM roomClients' $ readElem rooms ri
forM_ clIds (moveClientToLobby rnc)
@@ -131,12 +131,12 @@
moveClientToLobby :: MRoomsAndClients r c -> ClientIndex -> IO ()
moveClientToLobby rnc ci = do
- room <- clientRoomM rnc ci
- moveClientInRooms rnc room lobbyId ci
+ rm <- clientRoomM rnc ci
+ moveClientInRooms rnc rm lobbyId ci
moveClientToRoom :: MRoomsAndClients r c -> RoomIndex -> ClientIndex -> IO ()
-moveClientToRoom rnc ri ci = moveClientInRooms rnc lobbyId ri ci
+moveClientToRoom rnc = moveClientInRooms rnc lobbyId
clientExists :: MRoomsAndClients r c -> ClientIndex -> IO Bool
@@ -155,10 +155,10 @@
allClientsM (MRoomsAndClients (_, clients)) = liftM (map ClientIndex) $ indicesM clients
clientsM :: MRoomsAndClients r c -> IO [c]
-clientsM (MRoomsAndClients (_, clients)) = indicesM clients >>= mapM (\ci -> liftM client' $ readElem clients ci)
+clientsM (MRoomsAndClients (_, clients)) = indicesM clients >>= mapM (liftM client' . readElem clients)
roomClientsIndicesM :: MRoomsAndClients r c -> RoomIndex -> IO [ClientIndex]
-roomClientsIndicesM (MRoomsAndClients (rooms, clients)) (RoomIndex ri) = liftM roomClients' (rooms `readElem` ri)
+roomClientsIndicesM (MRoomsAndClients (rooms, _)) (RoomIndex ri) = liftM roomClients' (rooms `readElem` ri)
roomClientsM :: MRoomsAndClients r c -> RoomIndex -> IO [c]
roomClientsM (MRoomsAndClients (rooms, clients)) (RoomIndex ri) = liftM roomClients' (rooms `readElem` ri) >>= mapM (\(ClientIndex ci) -> liftM client' $ readElem clients ci)
@@ -173,8 +173,8 @@
showRooms :: (Show r, Show c) => IRoomsAndClients r c -> String
showRooms rnc@(IRoomsAndClients (rooms, clients)) = concatMap showRoom (allRooms rnc)
where
- showRoom r = unlines $ ((show r) ++ ": " ++ (show $ room' $ rooms ! (unRoomIndex r))) : (map showClient (roomClients' $ rooms ! (unRoomIndex r)))
- showClient c = " " ++ (show c) ++ ": " ++ (show $ client' $ clients ! (unClientIndex c))
+ showRoom r = unlines $ (show r ++ ": " ++ (show . room' $ rooms ! unRoomIndex r)) : map showClient (roomClients' $ rooms ! unRoomIndex r)
+ showClient c = " " ++ show c ++ ": " ++ (show . client' $ clients ! unClientIndex c)
allRooms :: IRoomsAndClients r c -> [RoomIndex]
@@ -193,4 +193,4 @@
room (IRoomsAndClients (rooms, _)) (RoomIndex ri) = room' (rooms ! ri)
roomClients :: IRoomsAndClients r c -> RoomIndex -> [ClientIndex]
-roomClients (IRoomsAndClients (rooms, _)) (RoomIndex ri) = roomClients' $ (rooms ! ri)
+roomClients (IRoomsAndClients (rooms, _)) (RoomIndex ri) = roomClients' (rooms ! ri)
--- a/gameServer/ServerCore.hs Sun Feb 06 18:59:53 2011 +0300
+++ b/gameServer/ServerCore.hs Sun Feb 06 21:50:29 2011 +0300
@@ -41,10 +41,10 @@
Accept ci -> processAction (AddClient ci)
ClientMessage (ci, cmd) -> do
- liftIO $ debugM "Clients" $ (show ci) ++ ": " ++ (show cmd)
+ liftIO $ debugM "Clients" $ show ci ++ ": " ++ show cmd
removed <- gets removedClients
- when (not $ ci `Set.member` removed) $ do
+ unless (ci `Set.member` removed) $ do
as <- get
put $! as{clientIndex = Just ci}
reactCmd cmd
@@ -61,11 +61,11 @@
ClientAccountInfo ci uid info -> do
rnc <- gets roomsClients
exists <- liftIO $ clientExists rnc ci
- when (exists) $ do
+ when exists $ do
as <- get
put $! as{clientIndex = Just ci}
uid' <- client's clUID
- when (uid == (hashUnique uid')) $ processAction (ProcessAccountInfo info)
+ when (uid == hashUnique uid') $ processAction (ProcessAccountInfo info)
return ()
TimerAction tick ->
@@ -77,19 +77,19 @@
startServer si serverSocket = do
putStrLn $ "Listening on port " ++ show (listenPort si)
- forkIO $
+ _ <- forkIO $
acceptLoop
serverSocket
(coreChan si)
return ()
- forkIO $ timerLoop 0 $ coreChan si
+ _ <- forkIO $ timerLoop 0 $ coreChan si
startDBConnection si
rnc <- newRoomsAndClients newRoom
- forkIO $ evalStateT mainLoop (ServerState Nothing si Set.empty rnc)
+ _ <- forkIO $ evalStateT mainLoop (ServerState Nothing si Set.empty rnc)
forever $ threadDelay 3600000000 -- one hour
--- a/gameServer/Store.hs Sun Feb 06 18:59:53 2011 +0300
+++ b/gameServer/Store.hs Sun Feb 06 21:50:29 2011 +0300
@@ -56,7 +56,7 @@
let newM' = growFunc (m' + 1) - 1
newArr <- IOA.newArray_ (0, newM')
sequence_ [IOA.readArray arr i >>= IOA.writeArray newArr i | i <- [0..m']]
- writeIORef ref (busyElems, freeElems `IntSet.union` (IntSet.fromAscList [m'+1..newM']), newArr)
+ writeIORef ref (busyElems, freeElems `IntSet.union` IntSet.fromAscList [m'+1..newM'], newArr)
growIfNeeded :: MStore e -> IO ()
@@ -113,7 +113,7 @@
c <- IOA.unsafeFreeze c'
return $ IStore (a, c)
-i2m :: (MStore e) -> IStore e -> IO ()
+i2m :: MStore e -> IStore e -> IO ()
i2m (MStore ref) (IStore (_, arr)) = do
(b, e, _) <- readIORef ref
a <- IOA.unsafeThaw arr
--- a/gameServer/Utils.hs Sun Feb 06 18:59:53 2011 +0300
+++ b/gameServer/Utils.hs Sun Feb 06 21:50:29 2011 +0300
@@ -1,21 +1,15 @@
{-# LANGUAGE OverloadedStrings #-}
module Utils where
-import Control.Concurrent
-import Control.Concurrent.STM
import Data.Char
import Data.Word
import qualified Data.Map as Map
-import qualified Data.IntMap as IntMap
import qualified Data.Set as Set
-import Data.ByteString.Internal (w2c)
import Numeric
import Network.Socket
import System.IO
import qualified Data.List as List
import Control.Monad
-import Control.Monad.Trans
-import Data.Maybe
-------------------------------------------------
import qualified Codec.Binary.Base64 as Base64
import qualified Data.ByteString.Char8 as B
@@ -27,14 +21,14 @@
sockAddr2String (SockAddrInet _ hostAddr) = liftM B.pack $ inet_ntoa hostAddr
sockAddr2String (SockAddrInet6 _ _ (a, b, c, d) _) =
return $ B.pack $ (foldr1 (.)
- $ List.intersperse (\a -> ':':a)
- $ concatMap (\n -> (\(a, b) -> [showHex a, showHex b]) $ divMod n 65536) [a, b, c, d]) []
+ $ List.intersperse (':':)
+ $ concatMap (\n -> (\(a0, a1) -> [showHex a0, showHex a1]) $ divMod n 65536) [a, b, c, d]) []
toEngineMsg :: B.ByteString -> B.ByteString
-toEngineMsg msg = B.pack $ Base64.encode (fromIntegral (BW.length msg) : (BW.unpack msg))
+toEngineMsg msg = B.pack $ Base64.encode (fromIntegral (BW.length msg) : BW.unpack msg)
fromEngineMsg :: B.ByteString -> Maybe B.ByteString
-fromEngineMsg msg = Base64.decode (B.unpack msg) >>= removeLength >>= return . BW.pack
+fromEngineMsg msg = liftM BW.pack (Base64.decode (B.unpack msg) >>= removeLength)
where
removeLength (x:xs) = if length xs == fromIntegral x then Just xs else Nothing
removeLength _ = Nothing
@@ -43,7 +37,7 @@
checkNetCmd = check . liftM B.unpack . fromEngineMsg
where
check Nothing = (False, False)
- check (Just (m:ms)) = (m `Set.member` legalMessages, m == '+')
+ check (Just (m:_)) = (m `Set.member` legalMessages, m == '+')
check _ = (False, False)
legalMessages = Set.fromList $ "M#+LlRrUuDdZzAaSjJ,sFNpPwtghb12345" ++ slotMessages
slotMessages = "\128\129\130\131\132\133\134\135\136\137\138"
@@ -62,20 +56,20 @@
: teamvoicepack team
: teamflag team
: teamowner team
- : (B.pack $ show $ difficulty team)
+ : (B.pack . show $ difficulty team)
: hhsInfo
where
- hhsInfo = concatMap (\(HedgehogInfo name hat) -> [name, hat]) $ hedgehogs team
+ hhsInfo = concatMap (\(HedgehogInfo n hat) -> [n, hat]) $ hedgehogs team
modifyTeam :: TeamInfo -> RoomInfo -> RoomInfo
modifyTeam team room = room{teams = replaceTeam team $ teams room}
where
replaceTeam _ [] = error "modifyTeam: no such team"
- replaceTeam team (t:teams) =
- if teamname team == teamname t then
- team : teams
+ replaceTeam tm (t:ts) =
+ if teamname tm == teamname t then
+ tm : ts
else
- t : replaceTeam team teams
+ t : replaceTeam tm ts
illegalName :: B.ByteString -> Bool
illegalName b = null s || all isSpace s || isSpace (head s) || isSpace (last s)
--- a/gameServer/hedgewars-server.hs Sun Feb 06 18:59:53 2011 +0300
+++ b/gameServer/hedgewars-server.hs Sun Feb 06 21:50:29 2011 +0300
@@ -30,8 +30,8 @@
main :: IO ()
main = withSocketsDo $ do
#if !defined(mingw32_HOST_OS)
- installHandler sigPIPE Ignore Nothing;
- installHandler sigCHLD Ignore Nothing;
+ _ <- installHandler sigPIPE Ignore Nothing
+ _ <- installHandler sigCHLD Ignore Nothing
#endif
setupLoggers
--- a/gameServer/stresstest.hs Sun Feb 06 18:59:53 2011 +0300
+++ b/gameServer/stresstest.hs Sun Feb 06 21:50:29 2011 +0300
@@ -2,8 +2,8 @@
module Main where
-import IO
import System.IO
+import System.IO.Error
import Control.Concurrent
import Network
import Control.OldException
--- a/gameServer/stresstest2.hs Sun Feb 06 18:59:53 2011 +0300
+++ b/gameServer/stresstest2.hs Sun Feb 06 21:50:29 2011 +0300
@@ -2,7 +2,6 @@
module Main where
-import IO
import System.IO
import Control.Concurrent
import Network
--- a/gameServer/stresstest3.hs Sun Feb 06 18:59:53 2011 +0300
+++ b/gameServer/stresstest3.hs Sun Feb 06 21:50:29 2011 +0300
@@ -2,8 +2,8 @@
module Main where
-import IO
import System.IO
+import System.IO.Error
import Control.Concurrent
import Network
import Control.OldException
@@ -22,12 +22,11 @@
readPacket :: StateT SState IO [String]
readPacket = do
h <- get
- p <- io $ hGetPacket h []
- return p
+ io $ hGetPacket h []
where
hGetPacket h buf = do
l <- hGetLine h
- if (not $ null l) then hGetPacket h (buf ++ [l]) else return buf
+ if not $ null l then hGetPacket h (buf ++ [l]) else return buf
waitPacket :: String -> StateT SState IO Bool
waitPacket s = do
@@ -46,7 +45,7 @@
emulateSession = do
n <- io $ randomRIO (100000::Int, 100100)
waitPacket "CONNECTED"
- sendPacket ["NICK", "test" ++ (show n)]
+ sendPacket ["NICK", "test" ++ show n]
waitPacket "NICK"
sendPacket ["PROTO", "31"]
waitPacket "PROTO"
--- a/hedgewars/uGears.pas Sun Feb 06 18:59:53 2011 +0300
+++ b/hedgewars/uGears.pas Sun Feb 06 21:50:29 2011 +0300
@@ -1262,13 +1262,14 @@
procedure ShotgunShot(Gear: PGear);
var t: PGear;
- dmg: LongInt;
+ dmg, dist: LongInt;
begin
Gear^.Radius:= cShotgunRadius;
t:= GearsList;
while t <> nil do
begin
- dmg:= ModifyDamage(min(Gear^.Radius + t^.Radius - hwRound(Distance(Gear^.X - t^.X, Gear^.Y - t^.Y)), 25), t);
+ dist:= hwRound(Distance(Gear^.X - t^.X, Gear^.Y - t^.Y));
+ dmg:= ModifyDamage(min(Gear^.Radius + t^.Radius - dist, 25), t);
if dmg > 0 then
case t^.Kind of
gtHedgehog,
@@ -1278,6 +1279,7 @@
gtTarget,
gtExplosives,
gtStructure: begin
+addFileLog('ShotgunShot radius: ' + inttostr(Gear^.Radius) + ', t^.Radius = ' + inttostr(t^.Radius) + ', distance = ' + inttostr(dist) + ', dmg = ' + inttostr(dmg));
if (not t^.Invulnerable) then
ApplyDamage(t, Gear^.Hedgehog, dmg, dsBullet)
else