diff --git a/src-client/Client/Events.hs b/src-client/Client/Events.hs index 578105c..9b23d41 100644 --- a/src-client/Client/Events.hs +++ b/src-client/Client/Events.hs @@ -11,18 +11,44 @@ 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 + :: 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 @@ -32,8 +58,9 @@ handleEvents = do handleEvent evs +-- | Function for punping all Events from Vty into a queue pumpEvents - :: Vty + :: Vty -> Game () pumpEvents vty = do eventQueue <- asks rcEventQueue diff --git a/src-client/Client/Log.hs b/src-client/Client/Log.hs index 3fd4547..3c1c646 100644 --- a/src-client/Client/Log.hs +++ b/src-client/Client/Log.hs @@ -10,19 +10,21 @@ import Debug.Trace (traceIO) import Client.Types (Game, LogLevel, ReaderContainer(rcLogLevel)) +-- | Print a log line logPrint - :: LogLevel - -> String + :: LogLevel -- ^ Desired log level of message + -> String -- ^ The message -> Game () logPrint level msg = do curLevel <- asks rcLogLevel when (level <= curLevel) $ liftIO $ traceIO $ show level <> ": " <> msg +-- | Print a log line logPrintIO - :: LogLevel - -> LogLevel - -> String + :: LogLevel -- ^ Current log level + -> LogLevel -- ^ Desired log level of message + -> String -- ^ The message -> IO () logPrintIO curLevel level msg = do when (level <= curLevel) $ diff --git a/src-lib/Library/Types/Communication.hs b/src-lib/Library/Types/Communication.hs index 52070ae..95fb961 100644 --- a/src-lib/Library/Types/Communication.hs +++ b/src-lib/Library/Types/Communication.hs @@ -36,12 +36,15 @@ instance FromJSON ServerMessage instance ToJSON ServerMessage data ClientMessagePayload - = ClientQuit -- ^ Message notifying the server of a client about to shut down - | ClientRequestWizard -- ^ Message for requesting a new player character - | ClientReady -- ^ Message requesting the server to position the client's character on the - -- map - | Pong -- ^ A client's reply to a heartbeat request - { pongId :: UUID -- ^ The 'UUID' of the original heartbeat request + = ClientQuit -- ^ Message notifying the server of a client about to shut down + | ClientRequestWizard -- ^ Message for requesting a new player character + | ClientReady -- ^ Message requesting the server to position the client's character on the + -- map + | ClientAction -- ^ Message containting a singular action of a client + { actionPayload :: ActionPayload -- ^ The contained action + } + | Pong -- ^ A client's reply to a heartbeat request + { pongId :: UUID -- ^ The 'UUID' of the original heartbeat request } deriving (Eq, Show, Generic) @@ -54,6 +57,15 @@ data ClientMessage -- 'UUID' ad startup deriving (Eq, Show, Generic) +data ActionPayload + = StepForward -- ^ Move a step forward + | StepBackward -- ^ Move a step backwards + | StrifeLeft -- ^ Move a step left + | StrifeRight -- ^ Move a step right + | TurnLeft -- ^ Turn left + | TurnRight -- ^ Turn right + deriving (Eq, Show, Generic) + instance FromJSON ClientMessagePayload instance ToJSON ClientMessagePayload @@ -61,3 +73,7 @@ instance ToJSON ClientMessagePayload instance FromJSON ClientMessage instance ToJSON ClientMessage + +instance FromJSON ActionPayload + +instance ToJSON ActionPayload diff --git a/src-server/Server/Communication/Handler.hs b/src-server/Server/Communication/Handler.hs index 0df8d65..1ad61aa 100644 --- a/src-server/Server/Communication/Handler.hs +++ b/src-server/Server/Communication/Handler.hs @@ -132,6 +132,9 @@ handleMessage stateContainer readerContainer msg = do mPlayer ) mclient + -- ClientAction act -> do + -- let mclient = find (\c -> csUUID c == Just clientId) socks + x -> logPrintIO (rcLogLevel readerContainer) Verbose ("Unhandled message: " <> show x) -- | handle received messages handleMessages :: Game ()