prepare graohics
This commit is contained in:
parent
b8214ddbec
commit
35da145cd1
2 changed files with 36 additions and 7 deletions
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue