author | koda |
Sat, 05 Feb 2011 22:22:16 +0100 | |
changeset 4924 | 616b618814b5 |
parent 4921 | 2efad3acbb74 |
child 4932 | f11d80bac7ed |
permissions | -rw-r--r-- |
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
1 |
{-# LANGUAGE OverloadedStrings #-} |
1804 | 2 |
module Utils where |
3 |
||
4 |
import Control.Concurrent |
|
5 |
import Control.Concurrent.STM |
|
6 |
import Data.Char |
|
7 |
import Data.Word |
|
8 |
import qualified Data.Map as Map |
|
9 |
import qualified Data.IntMap as IntMap |
|
2304 | 10 |
import qualified Data.Set as Set |
2310 | 11 |
import Data.ByteString.Internal (w2c) |
1917 | 12 |
import Numeric |
13 |
import Network.Socket |
|
1964 | 14 |
import System.IO |
1917 | 15 |
import qualified Data.List as List |
2349 | 16 |
import Control.Monad |
4601 | 17 |
import Control.Monad.Trans |
4334 | 18 |
import Data.Maybe |
1804 | 19 |
------------------------------------------------- |
20 |
import qualified Codec.Binary.Base64 as Base64 |
|
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
21 |
import qualified Data.ByteString.Char8 as B |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
22 |
import qualified Data.ByteString as BW |
1804 | 23 |
import CoreTypes |
24 |
||
1917 | 25 |
|
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
26 |
sockAddr2String :: SockAddr -> IO B.ByteString |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
27 |
sockAddr2String (SockAddrInet _ hostAddr) = liftM B.pack $ inet_ntoa hostAddr |
1917 | 28 |
sockAddr2String (SockAddrInet6 _ _ (a, b, c, d) _) = |
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
29 |
return $ B.pack $ (foldr1 (.) |
2867
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
30 |
$ List.intersperse (\a -> ':':a) |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
31 |
$ concatMap (\n -> (\(a, b) -> [showHex a, showHex b]) $ divMod n 65536) [a, b, c, d]) [] |
1917 | 32 |
|
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
33 |
toEngineMsg :: B.ByteString -> B.ByteString |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
34 |
toEngineMsg msg = B.pack $ Base64.encode (fromIntegral (BW.length msg) : (BW.unpack msg)) |
1804 | 35 |
|
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
36 |
fromEngineMsg :: B.ByteString -> Maybe B.ByteString |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
37 |
fromEngineMsg msg = Base64.decode (B.unpack msg) >>= removeLength >>= return . BW.pack |
2867
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
38 |
where |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
39 |
removeLength (x:xs) = if length xs == fromIntegral x then Just xs else Nothing |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
40 |
removeLength _ = Nothing |
2304 | 41 |
|
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
42 |
checkNetCmd :: B.ByteString -> (Bool, Bool) |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
43 |
checkNetCmd = check . liftM B.unpack . fromEngineMsg |
2867
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
44 |
where |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
45 |
check Nothing = (False, False) |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
46 |
check (Just (m:ms)) = (m `Set.member` legalMessages, m == '+') |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
47 |
check _ = (False, False) |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
48 |
legalMessages = Set.fromList $ "M#+LlRrUuDdZzAaSjJ,sFNpPwtghb12345" ++ slotMessages |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
49 |
slotMessages = "\128\129\130\131\132\133\134\135\136\137\138" |
1804 | 50 |
|
51 |
maybeRead :: Read a => String -> Maybe a |
|
52 |
maybeRead s = case reads s of |
|
2867
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
53 |
[(x, rest)] | all isSpace rest -> Just x |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
54 |
_ -> Nothing |
1804 | 55 |
|
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
56 |
teamToNet :: TeamInfo -> [B.ByteString] |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
57 |
teamToNet team = |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
58 |
"ADD_TEAM" |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
59 |
: teamname team |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
60 |
: teamgrave team |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
61 |
: teamfort team |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
62 |
: teamvoicepack team |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
63 |
: teamflag team |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
64 |
: teamowner team |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
65 |
: (B.pack $ show $ difficulty team) |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
66 |
: hhsInfo |
2867
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
67 |
where |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
68 |
hhsInfo = concatMap (\(HedgehogInfo name hat) -> [name, hat]) $ hedgehogs team |
1804 | 69 |
|
70 |
modifyTeam :: TeamInfo -> RoomInfo -> RoomInfo |
|
71 |
modifyTeam team room = room{teams = replaceTeam team $ teams room} |
|
2867
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
72 |
where |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
73 |
replaceTeam _ [] = error "modifyTeam: no such team" |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
74 |
replaceTeam team (t:teams) = |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
75 |
if teamname team == teamname t then |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
76 |
team : teams |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
77 |
else |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
78 |
t : replaceTeam team teams |
1804 | 79 |
|
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
80 |
illegalName :: B.ByteString -> Bool |
4581 | 81 |
illegalName b = null s || all isSpace s || isSpace (head s) || isSpace (last s) |
82 |
where |
|
83 |
s = B.unpack b |
|
2150
45b695f3a7b9
Forbid room names and nicknames consisting only of space characters
unc0rr
parents:
2113
diff
changeset
|
84 |
|
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
85 |
protoNumber2ver :: Word16 -> B.ByteString |
4569 | 86 |
protoNumber2ver v = Map.findWithDefault "Unknown" v vermap |
87 |
where |
|
88 |
vermap = Map.fromList [ |
|
89 |
(17, "0.9.7-dev"), |
|
90 |
(19, "0.9.7"), |
|
91 |
(20, "0.9.8-dev"), |
|
92 |
(21, "0.9.8"), |
|
93 |
(22, "0.9.9-dev"), |
|
94 |
(23, "0.9.9"), |
|
95 |
(24, "0.9.10-dev"), |
|
96 |
(25, "0.9.10"), |
|
97 |
(26, "0.9.11-dev"), |
|
98 |
(27, "0.9.11"), |
|
99 |
(28, "0.9.12-dev"), |
|
100 |
(29, "0.9.12"), |
|
101 |
(30, "0.9.13-dev"), |
|
102 |
(31, "0.9.13"), |
|
103 |
(32, "0.9.14-dev"), |
|
104 |
(33, "0.9.14"), |
|
105 |
(34, "0.9.15-dev"), |
|
106 |
(35, "0.9.14.1"), |
|
107 |
(37, "0.9.15"), |
|
4583 | 108 |
(38, "0.9.16-dev")] |
1804 | 109 |
|
4921 | 110 |
askFromConsole :: B.ByteString -> IO B.ByteString |
1964 | 111 |
askFromConsole msg = do |
4921 | 112 |
B.putStr msg |
2867
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
113 |
hFlush stdout |
4921 | 114 |
B.getLine |
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
115 |
|
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
116 |
|
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
117 |
unfoldrE :: (b -> Either b (a, b)) -> b -> ([a], b) |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
118 |
unfoldrE f b = |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
119 |
case f b of |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
120 |
Right (a, new_b) -> let (a', b') = unfoldrE f new_b in (a : a', b') |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
121 |
Left new_b -> ([], new_b) |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
122 |
|
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
123 |
showB :: Show a => a -> B.ByteString |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
124 |
showB = B.pack .show |