{-# 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 } )