73 lines
1.6 KiB
Haskell
73 lines
1.6 KiB
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.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 ()
|