author | nemo |
Wed, 29 Jul 2009 23:01:19 +0000 | |
changeset 2286 | 8a24e0858947 |
parent 2150 | 45b695f3a7b9 |
child 2304 | a6e733ad0366 |
permissions | -rw-r--r-- |
1804 | 1 |
module Utils where |
2 |
||
3 |
import Control.Concurrent |
|
4 |
import Control.Concurrent.STM |
|
5 |
import Data.Char |
|
6 |
import Data.Word |
|
7 |
import qualified Data.Map as Map |
|
8 |
import qualified Data.IntMap as IntMap |
|
1917 | 9 |
import Numeric |
10 |
import Network.Socket |
|
1964 | 11 |
import System.IO |
1917 | 12 |
import qualified Data.List as List |
1804 | 13 |
------------------------------------------------- |
14 |
import qualified Codec.Binary.Base64 as Base64 |
|
15 |
import qualified Codec.Binary.UTF8.String as UTF8 |
|
16 |
import CoreTypes |
|
17 |
||
1917 | 18 |
|
19 |
sockAddr2String :: SockAddr -> IO String |
|
20 |
sockAddr2String (SockAddrInet _ hostAddr) = inet_ntoa hostAddr |
|
21 |
sockAddr2String (SockAddrInet6 _ _ (a, b, c, d) _) = |
|
22 |
return $ (foldr1 (.) |
|
23 |
$ List.intersperse (\a -> ':':a) |
|
24 |
$ concatMap (\n -> (\(a, b) -> [showHex a, showHex b]) $ divMod n 65536) [a, b, c, d]) [] |
|
25 |
||
1804 | 26 |
toEngineMsg :: String -> String |
27 |
toEngineMsg msg = Base64.encode (fromIntegral (length msg) : (UTF8.encode msg)) |
|
28 |
||
29 |
--tselect :: [ClientInfo] -> STM ([String], ClientInfo) |
|
30 |
--tselect = foldl orElse retry . map (\ci -> (flip (,) ci) `fmap` readTChan (chan ci)) |
|
31 |
||
32 |
maybeRead :: Read a => String -> Maybe a |
|
33 |
maybeRead s = case reads s of |
|
34 |
[(x, rest)] | all isSpace rest -> Just x |
|
35 |
_ -> Nothing |
|
36 |
||
37 |
teamToNet team = [ |
|
38 |
"ADD_TEAM", |
|
39 |
teamname team, |
|
40 |
teamgrave team, |
|
41 |
teamfort team, |
|
42 |
teamvoicepack team, |
|
43 |
teamowner team, |
|
44 |
show $ difficulty team |
|
45 |
] |
|
46 |
++ hhsInfo |
|
47 |
where |
|
48 |
hhsInfo = concatMap (\(HedgehogInfo name hat) -> [name, hat]) $ hedgehogs team |
|
49 |
||
50 |
modifyTeam :: TeamInfo -> RoomInfo -> RoomInfo |
|
51 |
modifyTeam team room = room{teams = replaceTeam team $ teams room} |
|
52 |
where |
|
53 |
replaceTeam _ [] = error "modifyTeam: no such team" |
|
54 |
replaceTeam team (t:teams) = |
|
55 |
if teamname team == teamname t then |
|
56 |
team : teams |
|
57 |
else |
|
58 |
t : replaceTeam team teams |
|
59 |
||
2150
45b695f3a7b9
Forbid room names and nicknames consisting only of space characters
unc0rr
parents:
2113
diff
changeset
|
60 |
illegalName :: String -> Bool |
45b695f3a7b9
Forbid room names and nicknames consisting only of space characters
unc0rr
parents:
2113
diff
changeset
|
61 |
illegalName str = all isSpace str |
45b695f3a7b9
Forbid room names and nicknames consisting only of space characters
unc0rr
parents:
2113
diff
changeset
|
62 |
|
1804 | 63 |
protoNumber2ver :: Word16 -> String |
64 |
protoNumber2ver 17 = "0.9.7-dev" |
|
65 |
protoNumber2ver 19 = "0.9.7" |
|
66 |
protoNumber2ver 20 = "0.9.8-dev" |
|
67 |
protoNumber2ver 21 = "0.9.8" |
|
68 |
protoNumber2ver 22 = "0.9.9-dev" |
|
69 |
protoNumber2ver 23 = "0.9.9" |
|
70 |
protoNumber2ver 24 = "0.9.10-dev" |
|
71 |
protoNumber2ver 25 = "0.9.10" |
|
1953 | 72 |
protoNumber2ver 26 = "0.9.11-dev" |
2113 | 73 |
protoNumber2ver 27 = "0.9.11" |
74 |
protoNumber2ver 28 = "0.9.12-dev" |
|
1804 | 75 |
protoNumber2ver _ = "Unknown" |
76 |
||
1964 | 77 |
askFromConsole :: String -> IO String |
78 |
askFromConsole msg = do |
|
79 |
putStr msg |
|
80 |
hFlush stdout |
|
81 |
getLine |