diff -r dc9ea05c9d2f -r 340bfd438ca5 netserver/Miscutils.hs --- a/netserver/Miscutils.hs Sun Apr 12 12:50:43 2009 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,223 +0,0 @@ -module Miscutils where - -import IO -import Control.Concurrent.STM -import Data.Word -import Data.Char -import Data.List(find) -import Maybe (fromJust) -import qualified Data.Map as Map -import Data.Time -import Data.Sequence(Seq, empty) -import Network -import qualified Codec.Binary.Base64 as Base64 -import qualified Codec.Binary.UTF8.String as UTF8 - -data ClientInfo = - ClientInfo - { - chan :: TChan [String], - sendChan :: TChan [String], - handle :: Handle, - host :: String, - connectTime :: UTCTime, - nick :: String, - protocol :: Word16, - room :: String, - isMaster :: Bool, - isReady :: Bool, - forceQuit :: Bool, - partRoom :: Bool - } - -instance Eq ClientInfo where - a1 == a2 = handle a1 == handle a2 - -data HedgehogInfo = - HedgehogInfo String String - -data TeamInfo = - TeamInfo - { - teamowner :: String, - teamname :: String, - teamcolor :: String, - teamgrave :: String, - teamfort :: String, - teamvoicepack :: String, - difficulty :: Int, - hhnum :: Int, - hedgehogs :: [HedgehogInfo] - } - -data RoomInfo = - RoomInfo - { - name :: String, - password :: String, - roomProto :: Word16, - teams :: [TeamInfo], - gamemap :: String, - gameinprogress :: Bool, - playersIn :: Int, - readyPlayers :: Int, - isRestrictedJoins :: Bool, - isRestrictedTeams :: Bool, - roundMsgs :: Seq String, - leftTeams :: [String], - teamsAtStart :: [TeamInfo], - params :: Map.Map String [String] - } - -createRoom = ( - RoomInfo - "" - "" - 0 - [] - "+rnd+" - False - 1 - 0 - False - False - Data.Sequence.empty - [] - [] - Map.empty - ) - -data StatisticsInfo = - StatisticsInfo - { - playersNumber :: Int, - roomsNumber :: Int - } - -data ServerInfo = - ServerInfo - { - isDedicated :: Bool, - serverMessage :: String, - adminPassword :: String, - listenPort :: PortNumber, - loginsNumber :: Int, - lastHourUsers :: [UTCTime], - stats :: TMVar StatisticsInfo - } - -newServerInfo = ( - ServerInfo - True - "

http://www.hedgewars.org/

" - "" - 46631 - 0 - [] - ) - -type ClientsTransform = [ClientInfo] -> [ClientInfo] -type RoomsTransform = [RoomInfo] -> [RoomInfo] -type HandlesSelector = ClientInfo -> [ClientInfo] -> [RoomInfo] -> [ClientInfo] -type Answer = ServerInfo -> (HandlesSelector, [String]) -type CmdHandler = ClientInfo -> [ClientInfo] -> [RoomInfo] -> [String] -> (ClientsTransform, RoomsTransform, [Answer]) - - -roomByName :: String -> [RoomInfo] -> RoomInfo -roomByName roomName rooms = fromJust $ find (\room -> roomName == name room) rooms - -tselect :: [ClientInfo] -> STM ([String], ClientInfo) -tselect = foldl orElse retry . map (\ci -> (flip (,) ci) `fmap` readTChan (chan ci)) - -maybeRead :: Read a => String -> Maybe a -maybeRead s = case reads s of - [(x, rest)] | all isSpace rest -> Just x - _ -> Nothing - -deleteBy2t :: (a -> b -> Bool) -> b -> [a] -> [a] -deleteBy2t _ _ [] = [] -deleteBy2t eq x (y:ys) = if y `eq` x then ys else y : deleteBy2t eq x ys - -deleteFirstsBy2t :: (a -> b -> Bool) -> [a] -> [b] -> [a] -deleteFirstsBy2t eq = foldl (flip (deleteBy2t eq)) - ---clientByHandle :: Handle -> [ClientInfo] -> Maybe ClientInfo ---clientByHandle chandle clients = find (\c -> handle c == chandle) clients - -sameRoom :: HandlesSelector -sameRoom client clients rooms = filter (\ci -> room ci == room client) clients - -sameProtoLobbyClients :: HandlesSelector -sameProtoLobbyClients client clients rooms = filter (\ci -> room ci == [] && protocol ci == protocol client) clients - -otherLobbyClients :: HandlesSelector -otherLobbyClients client clients rooms = filter (\ci -> room ci == []) clients - -noRoomSameProto :: HandlesSelector -noRoomSameProto client clients _ = filter (null . room) $ filter (\ci -> protocol client == protocol ci) clients - -othersInRoom :: HandlesSelector -othersInRoom client clients rooms = filter (client /=) $ filter (\ci -> room ci == room client) clients - -fromRoom :: String -> HandlesSelector -fromRoom roomName _ clients _ = filter (\ci -> room ci == roomName) clients - -allClients :: HandlesSelector -allClients _ clients _ = clients - -clientOnly :: HandlesSelector -clientOnly client _ _ = [client] - -noChangeClients :: ClientsTransform -noChangeClients a = a - -modifyClient :: ClientInfo -> ClientsTransform -modifyClient _ [] = error "modifyClient: no such client" -modifyClient client (cl:cls) = - if cl == client then - client : cls - else - cl : (modifyClient client cls) - -modifyRoomClients :: RoomInfo -> (ClientInfo -> ClientInfo) -> ClientsTransform -modifyRoomClients clientsroom clientMod clients = map (\c -> if name clientsroom == room c then clientMod c else c) clients - -noChangeRooms :: RoomsTransform -noChangeRooms a = a - -addRoom :: RoomInfo -> RoomsTransform -addRoom room rooms = room:rooms - -removeRoom :: String -> RoomsTransform -removeRoom roomname rooms = filter (\rm -> roomname /= name rm) rooms - -modifyRoom :: RoomInfo -> RoomsTransform -modifyRoom _ [] = error "changeRoomConfig: no such room" -modifyRoom room (rm:rms) = - if name room == name rm then - room : rms - else - rm : modifyRoom room rms - -modifyTeam :: RoomInfo -> TeamInfo -> RoomInfo -modifyTeam room team = 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 - else - t : replaceTeam team teams - -proto2ver :: Word16 -> String -proto2ver 17 = "0.9.7-dev" -proto2ver 19 = "0.9.7" -proto2ver 20 = "0.9.8-dev" -proto2ver 21 = "0.9.8" -proto2ver 22 = "0.9.9-dev" -proto2ver 23 = "0.9.9" -proto2ver 24 = "0.9.10-dev" -proto2ver _ = "Unknown" - -toEngineMsg :: String -> String -toEngineMsg msg = Base64.encode (fromIntegral (length msg) : (UTF8.encode msg))