restructure of library and introducing channels to client

This commit is contained in:
nek0 2023-12-11 17:21:24 +01:00
parent 6db9d877aa
commit afa21eaece
6 changed files with 127 additions and 54 deletions

View file

@ -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
receiveMessage sock = do
-> STM.TQueue ServerMessage
-> 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
(error $ "unexpected message from Server: " <> show msg)
pure
maybe
(pure ())
(STM.atomically . STM.writeTQueue queue)
mJsonMsg
free ptr
pure jsonMsg

View file

@ -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
clientIdMsg <- receiveMessage sock
threadDelay $ 1 * 10 ^ 6
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"
, ""

View file

@ -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
-- | 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)
import Library.Types.Map as T

View file

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

View file

@ -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

View file

@ -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