126 lines
3.5 KiB
Haskell
126 lines
3.5 KiB
Haskell
{-# LANGUAGE RecordWildCards #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
module Main where
|
|
|
|
import Control.Concurrent (threadDelay)
|
|
|
|
import Control.Monad.Loops
|
|
|
|
import Control.Monad.RWS.Strict
|
|
|
|
import qualified Data.ByteString.Char8 as B8
|
|
|
|
import Data.String (fromString)
|
|
|
|
import Data.Time
|
|
|
|
import Data.Yaml
|
|
|
|
import Options.Applicative
|
|
|
|
-- internal imports
|
|
|
|
import Library.Types
|
|
|
|
import Server.Types
|
|
import Server.Map (generateArena)
|
|
|
|
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
|
|
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"
|
|
)
|
|
|
|
runGame :: Game
|
|
runGame = do
|
|
whileM_
|
|
(not . serverStop <$> gets scServerState)
|
|
(do
|
|
before <- gets scServerLastTick
|
|
now <- liftIO getCurrentTime
|
|
let delta = realToFrac $ diffUTCTime now before
|
|
updateSpawners delta
|
|
updateWizards delta
|
|
fps <- asks rcFPS
|
|
let remainingTime = recip (fromIntegral fps) - delta
|
|
when (remainingTime > 0) $
|
|
liftIO $ threadDelay $ floor $ remainingTime * 10 ^ 6
|
|
)
|
|
|
|
updateSpawners :: Float -> Game
|
|
updateSpawners dt =
|
|
modify' (\sc@(StateContainer spawners _ _ _) ->
|
|
let newSpawners = map
|
|
(\spawner -> do
|
|
let newTTL = spawnerReloadTTL spawner - dt
|
|
if newTTL < 0 && spawnerState spawner == SpawnerEmpty
|
|
then spawner
|
|
{ spawnerReloadTTL = fromIntegral $ spawnerReloadTime spawner
|
|
, spawnerState = SpawnerFull
|
|
}
|
|
else spawner
|
|
{ spawnerReloadTTL = spawnerReloadTTL spawner - dt
|
|
}
|
|
)
|
|
spawners
|
|
in sc
|
|
{ scSpawners = newSpawners
|
|
}
|
|
)
|
|
|
|
updateWizards :: Float -> Game
|
|
updateWizards dt =
|
|
modify' (\sc@(StateContainer _ wizards _ _) ->
|
|
let newWizards = map
|
|
(\wizard@(Wizard _ _ health _ _ effects) ->
|
|
let newEffects = foldl
|
|
(\acc effect@(Effect _ ttl) ->
|
|
if ttl - dt < 0
|
|
then acc
|
|
else effect
|
|
{ effectTTL = ttl - dt
|
|
} : acc
|
|
)
|
|
[]
|
|
effects
|
|
effectDamage = foldl
|
|
(\acc (Effect kind _) ->
|
|
if kind `elem` harmingAfflictions
|
|
then acc + 1
|
|
else acc
|
|
)
|
|
0
|
|
effects
|
|
in wizard
|
|
{ wizardEffects = newEffects
|
|
, wizardHealth = health - effectDamage
|
|
}
|
|
)
|
|
wizards
|
|
in sc
|
|
{ scPlayers = newWizards
|
|
}
|
|
)
|