8 import CoreTypes |
8 import CoreTypes |
9 |
9 |
10 registerEvent :: Event -> StateT ServerState IO [Action] |
10 registerEvent :: Event -> StateT ServerState IO [Action] |
11 registerEvent e = do |
11 registerEvent e = do |
12 eventInfo <- client's $ einfo e |
12 eventInfo <- client's $ einfo e |
13 if (not $ null eventInfo) && 0 == (fst $ head eventInfo) then doCheck eventInfo else updateInfo |
13 if (null eventInfo) || 0 == (fst $ head eventInfo) then doCheck eventInfo else updateInfo |
14 where |
14 where |
15 einfo LobbyChatMessage = eiLobbyChat |
15 einfo LobbyChatMessage = eiLobbyChat |
16 einfo EngineMessage = eiEM |
16 einfo EngineMessage = eiEM |
17 einfo RoomJoin = eiJoin |
17 einfo RoomJoin = eiJoin |
18 |
18 |
19 transformField LobbyChatMessage f = \c -> c{eiLobbyChat = f $ eiLobbyChat c} |
19 transformField LobbyChatMessage f = \c -> c{eiLobbyChat = f $ eiLobbyChat c} |
20 transformField EngineMessage f = \c -> c{eiLobbyChat = f $ eiEM c} |
20 transformField EngineMessage f = \c -> c{eiLobbyChat = f $ eiEM c} |
21 transformField RoomJoin f = \c -> c{eiLobbyChat = f $ eiJoin c} |
21 transformField RoomJoin f = \c -> c{eiLobbyChat = f $ eiJoin c} |
22 |
22 |
|
23 boundaries :: Event -> (Int, (NominalDiffTime, Int, [Action]), (NominalDiffTime, Int, [Action])) |
|
24 boundaries LobbyChatMessage = (3, (10, 2, []), (30, 3, [])) |
|
25 boundaries EngineMessage = (10, (10, 3, []), (30, 4, undefined)) |
|
26 boundaries RoomJoin = (2, (10, 2, []), (35, 3, [])) |
|
27 |
23 doCheck ei = do |
28 doCheck ei = do |
24 liftM Just $ io getCurrentTime |
29 curTime <- io getCurrentTime |
25 return [] |
30 let (numPerEntry, (sec1, num1, ac1), (sec2, num2, ac2)) = boundaries e |
|
31 |
|
32 let nei2 = takeWhile ((>=) sec2 . diffUTCTime curTime . snd) ei |
|
33 let nei1 = takeWhile ((>=) sec1 . diffUTCTime curTime . snd) nei1 |
|
34 |
|
35 let actions = if length nei2 >= num2 then ac2 else if length nei1 >= num1 then ac1 else [] |
|
36 |
|
37 return $ (ModifyClient . transformField e . const $ (numPerEntry, curTime) : nei2) : actions |
|
38 |
26 updateInfo = return [ |
39 updateInfo = return [ |
27 ModifyClient $ transformField e |
40 ModifyClient $ transformField e |
28 $ \ei -> if null ei then |
41 $ \(h:hs) -> first (flip (-) 1) h : hs |
29 [] |
|
30 else |
|
31 let (h:hs) = ei in first (flip (-) 1) h : hs |
|
32 ] |
42 ] |