2023-12-20 07:12:22 +00:00
|
|
|
module Client.Game where
|
|
|
|
|
2024-11-02 22:37:15 +00:00
|
|
|
import Control.Concurrent (threadDelay)
|
|
|
|
|
2024-10-28 11:20:04 +00:00
|
|
|
import Control.Concurrent.STM (atomically, readTMVar)
|
|
|
|
|
2023-12-20 07:12:22 +00:00
|
|
|
import Control.Monad.Loops
|
|
|
|
|
|
|
|
import Control.Monad.RWS
|
|
|
|
|
2024-04-19 18:18:49 +00:00
|
|
|
import Data.IORef (readIORef)
|
2024-04-17 17:44:47 +00:00
|
|
|
|
2023-12-20 07:12:22 +00:00
|
|
|
-- internal imports
|
|
|
|
|
|
|
|
import Client.Communication
|
2024-10-28 11:20:04 +00:00
|
|
|
import Client.Events
|
2023-12-23 10:39:34 +00:00
|
|
|
import Client.Graphics
|
2023-12-20 07:12:22 +00:00
|
|
|
import Client.Types
|
|
|
|
|
|
|
|
import Library.Types
|
|
|
|
|
2024-04-17 17:44:47 +00:00
|
|
|
runGame
|
2024-04-19 18:18:49 +00:00
|
|
|
:: Game ()
|
|
|
|
runGame = do
|
2023-12-20 08:04:50 +00:00
|
|
|
sock <- asks rcSocket
|
2024-10-28 11:20:04 +00:00
|
|
|
messageQueue <- asks rcMessageQueue
|
2023-12-23 10:38:57 +00:00
|
|
|
clientId <- asks rcClientUUID
|
2024-03-29 22:01:41 +00:00
|
|
|
st <- get
|
2024-10-28 11:20:04 +00:00
|
|
|
vty <- clientVty <$> liftIO (atomically $ readTMVar (scClientState st))
|
2024-04-19 18:18:49 +00:00
|
|
|
liftIO $ sendMessage (ClientMessage clientId ClientReady) sock
|
2023-12-20 07:12:22 +00:00
|
|
|
whileM_
|
2024-04-19 18:18:49 +00:00
|
|
|
(liftIO (not <$> readIORef (scStopper st)))
|
2023-12-20 07:12:22 +00:00
|
|
|
(do
|
2024-10-28 11:20:04 +00:00
|
|
|
liftIO $ receiveMessage sock messageQueue st
|
2023-12-20 08:04:50 +00:00
|
|
|
handleMessages
|
2024-10-28 11:20:04 +00:00
|
|
|
pumpEvents vty
|
|
|
|
handleEvents
|
2024-06-09 05:32:03 +00:00
|
|
|
draw
|
2023-12-20 07:12:22 +00:00
|
|
|
)
|
2024-11-02 22:37:15 +00:00
|
|
|
liftIO $ do
|
|
|
|
partingMessage clientId sock
|
|
|
|
threadDelay (10 ^ 6)
|