prepare graohics

This commit is contained in:
nek0 2023-12-13 13:36:06 +01:00
parent b8214ddbec
commit 35da145cd1
2 changed files with 36 additions and 7 deletions

View file

@ -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

View file

@ -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