86 lines
2.5 KiB
Haskell
86 lines
2.5 KiB
Haskell
{-# LANGUAGE RecordWildCards #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
module Main where
|
|
|
|
import Control.Concurrent (threadDelay)
|
|
|
|
import qualified Control.Concurrent.STM as STM
|
|
|
|
import Control.Monad.RWS.Strict
|
|
|
|
import qualified Data.ByteString.Char8 as B8
|
|
|
|
import Data.String (fromString)
|
|
|
|
import Data.Time
|
|
|
|
import Data.Yaml
|
|
|
|
import Network.Socket as Net
|
|
|
|
import Options.Applicative
|
|
|
|
-- internal imports
|
|
|
|
import Library.Map
|
|
import Library.Types
|
|
|
|
import Server.Communication
|
|
import Server.Game
|
|
import Server.Log
|
|
import Server.Map (generateArena)
|
|
import Server.Types
|
|
import Server.Util
|
|
|
|
main :: IO ()
|
|
main = do
|
|
putStrLn "Hello, Wizards!"
|
|
(Options optSettingLoc) <- execParser opts
|
|
raw <- B8.readFile optSettingLoc
|
|
case decodeEither' raw of
|
|
Left msg ->
|
|
error (optSettingLoc <> ":" <>
|
|
" error: " <>
|
|
fromString (prettyPrintParseException msg)
|
|
)
|
|
Right (Settings {..}) -> do
|
|
sock <- bindSocket setSocketPath
|
|
let logLevel = setLogLevel
|
|
logPrintIO logLevel Info "Bound and listening to socket:"
|
|
logPrintIO logLevel Info . show =<< getSocketName sock
|
|
logPrintIO logLevel Info "-----------------------------------------------------------------------------------"
|
|
arena <- generateArena setMapRows setMapColumns setSpawnerProbability
|
|
logPrintIO logLevel Info "generated arena:"
|
|
prettyPrintMap (arenaMap arena)
|
|
logPrintIO logLevel Info "-----------------------------------------------------------------------------------"
|
|
logPrintIO logLevel Info "starting game…"
|
|
now <- getCurrentTime
|
|
sockList <- STM.newTMVarIO []
|
|
queueList <- STM.newTMVarIO []
|
|
messageQueue <- STM.newTQueueIO
|
|
serverState <- STM.newTMVarIO (ServerState False False)
|
|
emptyPLayers <- STM.newTMVarIO []
|
|
let initRead = ReaderContainer
|
|
(arenaMap arena)
|
|
setFPS
|
|
setFramesPerPing
|
|
setClientMaxTimeout
|
|
sock
|
|
logLevel
|
|
initState = StateContainer (arenaSpawners arena) emptyPLayers serverState now sockList queueList messageQueue
|
|
(finalState, finalWrite) <- execRWST
|
|
(do
|
|
terminateGameOnSigint
|
|
runGame
|
|
)
|
|
initRead
|
|
initState
|
|
removeIfExists setSocketPath
|
|
threadDelay 1000
|
|
putStrLn "bye bye"
|
|
where
|
|
opts = info (options <**> helper)
|
|
( fullDesc
|
|
<> progDesc "Run the \"wizard-wipeout\" Server."
|
|
<> header "wizard-wipeout - Last Mage standing"
|
|
)
|