45 lines
869 B
Haskell
45 lines
869 B
Haskell
module Client.Events where
|
|
|
|
import Control.Concurrent.STM (atomically, writeTQueue, flushTQueue)
|
|
|
|
import Control.Monad.IO.Class (liftIO)
|
|
|
|
import Control.Monad.RWS (asks, get)
|
|
|
|
import Graphics.Vty
|
|
|
|
-- internal imports
|
|
|
|
import Client.Communication
|
|
import Client.Types
|
|
|
|
handleEvent
|
|
:: Event
|
|
-> Game ()
|
|
handleEvent (EvKey KEsc _) = do
|
|
st <- get
|
|
liftIO $ gracefulExit st "Quitting due to user input"
|
|
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 ()
|