# HG changeset patch # User unc0rr # Date 1297018229 -10800 # Node ID f11d80bac7edff17edf84680e37b9a616e5eaf0d # Parent da43c36a6e92619381917fb8d4b0b0aa7f6dff06 - Take into account hlint suggestions - Fix almost all warnings diff -r da43c36a6e92 -r f11d80bac7ed gameServer/Actions.hs --- 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 diff -r da43c36a6e92 -r f11d80bac7ed gameServer/ClientIO.hs --- 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 diff -r da43c36a6e92 -r f11d80bac7ed gameServer/CoreTypes.hs --- 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 "

http://www.hedgewars.org/

" @@ -154,7 +150,6 @@ "" "" [] - ) data AccountInfo = HasAccount B.ByteString Bool diff -r da43c36a6e92 -r f11d80bac7ed gameServer/HWProtoCore.hs --- 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 diff -r da43c36a6e92 -r f11d80bac7ed gameServer/HWProtoInRoomState.hs --- 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)"] diff -r da43c36a6e92 -r f11d80bac7ed gameServer/HWProtoLobbyState.hs --- 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 diff -r da43c36a6e92 -r f11d80bac7ed gameServer/HWProtoNEState.hs --- 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 diff -r da43c36a6e92 -r f11d80bac7ed gameServer/HandlerUtils.hs --- 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 diff -r da43c36a6e92 -r f11d80bac7ed gameServer/NetRoutines.hs --- 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 diff -r da43c36a6e92 -r f11d80bac7ed gameServer/OfficialServer/DBInteraction.hs --- 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 () diff -r da43c36a6e92 -r f11d80bac7ed gameServer/OfficialServer/extdbinterface.hs --- 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 diff -r da43c36a6e92 -r f11d80bac7ed gameServer/Opts.hs --- 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 diff -r da43c36a6e92 -r f11d80bac7ed gameServer/RoomsAndClients.hs --- 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) diff -r da43c36a6e92 -r f11d80bac7ed gameServer/ServerCore.hs --- 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 diff -r da43c36a6e92 -r f11d80bac7ed gameServer/Store.hs --- 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 diff -r da43c36a6e92 -r f11d80bac7ed gameServer/Utils.hs --- 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) diff -r da43c36a6e92 -r f11d80bac7ed gameServer/hedgewars-server.hs --- 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 diff -r da43c36a6e92 -r f11d80bac7ed gameServer/stresstest.hs --- 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 diff -r da43c36a6e92 -r f11d80bac7ed gameServer/stresstest2.hs --- 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 diff -r da43c36a6e92 -r f11d80bac7ed gameServer/stresstest3.hs --- 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" diff -r da43c36a6e92 -r f11d80bac7ed hedgewars/uGears.pas --- 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