prepare graohics

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

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)
+      initState = StateContainer (initWizard playerWizard) clientState
-  putStrLn "sending quit message"
+  -- putStrLn "sending quit message"
-  sendMessage (ClientMessage clientId ClientQuit) sock
+  -- 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