94 lines
2.1 KiB
Haskell
94 lines
2.1 KiB
Haskell
{-# LANGUAGE DeriveGeneric #-}
|
|
module Server.Types where
|
|
|
|
import Control.Concurrent
|
|
|
|
import qualified Control.Concurrent.STM as STM
|
|
|
|
import Control.Monad.RWS.Strict
|
|
|
|
import qualified Data.Aeson as Aeson
|
|
|
|
import Data.Time.Clock
|
|
|
|
import Data.UUID
|
|
|
|
import GHC.Generics
|
|
|
|
import Network.Socket
|
|
|
|
import Options.Applicative as O
|
|
|
|
--internal imports
|
|
|
|
import Library.Types
|
|
|
|
data Settings = Settings
|
|
{ setSocketPath :: FilePath
|
|
, setMapRows :: Int
|
|
, setMapColumns :: Int
|
|
, setSpawnerProbability :: Float
|
|
, setFPS :: Int
|
|
, setClientMaxTimeout :: Float
|
|
, setFramesPerPing :: Int
|
|
}
|
|
deriving (Show, Generic)
|
|
|
|
instance Aeson.FromJSON Settings
|
|
|
|
newtype Options = Options
|
|
{ optConfLoc :: FilePath
|
|
}
|
|
|
|
options :: O.Parser Options
|
|
options = Options
|
|
<$> strOption
|
|
( long "configuration"
|
|
<> short 'c'
|
|
<> metavar "FILEPATH"
|
|
<> help "Location of the configuration YAML-file"
|
|
)
|
|
|
|
data ReaderContainer = ReaderContainer
|
|
{ rcMap :: ServerMap
|
|
, rcFPS :: Int
|
|
, rcFramesPerPing :: Int
|
|
, rcClientMaxTimeout :: Float
|
|
, rcMainSocket :: Socket
|
|
}
|
|
deriving (Eq, Show)
|
|
|
|
data StateContainer = StateContainer
|
|
{ scSpawners :: [Spawner]
|
|
, scPlayers :: STM.TMVar [Player]
|
|
, scServerState :: STM.TMVar ServerState
|
|
, scServerLastTick :: UTCTime
|
|
, scClientSockets :: STM.TMVar [ClientComms]
|
|
, scMessageQueue :: STM.TQueue ClientMessage
|
|
}
|
|
|
|
data ClientComms = ClientComms
|
|
{ ccUUID :: Maybe UUID
|
|
, ccSocket :: Socket
|
|
, ccQueue :: STM.TQueue ServerMessage
|
|
, ccWriter :: ThreadId
|
|
, ccListener :: ThreadId
|
|
}
|
|
deriving (Eq)
|
|
|
|
data Player = Player
|
|
{ playerId :: UUID
|
|
, playerWizard :: Wizard
|
|
, playerReady :: Bool
|
|
, playerLastPong :: (UTCTime, UUID)
|
|
}
|
|
deriving (Eq, Show)
|
|
|
|
-- | Data object for storing the server's state
|
|
data ServerState = ServerState
|
|
{ serverGameOver :: Bool -- ^ global game over state (only one contestant left)
|
|
, serverStop :: Bool -- ^ Server shutdown
|
|
}
|
|
deriving (Show, Eq)
|
|
|
|
type Game = RWST ReaderContainer String StateContainer IO
|