author | koda |
Thu, 30 Sep 2010 22:31:38 +0200 | |
changeset 3920 | a54ca6185307 |
parent 3671 | a94d1dc4a8d9 |
child 4242 | 5e3c5fe2cb14 |
permissions | -rw-r--r-- |
3500
af8390d807d6
Use sockets instead of handles, use bytestrings instead of strings
unc0rr
parents:
3458
diff
changeset
|
1 |
{-# LANGUAGE OverloadedStrings #-} |
1804 | 2 |
module HWProtoCore where |
3 |
||
4 |
import qualified Data.IntMap as IntMap |
|
1862 | 5 |
import Data.Foldable |
3671
a94d1dc4a8d9
- burp's patch cleaning up module dependancies + cabal file
unc0rr
parents:
3500
diff
changeset
|
6 |
import Data.Maybe |
3435 | 7 |
import Control.Monad.Reader |
1804 | 8 |
-------------------------------------- |
9 |
import CoreTypes |
|
10 |
import Actions |
|
11 |
import Utils |
|
12 |
import HWProtoNEState |
|
13 |
import HWProtoLobbyState |
|
14 |
import HWProtoInRoomState |
|
3435 | 15 |
import HandlerUtils |
16 |
import RoomsAndClients |
|
1804 | 17 |
|
1862 | 18 |
handleCmd, handleCmd_loggedin :: CmdHandler |
1804 | 19 |
|
3435 | 20 |
|
21 |
handleCmd ["PING"] = answerClient ["PONG"] |
|
1804 | 22 |
|
3435 | 23 |
|
24 |
handleCmd ("QUIT" : xs) = return [ByeClient msg] |
|
2867
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2706
diff
changeset
|
25 |
where |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2706
diff
changeset
|
26 |
msg = if not $ null xs then head xs else "" |
1804 | 27 |
|
3435 | 28 |
{- |
3458 | 29 |
handleCmd ["PONG"] = |
2867
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2706
diff
changeset
|
30 |
if pingsQueue client == 0 then |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2706
diff
changeset
|
31 |
[ProtocolError "Protocol violation"] |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2706
diff
changeset
|
32 |
else |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2706
diff
changeset
|
33 |
[ModifyClient (\cl -> cl{pingsQueue = pingsQueue cl - 1})] |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2706
diff
changeset
|
34 |
where |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2706
diff
changeset
|
35 |
client = clients IntMap.! clID |
3435 | 36 |
-} |
1928 | 37 |
|
3435 | 38 |
handleCmd cmd = do |
39 |
(ci, irnc) <- ask |
|
40 |
if logonPassed (irnc `client` ci) then |
|
3458 | 41 |
handleCmd_loggedin cmd |
3435 | 42 |
else |
3458 | 43 |
handleCmd_NotEntered cmd |
1862 | 44 |
|
3435 | 45 |
{- |
1862 | 46 |
handleCmd_loggedin clID clients rooms ["INFO", asknick] = |
2867
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2706
diff
changeset
|
47 |
if noSuchClient then |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2706
diff
changeset
|
48 |
[] |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2706
diff
changeset
|
49 |
else |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2706
diff
changeset
|
50 |
[AnswerThisClient |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2706
diff
changeset
|
51 |
["INFO", |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2706
diff
changeset
|
52 |
nick client, |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2706
diff
changeset
|
53 |
"[" ++ host client ++ "]", |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2706
diff
changeset
|
54 |
protoNumber2ver $ clientProto client, |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2706
diff
changeset
|
55 |
"[" ++ roomInfo ++ "]" ++ roomStatus]] |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2706
diff
changeset
|
56 |
where |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2706
diff
changeset
|
57 |
maybeClient = find (\cl -> asknick == nick cl) clients |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2706
diff
changeset
|
58 |
noSuchClient = isNothing maybeClient |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2706
diff
changeset
|
59 |
client = fromJust maybeClient |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2706
diff
changeset
|
60 |
room = rooms IntMap.! roomID client |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2706
diff
changeset
|
61 |
roomInfo = if roomID client /= 0 then roomMasterSign ++ "room " ++ (name room) else adminSign ++ "lobby" |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2706
diff
changeset
|
62 |
roomMasterSign = if isMaster client then "@" else "" |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2706
diff
changeset
|
63 |
adminSign = if isAdministrator client then "@" else "" |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2706
diff
changeset
|
64 |
roomStatus = |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2706
diff
changeset
|
65 |
if gameinprogress room |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2706
diff
changeset
|
66 |
then if teamsInGame client > 0 then "(playing)" else "(spectating)" |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2706
diff
changeset
|
67 |
else "" |
1862 | 68 |
|
3435 | 69 |
-} |
1862 | 70 |
|
3435 | 71 |
|
72 |
handleCmd_loggedin cmd = do |
|
73 |
(ci, rnc) <- ask |
|
74 |
if clientRoom rnc ci == lobbyId then |
|
75 |
handleCmd_lobby cmd |
|
76 |
else |
|
77 |
handleCmd_inRoom cmd |