author  sheepluva 
Sat, 17 Sep 2011 11:39:42 +0200  
changeset 5948  e389a60ae8ab 
parent 5060  7d0f6e5b1c1c 
child 5996  2c72fe81dd37 
permissions  rwrr 
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 HWProtoCore where 
3 

4612  4 
import Control.Monad.Reader 
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

5 
import Data.Maybe 
4612  6 
import qualified Data.ByteString.Char8 as B 
1804  7 
 
8 
import CoreTypes 

9 
import Actions 

10 
import HWProtoNEState 

11 
import HWProtoLobbyState 

12 
import HWProtoInRoomState 

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

13 
import HandlerUtils 
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

14 
import RoomsAndClients 
4612  15 
import Utils 
1804  16 

4989  17 
handleCmd, handleCmd_loggedin :: CmdHandler 
1804  18 

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

19 

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

20 
handleCmd ["PING"] = answerClient ["PONG"] 
1804  21 

22 

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

23 
handleCmd ("QUIT" : xs) = return [ByeClient msg] 
2867
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2706
diff
changeset

24 
where 
4612  25 
msg = if not $ null xs then head xs else "bye" 
1804  26 

4568  27 

4612  28 
handleCmd ["PONG"] = do 
29 
cl < thisClient 

30 
if pingsQueue cl == 0 then 

31 
return [ProtocolError "Protocol violation"] 

32 
else 

33 
return [ModifyClient (\c > c{pingsQueue = pingsQueue c  1})] 

4568  34 

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

35 
handleCmd cmd = do 
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 
(ci, irnc) < ask 
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 
if logonPassed (irnc `client` ci) then 
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

38 
handleCmd_loggedin cmd 
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

39 
else 
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

40 
handleCmd_NotEntered cmd 
1862  41 

4568  42 

4612  43 
handleCmd_loggedin ["INFO", asknick] = do 
44 
(_, rnc) < ask 

4614  45 
maybeClientId < clientByNick asknick 
5060
7d0f6e5b1c1c
Hide last two octets of IP address from usual users
unc0rr
parents:
5030
diff
changeset

46 
isAdminAsking < liftM isAdministrator thisClient 
4612  47 
let noSuchClient = isNothing maybeClientId 
48 
let clientId = fromJust maybeClientId 

49 
let cl = rnc `client` fromJust maybeClientId 

50 
let roomId = clientRoom rnc clientId 

51 
let clRoom = room rnc roomId 

52 
let roomMasterSign = if isMaster cl then "@" else "" 

53 
let adminSign = if isAdministrator cl then "@" else "" 

5030
42746c5d4a80
Changed the standard show function to Text.Show.ByteString, and misc.
EJ <eivind.jahren@gmail.com>
parents:
4989
diff
changeset

54 
let roomInfo = if roomId /= lobbyId then B.concat [roomMasterSign, "room ", name clRoom] else adminSign `B.append` "lobby" 
4612  55 
let roomStatus = if gameinprogress clRoom then 
56 
if teamsInGame cl > 0 then "(playing)" else "(spectating)" 

57 
else 

58 
"" 

5060
7d0f6e5b1c1c
Hide last two octets of IP address from usual users
unc0rr
parents:
5030
diff
changeset

59 
let hostStr = if isAdminAsking then host cl else cutHost $ host cl 
2867
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2706
diff
changeset

60 
if noSuchClient then 
4612  61 
return [] 
62 
else 

63 
answerClient [ 

64 
"INFO", 

65 
nick cl, 

5060
7d0f6e5b1c1c
Hide last two octets of IP address from usual users
unc0rr
parents:
5030
diff
changeset

66 
B.concat ["[", hostStr, "]"], 
4612  67 
protoNumber2ver $ clientProto cl, 
5030
42746c5d4a80
Changed the standard show function to Text.Show.ByteString, and misc.
EJ <eivind.jahren@gmail.com>
parents:
4989
diff
changeset

68 
B.concat ["[", roomInfo, "]", roomStatus] 
4612  69 
] 
1862  70 

71 

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

72 
handleCmd_loggedin cmd = do 
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

73 
(ci, rnc) < ask 
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

74 
if clientRoom rnc ci == lobbyId then 
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

75 
handleCmd_lobby cmd 
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

76 
else 
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

77 
handleCmd_inRoom cmd 