From 35da145cd1c71d53e39c8e7ce6fe804d73306bd8 Mon Sep 17 00:00:00 2001 From: nek0 Date: Wed, 13 Dec 2023 13:36:06 +0100 Subject: [PATCH] prepare graohics --- src-client/Client/Communication.hs | 7 ++++-- src-client/Main.hs | 36 +++++++++++++++++++++++++----- 2 files changed, 36 insertions(+), 7 deletions(-) diff --git a/src-client/Client/Communication.hs b/src-client/Client/Communication.hs index 7160630..ab2f8a7 100644 --- a/src-client/Client/Communication.hs +++ b/src-client/Client/Communication.hs @@ -16,6 +16,8 @@ import qualified Data.Vector.Storable as VS import Foreign hiding (void) +import Graphics.Vty as Vty + import Network.Socket import System.Posix.Signals @@ -71,10 +73,11 @@ terminateGameOnSigint = do void $ liftIO $ installHandler keyboardSignal (CatchOnce $ do - STM.atomically $ do + currentState <- STM.atomically $ do currentState <- STM.readTMVar clientState void $ STM.swapTMVar clientState $ currentState { clientStop = True } - threadDelay (10 ^ 6) + pure currentState + Vty.shutdown (clientVty currentState) sendMessage (ClientMessage clientId ClientQuit) sock close sock -- Raise SIGINT again so it does not get blocked diff --git a/src-client/Main.hs b/src-client/Main.hs index 3e49228..496a70a 100644 --- a/src-client/Main.hs +++ b/src-client/Main.hs @@ -5,6 +5,16 @@ import Control.Concurrent (threadDelay) import qualified Control.Concurrent.STM as STM +import Control.Monad + +import Control.Monad.IO.Class + +import Control.Monad.Loops + +import Control.Monad.RWS + +import Graphics.Vty + import Options.Applicative -- internal imports @@ -27,7 +37,7 @@ main = do sendMessage (IdRequest) sock - threadDelay $ 1 * 10 ^ 6 + -- threadDelay $ 1 * 10 ^ 6 receiveMessage sock queue awaitResponse queue 1 clientIdMsg <- head <$> STM.atomically (STM.flushTQueue queue) @@ -40,17 +50,33 @@ main = do sendMessage (ClientMessage clientId ClientRequestWizard) sock - threadDelay $ 1 * 10 ^ 6 + -- threadDelay $ 1 * 10 ^ 6 receiveMessage sock queue awaitResponse queue 1 playerWizard <- head <$> STM.atomically (STM.flushTQueue queue) putStrLn $ "received wizard: " <> show (initWizard playerWizard) + cfg <- standardIOConfig + vty <- mkVty cfg + -- shut down graphical interface for now + shutdown vty + + clientState <- STM.newTMVarIO (ClientState vty False False) let initRead = ReaderContainer sock clientId - initState = StateContainer (initWizard playerWizard) - putStrLn "sending quit message" - sendMessage (ClientMessage clientId ClientQuit) sock + 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 + forever $ pure () where opts = info (options <**> helper) ( fullDesc