68 lines
2.1 KiB
Haskell
68 lines
2.1 KiB
Haskell
{-# LANGUAGE RecordWildCards #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
module Main where
|
|
|
|
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
|
|
|
|
import Options.Applicative
|
|
|
|
-- internal imports
|
|
|
|
import Library.Types
|
|
|
|
import Server.Game
|
|
import Server.Map (generateArena)
|
|
import Server.Types
|
|
|
|
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
|
|
let sockAddr = SockAddrUnix setSocketPath
|
|
unless (isSupportedSockAddr sockAddr)
|
|
(error $ "invalid socket path " <> setSocketPath)
|
|
let hints = defaultHints
|
|
{ addrFamily = AF_UNIX
|
|
, addrSocketType = Stream
|
|
, addrAddress = sockAddr
|
|
}
|
|
addr <- head <$> getAddrInfo (Just hints) Nothing Nothing
|
|
sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
|
|
bind sock (addrAddress addr)
|
|
putStrLn "Bound to socket:"
|
|
print =<< getSocketName sock
|
|
putStrLn "-----------------------------------------------------------------------------------"
|
|
arena <- generateArena setMapRows setMapColumns setSpawnerProbability
|
|
putStrLn "generated arena:"
|
|
print (arenaMap arena)
|
|
putStrLn "-----------------------------------------------------------------------------------"
|
|
putStrLn "starting game…"
|
|
now <- getCurrentTime
|
|
let initRead = ReaderContainer (arenaMap arena) setFPS
|
|
initState = StateContainer (arenaSpawners arena) [] (ServerState False False) now
|
|
(finalState, finalWrite) <- execRWST runGame initRead initState
|
|
print finalWrite
|
|
where
|
|
opts = info (options <**> helper)
|
|
( fullDesc
|
|
<> progDesc "Run the \"wizard-wipeout\" Server."
|
|
<> header "wizard-wipeout - Last Mage standing"
|
|
)
|