wizard-wipeout/src-client/Main.hs

113 lines
2.7 KiB
Haskell
Raw Normal View History

2023-12-10 16:00:50 +00:00
{-# LANGUAGE LambdaCase #-}
2023-12-04 16:20:06 +00:00
module Main where
import Control.Concurrent (threadDelay)
import qualified Control.Concurrent.STM as STM
2023-12-13 12:36:06 +00:00
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Loops
import Control.Monad.RWS
import Graphics.Vty
import Options.Applicative
-- internal imports
import Client.Communication
import Client.Types
2023-12-10 16:00:50 +00:00
import Library.Types
2023-12-04 16:20:06 +00:00
main :: IO ()
main = do
putStrLn "Hello, Arena!"
(Options socketLocation) <- execParser opts
putStrLn $ "connecting to Socket " <> socketLocation
2023-12-10 19:12:53 +00:00
sock <- connectSocket socketLocation
putStrLn "connected"
2023-12-12 01:53:05 +00:00
2023-12-12 08:01:21 +00:00
queue <- STM.newTQueueIO
2023-12-10 19:12:53 +00:00
sendMessage (IdRequest) sock
2023-12-13 12:36:06 +00:00
-- threadDelay $ 1 * 10 ^ 6
receiveMessage sock queue
2023-12-12 08:01:21 +00:00
awaitResponse queue 1
clientIdMsg <- head <$> STM.atomically (STM.flushTQueue queue)
let clientId = acClientUUID clientIdMsg
putStrLn $ "received client UUID: " <> show clientId
2023-12-12 01:53:05 +00:00
putStrLn welcomeText
2023-12-12 08:01:21 +00:00
threadDelay $ 5 * 10 ^ 6
2023-12-12 01:53:05 +00:00
sendMessage (ClientMessage clientId ClientRequestWizard) sock
2023-12-13 12:36:06 +00:00
-- threadDelay $ 1 * 10 ^ 6
receiveMessage sock queue
2023-12-12 08:01:21 +00:00
awaitResponse queue 1
playerWizard <- head <$> STM.atomically (STM.flushTQueue queue)
2023-12-12 01:53:05 +00:00
putStrLn $ "received wizard: " <> show (initWizard playerWizard)
2023-12-13 12:36:06 +00:00
cfg <- standardIOConfig
vty <- mkVty cfg
-- shut down graphical interface for now
shutdown vty
2023-12-12 01:53:05 +00:00
2023-12-13 12:36:06 +00:00
clientState <- STM.newTMVarIO (ClientState vty False False)
let initRead = ReaderContainer sock clientId
2023-12-13 12:36:06 +00:00
initState = StateContainer (initWizard playerWizard) clientState
-- putStrLn "sending quit message"
-- sendMessage (ClientMessage clientId ClientQuit) sock
void $ execRWST
(do
terminateGameOnSigint
whileM_
(not . clientStop <$> (liftIO . STM.atomically . STM.readTMVar =<< gets scClientState))
(pure ())
)
initRead
initState
where
opts = info (options <**> helper)
( fullDesc
<> progDesc "Run the \"wizard-wipeout\" Server."
<> header "wizard-wipeout - Last Mage standing"
)
welcomeText :: String
welcomeText = mconcat $ map (<> "\n")
[ "Welcome to the arena, wizards."
, ""
, "Let the toughest and bravest of you survive"
, ""
, "Some last hints before you enter the fighting grounds:"
, ""
, "press [SPACE] to fire your wand"
, "press [1] through [9] to change wands, if you have collected more wands"
, "press [ESC] to leave"
, ""
, "Good Luck!"
]
2023-12-12 08:01:21 +00:00
awaitResponse
:: STM.TQueue ServerMessage
-> Int
-> IO ()
awaitResponse _ 10 = error "Tries to communicate with server exceeded"
awaitResponse queue numTries = do
responsePresent <- not <$> STM.atomically (STM.isEmptyTQueue queue)
if responsePresent
then pure ()
else do
threadDelay $ 10 ^ 6
awaitResponse queue (succ numTries)