46 lines
881 B
Haskell
46 lines
881 B
Haskell
module Client.Events where
|
|
|
|
import Control.Concurrent.STM (atomically, writeTQueue, flushTQueue)
|
|
|
|
import Control.Monad.IO.Class (liftIO)
|
|
|
|
import Control.Monad.RWS (asks, gets)
|
|
|
|
import Data.IORef (modifyIORef')
|
|
|
|
import Graphics.Vty
|
|
|
|
-- internal imports
|
|
|
|
import Client.Types
|
|
|
|
handleEvent
|
|
:: Event
|
|
-> Game ()
|
|
handleEvent (EvKey KEsc _) = do
|
|
stopper <- gets scStopper
|
|
liftIO $ modifyIORef' stopper (const True)
|
|
handleEvent _ =
|
|
pure ()
|
|
|
|
handleEvents
|
|
:: Game ()
|
|
handleEvents = do
|
|
eventQueue <- asks rcEventQueue
|
|
evs <- liftIO $ atomically $ flushTQueue eventQueue
|
|
mapM_
|
|
handleEvent
|
|
evs
|
|
|
|
pumpEvents
|
|
:: Vty
|
|
-> Game ()
|
|
pumpEvents vty = do
|
|
eventQueue <- asks rcEventQueue
|
|
mev <- liftIO $ nextEventNonblocking vty
|
|
case mev of
|
|
Just ev -> do
|
|
liftIO $ atomically $ writeTQueue eventQueue ev
|
|
pumpEvents vty
|
|
Nothing ->
|
|
return ()
|