nek0/wizard-wipeout
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

fix data garbling

Browse source
This commit is contained in:
nek0 2023-12-23 11:38:57 +01:00
parent b2d75ca3fd
commit 3e72e87e56
7 changed files with 80 additions and 55 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

17
src-client/Client/Communication.hs
View file

@ -93,12 +93,17 @@ 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
maybe
(putStrLn $ "received garbled data: " <> B8.unpack (B8.fromStrict msg))
(STM.atomically . STM.writeTQueue queue)
mJsonMsg
rawMsg <- B.pack <$> peekArray bufferLength ptr
let msgs = map B8.tail $ init $ B8.split '>' $ B8.fromStrict rawMsg
mapM_
(\msg -> do
let mJsonMsg = A.decode' msg
maybe
(putStrLn $ "received garbled data: " <> B8.unpack msg)
(STM.atomically . STM.writeTQueue queue)
mJsonMsg
)
msgs
-- | Function that installs a handler on SIGINT to terminate game
terminateGameOnSigint

2
src-client/Client/Game.hs
View file

@ -21,7 +21,9 @@ runGame :: Game ()
runGame = do
sock <- asks rcSocket
queue <- asks rcQueue
clientId <- asks rcClientUUID
recvThread <- liftIO $ forkIO $ forever $ receiveMessage sock queue
liftIO $ sendMessage (ClientMessage clientId ClientReady) sock
whileM_
(not . clientStop <$> (liftIO . STM.atomically . STM.readTMVar =<< gets scClientState))
(do

1
src-lib/Library/Types/Communication.hs
View file

@ -33,6 +33,7 @@ instance ToJSON ServerMessage
data ClientMessagePayload
= ClientQuit
| ClientRequestWizard
| ClientReady
deriving (Eq, Show, Generic)
data ClientMessage

91
src-server/Server/Communication.hs
View file

@ -23,7 +23,7 @@ import qualified Data.Matrix as M
import Data.Maybe
import Data.UUID
import Data.UUID hiding (null)
import Data.UUID.V4
import qualified Data.Vector.Storable as VS
@ -108,7 +108,7 @@ sendMessage
-> IO ()
sendMessage msg sock = do
let msgJson = A.encode msg
msgVector = VS.fromList $ B.unpack $ B.toStrict msgJson
msgVector = VS.fromList $ B.unpack $ B.toStrict $ ('<' `B8.cons` (msgJson `B8.snoc` '>'))
-- putStrLn $ "sending: " <> B8.unpack msgJson
VS.unsafeWith
msgVector
@ -206,12 +206,22 @@ handleMessage stateContainer readerContainer msg = do
putStrLn "initializing new wizard"
let arena = rcMap readerContainer
initPos <- rollInitPosition arena
let freshWIzard = newWizard initPos
let freshWizard = newWizard initPos
STM.atomically $ do
currentPlayers <- STM.readTMVar (scPlayers stateContainer)
void $ STM.swapTMVar (scPlayers stateContainer) $ Player clientId freshWIzard : currentPlayers
void $ STM.swapTMVar (scPlayers stateContainer) $
Player clientId freshWizard False : currentPlayers
let clientSock = fromJust $ lookup (Just clientId) clients
sendMessage (ProvideInitialWizard (newWizard initPos)) clientSock
sendMessage (ProvideInitialWizard freshWizard) clientSock
ClientReady -> do
putStrLn $ "client " <> show clientId <> " is ready!"
STM.atomically $ do
currentPlayers <- STM.readTMVar (scPlayers stateContainer)
let (thisPlayers, otherPlayers) =
partition (\p -> playerId p == clientId) currentPlayers
unless (null thisPlayers) $
void $ STM.swapTMVar (scPlayers stateContainer) $
(head thisPlayers) {playerReady = True} : otherPlayers
_ -> pure ()
sendUpdates :: Game ()
@ -221,41 +231,42 @@ sendUpdates = do
players <- liftIO $ STM.atomically $ STM.readTMVar (scPlayers stateContainer)
sockets <- liftIO $ STM.atomically $ STM.readTMVar (scClientSockets stateContainer)
mapM_
(\(player@(Player playerId wizard@(Wizard {..}))) -> do
let V2 wr wc = wizardPos
subCoords = (,) <$> [floor wr - 4 .. floor wr + 4] <*> [floor wc - 4 .. floor wc + 4]
leftBound = wizardRot + (pi / 4)
rightBound = wizardRot - (pi / 4)
leftLine row = cos leftBound * row
rightLine row = sin rightBound * row
correctionLeft = if wizardRot < pi / 2 || wizardRot > 4 * pi / 2
then floor
else ceiling
correctionRight = if wizardRot < pi / 2 || wizardRot > 4 * pi / 2
then ceiling
else floor
viewMatrix = M.fromList 9 9 $ map
(\(qr, qc) ->
if qc - floor wc <= correctionLeft (leftLine (wr - fromIntegral qr))
&& qc - floor wc >= correctionRight (rightLine (wr - fromIntegral qr))
then
M.safeGet qr qc tileMap
else
Nothing
)
subCoords
clientSock = fromJust $ lookup (Just playerId) sockets
-- liftIO $ print $ leftLine . (\x -> x - wr) . fromIntegral .fst <$> subCoords
-- liftIO $ print initViewMatrix
liftIO $ sendMessage
(TickUpdate
{ tuWizard = wizard
, tuMapSlice = MapSlice
{ msViewMap = viewMatrix
, msContents = []
(\(Player playerId wizard@(Wizard {..}) readiness) -> do
when readiness $ do
let V2 wr wc = wizardPos
subCoords = (,) <$> [floor wr - 4 .. floor wr + 4] <*> [floor wc - 4 .. floor wc + 4]
leftBound = wizardRot + (pi / 4)
rightBound = wizardRot - (pi / 4)
leftLine row = cos leftBound * row
rightLine row = sin rightBound * row
correctionLeft = if wizardRot < pi / 2 || wizardRot > 4 * pi / 2
then floor
else ceiling
correctionRight = if wizardRot < pi / 2 || wizardRot > 4 * pi / 2
then ceiling
else floor
viewMatrix = M.fromList 9 9 $ map
(\(qr, qc) ->
if qc - floor wc <= correctionLeft (leftLine (wr - fromIntegral qr))
&& qc - floor wc >= correctionRight (rightLine (wr - fromIntegral qr))
then
M.safeGet qr qc tileMap
else
Nothing
)
subCoords
clientSock = fromJust $ lookup (Just playerId) sockets
-- liftIO $ print $ leftLine . (\x -> x - wr) . fromIntegral .fst <$> subCoords
-- liftIO $ print initViewMatrix
liftIO $ sendMessage
(TickUpdate
{ tuWizard = wizard
, tuMapSlice = MapSlice
{ msViewMap = viewMatrix
, msContents = []
}
}
}
)
clientSock
)
clientSock
)
players

21
src-server/Server/Game.hs
View file

@ -48,7 +48,7 @@ runGame = do
}
)
fps <- asks rcFPS
-- sendUpdates
sendUpdates
let remainingTime = recip (fromIntegral fps) - delta
when (remainingTime > 0) $
liftIO $ threadDelay $ floor $ remainingTime * 10 ^ 6
@ -81,7 +81,7 @@ updateWizards dt = do
playersVar <- gets scPlayers
players <- liftIO $ STM.atomically $ STM.readTMVar playersVar
let newPlayers = map
(\player@(Player pId wizard@(Wizard _ _ health _ _ effects)) ->
(\player@(Player pId wizard@(Wizard _ _ health _ _ effects) readiness) ->
let newEffects = foldl
(\acc effect@(Effect _ ttl) ->
if ttl - dt < 0
@ -100,12 +100,17 @@ updateWizards dt = do
)
0
effects
in player {
playerWizard = wizard
{ wizardEffects = newEffects
, wizardHealth = health - effectDamage
}
}
in
if readiness
then
player
{ playerWizard = wizard
{ wizardEffects = newEffects
, wizardHealth = health - effectDamage
}
}
else
player
)
players
void $ liftIO $ STM.atomically $ STM.swapTMVar playersVar newPlayers

1
src-server/Server/Types.hs
View file

@ -64,6 +64,7 @@ data StateContainer = StateContainer
data Player = Player
{ playerId :: UUID
, playerWizard :: Wizard
, playerReady :: Bool
}
deriving (Eq, Show)

2
src-server/Server/Util.hs
View file

@ -29,7 +29,7 @@ newWizard
newWizard pos =
Wizard
{ wizardWands = []
, wizardRot = 3
, wizardRot = 0
, wizardPos = pos
, wizardMana = 100
, wizardHealth = 100