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 curLevel <- asks rcLogLevel liftIO $ gracefulExit curLevel 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 ()