wizard-wipeout/src-server/Main.hs

83 lines
2.2 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.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
putStrLn "Bound and listening to socket:"
print =<< getSocketName sock
putStrLn "-----------------------------------------------------------------------------------"
arena <- generateArena setMapRows setMapColumns setSpawnerProbability
putStrLn "generated arena:"
prettyPrintMap (arenaMap arena)
putStrLn "-----------------------------------------------------------------------------------"
putStrLn "starting game…"
now <- getCurrentTime
sockList <- STM.newTMVarIO []
messageQueue <- STM.newTQueueIO
serverState <- STM.newTMVarIO (ServerState False False)
emptyPLayers <- STM.newTMVarIO []
let initRead = ReaderContainer
(arenaMap arena)
setFPS
setFramesPerPing
setClientMaxTimeout
sock
initState = StateContainer (arenaSpawners arena) emptyPLayers serverState now sockList 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"
)