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.Log import Client.Types import Library.Types -- | Function for Handling singular input events handleEvent :: Event -- A single event -> Game () handleEvent (EvKey KEsc _) = do st <- get curLevel <- asks rcLogLevel liftIO $ gracefulExit curLevel st "Quitting due to user input" handleEvent (EvKey (KChar c) _) = do curLevel <- asks rcLogLevel cId <- asks rcClientUUID sock <- asks rcSocket let action = case c of 'w' -> Just StepForward 's' -> Just StepBackward 'a' -> Just TurnLeft 'd' -> Just TurnRight 'q' -> Just StrifeLeft 'e' -> Just StrifeRight _ -> Nothing maybe (logPrint Verbose $ "Unmapped input:" <> [c]) (\act -> do let msg = ClientMessage cId (ClientAction act) liftIO $ sendMessage curLevel msg sock ) action handleEvent _ = pure () -- | Function handling the event list from the queue handleEvents :: Game () handleEvents = do eventQueue <- asks rcEventQueue evs <- liftIO $ atomically $ flushTQueue eventQueue mapM_ handleEvent evs -- | Function for punping all Events from Vty into a queue 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 ()