- Collect synced packets to send within 1 second (cSendEmptyPacketTime) into buffer which is flushed each second.
- Send empty packet only if there was no other synced message within last second.
This should reduce traffic load: less bytes and less packets (less packets is very good for the server too).
{-# LANGUAGE OverloadedStrings #-}module Utils whereimport Data.Charimport Data.Wordimport qualified Data.Map as Mapimport qualified Data.Char as Charimport Numericimport Network.Socketimport System.IOimport qualified Data.List as Listimport Control.Monadimport qualified Data.ByteString.Lazy as BLimport qualified Text.Show.ByteString as BSimport qualified Data.ByteString.Char8 as Bimport qualified Data.ByteString.UTF8 as UTF8import Data.Maybe-------------------------------------------------import CoreTypessockAddr2String :: SockAddr -> IO B.ByteStringsockAddr2String (SockAddrInet _ hostAddr) = liftM B.pack $ inet_ntoa hostAddrsockAddr2String (SockAddrInet6 _ _ (a, b, c, d) _) = return $ B.pack $ (foldr1 (.) $ List.intersperse (':':) $ concatMap (\n -> (\(a0, a1) -> [showHex a0, showHex a1]) $ divMod n 65536) [a, b, c, d]) []maybeRead :: Read a => String -> Maybe amaybeRead s = case reads s of [(x, rest)] | all isSpace rest -> Just x _ -> NothingteamToNet :: TeamInfo -> [B.ByteString]teamToNet team = "ADD_TEAM" : teamname team : teamgrave team : teamfort team : teamvoicepack team : teamflag team : teamowner team : (showB . difficulty $ team) : hhsInfo where hhsInfo = concatMap (\(HedgehogInfo n hat) -> [n, hat]) $ hedgehogs teammodifyTeam :: TeamInfo -> RoomInfo -> RoomInfomodifyTeam team room = room{teams = replaceTeam team $ teams room} where replaceTeam _ [] = error "modifyTeam: no such team" replaceTeam tm (t:ts) = if teamname tm == teamname t then tm : ts else t : replaceTeam tm tsillegalName :: B.ByteString -> BoolillegalName s = B.null s || B.all isSpace s || isSpace (B.head s) || isSpace (B.last s) || B.any isIllegalChar s where isIllegalChar c = c `List.elem` "$()*+?[]^{|}"protoNumber2ver :: Word16 -> B.ByteStringprotoNumber2ver v = Map.findWithDefault "Unknown" v vermap where vermap = Map.fromList [ (17, "0.9.7-dev") , (19, "0.9.7") , (20, "0.9.8-dev") , (21, "0.9.8") , (22, "0.9.9-dev") , (23, "0.9.9") , (24, "0.9.10-dev") , (25, "0.9.10") , (26, "0.9.11-dev") , (27, "0.9.11") , (28, "0.9.12-dev") , (29, "0.9.12") , (30, "0.9.13-dev") , (31, "0.9.13") , (32, "0.9.14-dev") , (33, "0.9.14") , (34, "0.9.15-dev") , (35, "0.9.14.1") , (37, "0.9.15") , (38, "0.9.16-dev") , (39, "0.9.16") , (40, "0.9.17-dev") , (41, "0.9.17") , (42, "0.9.18-dev") , (43, "0.9.18") , (44, "0.9.19-dev") ]askFromConsole :: B.ByteString -> IO B.ByteStringaskFromConsole msg = do B.putStr msg hFlush stdout B.getLineunfoldrE :: (b -> Either b (a, b)) -> b -> ([a], b)unfoldrE f b = case f b of Right (a, new_b) -> let (a', b') = unfoldrE f new_b in (a : a', b') Left new_b -> ([], new_b)showB :: (BS.Show a) => a -> B.ByteStringshowB = B.concat . BL.toChunks . BS.showreadInt_ :: (Num a) => B.ByteString -> areadInt_ str = case B.readInt str of Just (i, t) | B.null t -> fromIntegral i _ -> 0 cutHost :: B.ByteString -> B.ByteStringcutHost = B.intercalate "." . flip (++) ["*","*"] . List.take 2 . B.split '.'caseInsensitiveCompare :: B.ByteString -> B.ByteString -> BoolcaseInsensitiveCompare a b = upperCase a == upperCase bupperCase :: B.ByteString -> B.ByteStringupperCase = UTF8.fromString . map Char.toUpper . UTF8.toStringroomInfo :: B.ByteString -> RoomInfo -> [B.ByteString]roomInfo n r = [ showB $ isJust $ gameInfo r, name r, showB $ playersIn r, showB $ length $ teams r, n, Map.findWithDefault "+rnd+" "MAP" (mapParams r), head (Map.findWithDefault ["Default"] "SCHEME" (params r)), head (Map.findWithDefault ["Default"] "AMMO" (params r)) ]loc :: B.ByteString -> B.ByteStringloc = id