# HG changeset patch
# User unc0rr
# Date 1296326004 -10800
# Node ID e82758d6f924bb873f0e0bc7da9322ae07ec081c
# Parent  9541b2a7606752b0309b8f15d51a6e275aceb5ad
 - Reactivate pings timer, reimplement PING handler
 - Reimplement INFO

diff -r 9541b2a76067 -r e82758d6f924 CMakeLists.txt
--- a/CMakeLists.txt	Sat Jan 29 13:43:07 2011 +0300
+++ b/CMakeLists.txt	Sat Jan 29 21:33:24 2011 +0300
@@ -150,10 +150,10 @@
 if(Optz)
 #	set(pascal_compiler_flags_cmn "-O3" "-OpPENTIUM4" "-CfSSE3" "-Xs" "-Si" ${pascal_compiler_flags_cmn})
 	set(pascal_compiler_flags_cmn "-O2" "-Xs" "-Si" ${pascal_compiler_flags_cmn})
-	set(haskell_compiler_flags_cmn "-O2" "-w")
+	set(haskell_compiler_flags_cmn "-O2" "-w" "-fno-warn-unused-do-bind")
 else(Optz)
 	set(pascal_compiler_flags_cmn "-O-" "-g" "-gh" "-gl" "-dDEBUGFILE" ${pascal_compiler_flags_cmn})
-	set(haskell_compiler_flags_cmn "-Wall" "-debug" "-dcore-lint")
+	set(haskell_compiler_flags_cmn "-Wall" "-debug" "-dcore-lint" "-fno-warn-unused-do-bind")
 endif(Optz)
 
 
