restructure of library and introducing channels to client

src-client/Client/Communication.hs

@@ -1,6 +1,8 @@
 {-# LANGUAGE LambdaCase #-}
 module Client.Communication where
 
+import qualified Control.Concurrent.STM as STM
+
 import Control.Monad (void)
 
 import qualified Data.Aeson as A
@@ -8,6 +10,8 @@ import qualified Data.Aeson as A
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Lazy.Char8 as B8
 
+import Data.Maybe (fromJust)
+
 import qualified Data.Vector.Storable as VS
 
 import Foreign hiding (void)
@@ -41,16 +45,15 @@ sendMessage msg sock = do
 
 receiveMessage
   :: Socket
-  -> IO ServerMessage
+  -> STM.TQueue ServerMessage
-receiveMessage sock = do
+  -> IO ()
+receiveMessage sock queue = do
   let maxBufferLength = 4096
   ptr <- mallocArray maxBufferLength
   bufferLength <- recvBuf sock ptr maxBufferLength
   msg <- B.pack <$> peekArray bufferLength ptr
   let mJsonMsg = A.decode' $ B8.fromStrict msg
-  jsonMsg <- maybe
+  maybe
-    (error $ "unexpected message from Server: " <> show msg)
+    (pure ())
-    pure
+    (STM.atomically . STM.writeTQueue queue)
     mJsonMsg
-  free ptr
-  pure jsonMsg

src-client/Main.hs

@@ -3,6 +3,8 @@ module Main where
 
 import Control.Concurrent (threadDelay)
 
+import qualified Control.Concurrent.STM as STM
+
 import Options.Applicative
 
 -- internal imports
@@ -18,17 +20,24 @@ main = do
   (Options socketLocation) <- execParser opts
   putStrLn $ "connecting to Socket " <> socketLocation
   sock <- connectSocket socketLocation
+  queue <- STM.newTQueueIO
   putStrLn "connected"
   sendMessage (IdRequest) sock
-  threadDelay $ 5 * 10 ^ 6
+  threadDelay $ 1 * 10 ^ 6
-  clientIdMsg <- receiveMessage sock
+  receiveMessage sock queue
+  threadDelay $ 1 * 10 ^ 6
+  clientIdMsg <- head <$> STM.atomically (STM.flushTQueue queue)
   let clientId = acClientUUID clientIdMsg
   putStrLn $ "received client UUID: " <> show clientId
-  threadDelay $ 5 * 10 ^ 6
+  threadDelay $ 1 * 10 ^ 6
   putStrLn welcomeText
   threadDelay $ 15 * 10 ^ 6
+  putStrLn welcomeText
   sendMessage (ClientMessage clientId ClientRequestWizard) sock
-  playerWizard <- receiveMessage sock
+  threadDelay $ 1 * 10 ^ 6
+  receiveMessage sock queue
+  threadDelay $ 1 * 10 ^ 6
+  playerWizard <- head <$> STM.atomically (STM.flushTQueue queue)
   putStrLn "received wizard"
   print (initWizard playerWizard)
   let initRead = ReaderContainer sock clientId
@@ -50,7 +59,7 @@ welcomeText = mconcat $ map (<> "\n")
   , ""
   , "Some last hints before you enter the fighting grounds:"
   , ""
-  , "press [SpACE] to fire your wand"
+  , "press [SPACE] to fire your wand"
   , "press [1] through [9] to change wands, if you have collected more wands"
   , "press [ESC] to leave"
   , ""

src-lib/Library/Types.hs

@@ -1,48 +1,7 @@
 module Library.Types
   ( module T
-  , module Library.Types
   ) where
 
-import Data.Matrix
-import Graphics.Vty
-
 import Library.Types.Communication as T
 import Library.Types.Player as T
-
+import Library.Types.Map as T
--- | Data object for storing the client's state
-data ClientState = ClientState
-  { clientVty      :: Vty  -- ^ Context object for graphics
-  , clientGameOver :: Bool -- ^ client game over (contestant died)
-  , clientStop     :: Bool -- ^ client shutdown
-  }
-
--- | Type synonym for the Map. Translates to a Matrix of 'Tile's
-type ServerMap = Matrix Tile
-
--- | Type synonym for the Map. Translates to a Matrix of 'Maybe Tile's
-type ClientMap = Matrix (Maybe Tile)
-
-data Tile
-  = Air  -- ^ walkable area
-  | Wall -- ^ obstacle
-  deriving (Show, Eq)
-
-data Arena = Arena
-  { arenaMap      :: ServerMap
-  , arenaSpawners :: [Spawner]
-  }
-  deriving (Show, Eq)
-
-data Spawner = Spawner
-  { spawnerPowerup    :: Wand -- ^ Which 'Powerup' is being spawned
-  , spawnerReloadTime :: Int     -- ^ How long does it take for the 'Powerup' to reappear
-  , spawnerState      :: SpawnerState
-  , spawnerReloadTTL  :: Float
-  , spawnerPosition   :: Position -- ^ Position of the `Spawner` on the map
-  }
-  deriving (Show, Eq)
-
-data SpawnerState
-  = SpawnerFull
-  | SpawnerEmpty
-  deriving (Eq, Show)

src-lib/Library/Types/Communication.hs

@@ -19,6 +19,10 @@ data ServerMessage
   | ProvideInitialWizard
     { initWizard :: Wizard
     }
+  | TickUpdate
+    { tuMapSlice :: MapSlice
+    , tuWizard   :: Wizard
+    }
   deriving (Eq, Show, Generic)
 
 instance FromJSON ServerMessage

src-lib/Library/Types/Map.hs

@@ -0,0 +1,96 @@
+{-# LANGUAGE DeriveGeneric #-}
+module Library.Types.Map where
+
+import Data.Matrix
+
+import GHC.Generics
+
+import Graphics.Vty
+
+-- internal imports
+
+import Library.Types.Player
+import Data.Aeson (ToJSON, FromJSON)
+
+-- | Data object for storing the client's state
+data ClientState = ClientState
+  { clientVty      :: Vty  -- ^ Context object for graphics
+  , clientGameOver :: Bool -- ^ client game over (contestant died)
+  , clientStop     :: Bool -- ^ client shutdown
+  }
+
+-- | Type synonym for the Map. Translates to a Matrix of 'Tile's
+type ServerMap = Matrix Tile
+
+-- | Type synonym for the Map. Translates to a Matrix of 'Maybe Tile's
+type ClientMap = Matrix (Maybe Tile)
+
+instance ToJSON ClientMap
+
+instance FromJSON ClientMap
+
+data Tile
+  = Air  -- ^ walkable area
+  | Wall -- ^ obstacle
+  deriving (Show, Eq, Generic)
+
+instance ToJSON Tile
+
+instance FromJSON Tile
+
+data Arena = Arena
+  { arenaMap      :: ServerMap
+  , arenaSpawners :: [Spawner]
+  }
+  deriving (Show, Eq)
+
+data Spawner = Spawner
+  { spawnerPowerup    :: Wand -- ^ Which 'Powerup' is being spawned
+  , spawnerReloadTime :: Int     -- ^ How long does it take for the 'Powerup' to reappear
+  , spawnerState      :: SpawnerState
+  , spawnerReloadTTL  :: Float
+  , spawnerPosition   :: Position -- ^ Position of the `Spawner` on the map
+  }
+  deriving (Show, Eq)
+
+data SpawnerState
+  = SpawnerFull
+  | SpawnerEmpty
+  deriving (Eq, Show)
+
+data MapSlice = MapSlice
+  { msViewMap    :: ClientMap
+  , msViewOffset :: Position
+  , msContents   :: [Effigy]
+  }
+  deriving (Eq, Show, Generic)
+
+instance ToJSON MapSlice
+
+instance FromJSON MapSlice
+
+data Effigy = Effigy
+  { effPosition :: Position
+  , effType     :: EffigyType
+  }
+  deriving (Eq, Show, Generic)
+
+instance ToJSON Effigy
+
+instance FromJSON Effigy
+
+data EffigyType
+  = EffZap
+  | EffBigZap
+  | EffFire
+  | EffIce
+  | EffBigWand
+  | EffFireWand
+  | EffIceWand
+  | EffWizard
+  | EffCorpse
+  deriving (Eq, Show, Generic)
+
+instance ToJSON EffigyType
+
+instance FromJSON EffigyType

wizard-wipeout.cabal

@@ -20,6 +20,7 @@ library
     import:           warnings
     exposed-modules:  Library.Types
                       Library.Types.Communication
+                      Library.Types.Map
                       Library.Types.Player
     build-depends:    base ^>=4.17.2.1
                     , aeson
@@ -44,6 +45,7 @@ executable wizard-wipeout-client
                     , mtl
                     , network
                     , optparse-applicative
+                    , stm
                     , uuid
                     , vector
                     , vty