2023-12-20 08:12:22 +01:00
|
|
|
module Client.Game where
|
|
|
|
|
|
|
|
import Control.Monad.Loops
|
|
|
|
|
|
|
|
import Control.Monad.RWS
|
|
|
|
|
2024-04-19 20:18:49 +02:00
|
|
|
import Data.IORef (readIORef)
|
2024-04-17 19:44:47 +02:00
|
|
|
|
2024-01-20 10:49:57 +01:00
|
|
|
import Graphics.Vty
|
|
|
|
|
2023-12-20 08:12:22 +01:00
|
|
|
-- internal imports
|
|
|
|
|
|
|
|
import Client.Communication
|
2023-12-23 11:39:34 +01:00
|
|
|
import Client.Graphics
|
2023-12-20 08:12:22 +01:00
|
|
|
import Client.Types
|
|
|
|
|
|
|
|
import Library.Types
|
|
|
|
|
2024-04-17 19:44:47 +02:00
|
|
|
runGame
|
2024-04-19 20:18:49 +02:00
|
|
|
:: Game ()
|
|
|
|
runGame = do
|
2023-12-20 09:04:50 +01:00
|
|
|
sock <- asks rcSocket
|
|
|
|
queue <- asks rcQueue
|
2023-12-23 11:38:57 +01:00
|
|
|
clientId <- asks rcClientUUID
|
2024-03-29 23:01:41 +01:00
|
|
|
st <- get
|
2024-04-17 19:44:47 +02:00
|
|
|
-- recvThread <- liftIO $ forkIO $ forever $ receiveMessage sock queue st
|
2024-04-19 20:18:49 +02:00
|
|
|
liftIO $ sendMessage (ClientMessage clientId ClientReady) sock
|
2023-12-20 08:12:22 +01:00
|
|
|
whileM_
|
2024-04-19 20:18:49 +02:00
|
|
|
(liftIO (not <$> readIORef (scStopper st)))
|
2023-12-20 08:12:22 +01:00
|
|
|
(do
|
2024-04-17 19:44:47 +02:00
|
|
|
liftIO $ receiveMessage sock queue st
|
2023-12-20 09:04:50 +01:00
|
|
|
handleMessages
|
2024-01-23 11:13:52 +01:00
|
|
|
-- draw
|
2023-12-20 08:12:22 +01:00
|
|
|
)
|
2024-04-17 19:44:47 +02:00
|
|
|
-- liftIO $ killThread recvThread
|
2024-01-20 10:49:57 +01:00
|
|
|
|
|
|
|
handleEvent
|
|
|
|
:: Maybe Event
|
|
|
|
-> Game ()
|
|
|
|
handleEvent Nothing =
|
|
|
|
pure ()
|
|
|
|
handleEvent (Just event) =
|
|
|
|
pure ()
|