wizard-wipeout/src-server/Main.hs

83 lines
2.2 KiB
Haskell
Raw Normal View History

2023-12-08 04:19:32 +00:00
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
2023-12-04 16:20:06 +00:00
module Main where
2024-03-29 09:34:15 +00:00
import Control.Concurrent (threadDelay)
import qualified Control.Concurrent.STM as STM
2023-12-08 04:19:32 +00:00
import Control.Monad.RWS.Strict
import qualified Data.ByteString.Char8 as B8
import Data.String (fromString)
import Data.Time
import Data.Yaml
2023-12-09 12:24:33 +00:00
import Network.Socket as Net
2023-12-09 07:55:56 +00:00
2023-12-08 04:19:32 +00:00
import Options.Applicative
-- internal imports
import Library.Map
2023-12-08 04:19:32 +00:00
import Library.Types
2023-12-09 12:58:59 +00:00
import Server.Communication
import Server.Game
2023-12-08 04:19:32 +00:00
import Server.Map (generateArena)
import Server.Types
2023-12-12 10:21:25 +00:00
import Server.Util
2023-12-08 04:19:32 +00:00
2023-12-04 16:20:06 +00:00
main :: IO ()
2023-12-08 04:19:32 +00:00
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
2023-12-09 12:58:59 +00:00
sock <- bindSocket setSocketPath
2023-12-09 12:24:33 +00:00
putStrLn "Bound and listening to socket:"
2023-12-09 07:55:56 +00:00
print =<< getSocketName sock
putStrLn "-----------------------------------------------------------------------------------"
2023-12-08 04:19:32 +00:00
arena <- generateArena setMapRows setMapColumns setSpawnerProbability
putStrLn "generated arena:"
prettyPrintMap (arenaMap arena)
2023-12-08 04:19:32 +00:00
putStrLn "-----------------------------------------------------------------------------------"
putStrLn "starting game…"
now <- getCurrentTime
sockList <- STM.newTMVarIO []
2023-12-11 08:49:24 +00:00
messageQueue <- STM.newTQueueIO
serverState <- STM.newTMVarIO (ServerState False False)
emptyPLayers <- STM.newTMVarIO []
2024-02-02 08:07:11 +00:00
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
2024-03-29 22:01:41 +00:00
removeIfExists setSocketPath
2024-03-29 09:34:15 +00:00
threadDelay 1000
2023-12-12 10:21:25 +00:00
putStrLn "bye bye"
2023-12-08 04:19:32 +00:00
where
opts = info (options <**> helper)
( fullDesc
<> progDesc "Run the \"wizard-wipeout\" Server."
<> header "wizard-wipeout - Last Mage standing"
)