wizard-wipeout/src-client/Client/Game.hs

50 lines
1.2 KiB
Haskell
Raw Normal View History

2023-12-20 07:12:22 +00:00
module Client.Game where
import Control.Concurrent (threadDelay)
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
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
messageQueue <- asks rcMessageQueue
2023-12-23 10:38:57 +00:00
clientId <- asks rcClientUUID
2024-03-29 22:01:41 +00:00
st <- get
vty <- clientVty <$> liftIO (atomically $ readTMVar (scClientState st))
2024-04-19 18:18:49 +00:00
liftIO $ sendMessage (ClientMessage clientId ClientReady) sock
2024-11-03 10:19:19 +00:00
liftIO $ putStrLn "entering game loop"
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
liftIO $ receiveMessage sock messageQueue st
2024-11-03 10:19:19 +00:00
-- liftIO $ putStrLn "received messages"
2023-12-20 08:04:50 +00:00
handleMessages
2024-11-03 10:19:19 +00:00
-- liftIO $ putStrLn "handled messages"
pumpEvents vty
2024-11-03 10:19:19 +00:00
-- liftIO $ putStrLn "pumped events"
handleEvents
2024-11-03 10:19:19 +00:00
-- liftIO $ putStrLn "handled events"
2024-06-09 05:32:03 +00:00
draw
2024-11-03 10:19:19 +00:00
-- liftIO $ putStrLn "drew"
2023-12-20 07:12:22 +00:00
)
liftIO $ do
2024-11-03 10:19:19 +00:00
liftIO $ putStrLn "left game loop"
partingMessage clientId sock
threadDelay (10 ^ 6)