diff -r 9541b2a76067 -r e82758d6f924 gameServer/HWProtoCore.hs
--- a/gameServer/HWProtoCore.hs	Sat Jan 29 13:43:07 2011 +0300
+++ b/gameServer/HWProtoCore.hs	Sat Jan 29 21:33:24 2011 +0300
@@ -1,19 +1,19 @@
 {-# LANGUAGE OverloadedStrings #-}
 module HWProtoCore where
 
-import qualified Data.IntMap as IntMap
-import Data.Foldable
+import Control.Monad.Reader
 import Data.Maybe
-import Control.Monad.Reader
+import Data.List
+import qualified Data.ByteString.Char8 as B
 --------------------------------------
 import CoreTypes
 import Actions
-import Utils
 import HWProtoNEState
 import HWProtoLobbyState
 import HWProtoInRoomState
 import HandlerUtils
 import RoomsAndClients
+import Utils
 
 handleCmd, handleCmd_loggedin :: CmdHandler
 
@@ -23,17 +23,15 @@
 
 handleCmd ("QUIT" : xs) = return [ByeClient msg]
     where
-        msg = if not $ null xs then head xs else ""
+        msg = if not $ null xs then head xs else "bye"
+
 
-{-
-handleCmd ["PONG"] =
-    if pingsQueue client == 0 then
-        [ProtocolError "Protocol violation"]
-    else
-        [ModifyClient (\cl -> cl{pingsQueue = pingsQueue cl - 1})]
-    where
-        client = clients IntMap.! clID
--}
+handleCmd ["PONG"] = do
+    cl <- thisClient
+    if pingsQueue cl == 0 then
+        return [ProtocolError "Protocol violation"]
+        else
+        return [ModifyClient (\c -> c{pingsQueue = pingsQueue c - 1})]
 
 handleCmd cmd = do
     (ci, irnc) <- ask
@@ -42,31 +40,33 @@
         else
         handleCmd_NotEntered cmd
 
-{-
-handleCmd_loggedin clID clients rooms ["INFO", asknick] =
+
+handleCmd_loggedin ["INFO", asknick] = do
+    (_, rnc) <- ask
+    let allClientIDs = allClients rnc
+    let maybeClientId = find (\clId -> asknick == nick (client rnc clId)) allClientIDs
+    let noSuchClient = isNothing maybeClientId
+    let clientId = fromJust maybeClientId
+    let cl = rnc `client` fromJust maybeClientId
+    let roomId = clientRoom rnc clientId
+    let clRoom = room rnc roomId
+    let roomMasterSign = if isMaster cl then "@" else ""
+    let adminSign = if isAdministrator cl then "@" else ""
+    let roomInfo = if roomId /= lobbyId then roomMasterSign `B.append` "room " `B.append` (name clRoom) else adminSign `B.append` "lobby"
+    let roomStatus = if gameinprogress clRoom then
+            if teamsInGame cl > 0 then "(playing)" else "(spectating)"
+            else
+            ""
     if noSuchClient then
-        []
-    else
-        [AnswerThisClient
-            ["INFO",
-            nick client,
-            "[" ++ host client ++ "]",
-            protoNumber2ver $ clientProto client,
-            "[" ++ roomInfo ++ "]" ++ roomStatus]]
-    where
-        maybeClient = find (\cl -> asknick == nick cl) clients
-        noSuchClient = isNothing maybeClient
-        client = fromJust maybeClient
-        room = rooms IntMap.! roomID client
-        roomInfo = if roomID client /= 0 then roomMasterSign ++ "room " ++ (name room) else adminSign ++ "lobby"
-        roomMasterSign = if isMaster client then "@" else ""
-        adminSign = if isAdministrator client then "@" else ""
-        roomStatus =
-            if gameinprogress room
-            then if teamsInGame client > 0 then "(playing)" else "(spectating)"
-            else ""
-
--}
+        return []
+        else
+        answerClient [
+            "INFO",
+            nick cl,
+            "[" `B.append` host cl `B.append` "]",
+            protoNumber2ver $ clientProto cl,
+            "[" `B.append` roomInfo `B.append` "]" `B.append` roomStatus
+            ]
 
 
 handleCmd_loggedin cmd = do
diff -r 9541b2a76067 -r e82758d6f924 gameServer/ServerCore.hs
--- a/gameServer/ServerCore.hs	Sat Jan 29 13:43:07 2011 +0300
+++ b/gameServer/ServerCore.hs	Sat Jan 29 21:33:24 2011 +0300
@@ -2,9 +2,7 @@
 
 import Network
 import Control.Concurrent
-import Control.Concurrent.Chan
 import Control.Monad
-import qualified Data.IntMap as IntMap
 import System.Log.Logger
 import Control.Monad.Reader
 import Control.Monad.State.Strict
@@ -21,7 +19,7 @@
 
 
 timerLoop :: Int -> Chan CoreMessage -> IO ()
-timerLoop tick messagesChan = threadDelay (30 * 10^6) >> writeChan messagesChan (TimerAction tick) >> timerLoop (tick + 1) messagesChan
+timerLoop tick messagesChan = threadDelay 30000000 >> writeChan messagesChan (TimerAction tick) >> timerLoop (tick + 1) messagesChan
 
 
 reactCmd :: [B.ByteString] -> StateT ServerState IO ()
@@ -74,22 +72,22 @@
 
 
 startServer :: ServerInfo -> Socket -> IO ()
-startServer serverInfo serverSocket = do
-    putStrLn $ "Listening on port " ++ show (listenPort serverInfo)
+startServer si serverSocket = do
+    putStrLn $ "Listening on port " ++ show (listenPort si)
 
     forkIO $
         acceptLoop
             serverSocket
-            (coreChan serverInfo)
+            (coreChan si)
 
     return ()
 
-    --forkIO $ timerLoop 0 $ coreChan serverInfo
+    forkIO $ timerLoop 0 $ coreChan si
 
-    startDBConnection serverInfo
+    startDBConnection si
 
     rnc <- newRoomsAndClients newRoom
 
-    forkIO $ evalStateT mainLoop (ServerState Nothing serverInfo Set.empty rnc)
+    forkIO $ evalStateT mainLoop (ServerState Nothing si Set.empty rnc)
 
-    forever $ threadDelay (60 * 60 * 10^6)
+    forever $ threadDelay 3600000000 -- one hour