start imlementing client actions

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

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
+  :: LogLevel -- ^ Desired log level of message
-  -> String
+  -> 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 -- ^ Current log level
-  -> LogLevel
+  -> LogLevel -- ^ Desired log level of message
-  -> String
+  -> String   -- ^ The message
   -> IO ()
 logPrintIO curLevel level msg = do
   when (level <= curLevel) $

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
+  = ClientQuit                       -- ^ Message notifying the server of a client about to shut down
-  | ClientRequestWizard -- ^ Message for requesting a new player character
+  | ClientRequestWizard              -- ^ Message for requesting a new player character
-  | ClientReady         -- ^ Message requesting the server to position the client's character on the
+  | ClientReady                      -- ^ Message requesting the server to position the client's character on the
-                        --   map
+                                     --   map
-  | Pong                -- ^ A client's reply to a heartbeat request
+  | ClientAction                     -- ^ Message containting a singular action of a client
-    { pongId :: UUID    -- ^ The 'UUID' of the original heartbeat request
+    { 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

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 ()