GCI2012: Improve Game Configuration Widget
- Refactored mapmodel+datamanager to have two separate map models for static and mission maps, and then three static MapInfos in MapModel for the three special maps (random, maze, drawn).
- Created theme selector dialog.
- Created seed view/edit dialog.
- Enlarged start icon on pagemultiplayer and pagenetgame, and added Start.png.
- Moved "Settings" button on pagemultiplayer and pagenetgame from middle of page to page footer.
- Added "load drawing" button to mapcontainer widget.
- Map preview is no longer the randomize button; The randomize functionality is now in a button of its own.
- Map preview no longer grays out (isn't disabled) when in slave mode.
- Seed is now viewable and copyable when in slave mode -- but not editable.
- You should now use the property master (isMaster() and setMaster()) on gamecfgwidget and mapcontainer instead of the enabled property. This is because some widgets (e.g. "view/edit seed" button and map preview) shouldn't be disabled, when all other widgets should be.
- Added mission map descriptions w/ locale support in INI format in mapname/desc.txt if applicable. Use '|' for line break.
module ServerCore where
import Control.Concurrent
import Control.Monad
import System.Log.Logger
import Control.Monad.Reader
import Control.Monad.State.Strict
import Data.Set as Set
import qualified Data.ByteString.Char8 as B
import Control.DeepSeq
import Data.Unique
import Data.Maybe
--------------------------------------
import CoreTypes
import NetRoutines
import HWProtoCore
import Actions
import OfficialServer.DBInteraction
import ServerState
timerLoop :: Int -> Chan CoreMessage -> IO ()
timerLoop tick messagesChan = threadDelay 30000000 >> writeChan messagesChan (TimerAction tick) >> timerLoop (tick + 1) messagesChan
reactCmd :: [B.ByteString] -> StateT ServerState IO ()
reactCmd cmd = do
(Just ci) <- gets clientIndex
rnc <- gets roomsClients
actions <- liftIO $ withRoomsAndClients rnc (\irnc -> runReader (handleCmd cmd) (ci, irnc))
forM_ (actions `deepseq` actions) processAction
mainLoop :: StateT ServerState IO ()
mainLoop = forever $ do
-- get >>= \s -> put $! s
si <- gets serverInfo
r <- liftIO $ readChan $ coreChan si
case r of
Accept ci -> processAction (AddClient ci)
ClientMessage (ci, cmd) -> do
liftIO $ debugM "Clients" $ show ci ++ ": " ++ show cmd
removed <- gets removedClients
unless (ci `Set.member` removed) $ do
modify (\s -> s{clientIndex = Just ci})
reactCmd cmd
Remove ci ->
processAction (DeleteClient ci)
ClientAccountInfo ci uid info -> do
rnc <- gets roomsClients
exists <- liftIO $ clientExists rnc ci
when exists $ do
modify (\s -> s{clientIndex = Just ci})
uid' <- client's clUID
when (uid == hashUnique uid') $ processAction (ProcessAccountInfo info)
return ()
TimerAction tick ->
mapM_ processAction $
PingAll : [StatsAction | even tick]
startServer :: ServerInfo -> IO ()
startServer si = do
noticeM "Core" $ "Listening on port " ++ show (listenPort si)
_ <- forkIO $
acceptLoop
(fromJust $ serverSocket si)
(coreChan si)
_ <- forkIO $ timerLoop 0 $ coreChan si
startDBConnection si
rnc <- newRoomsAndClients newRoom
evalStateT mainLoop (ServerState Nothing si Set.empty rnc)