fixing queu identification
This commit is contained in:
parent
e8bdc8a1f7
commit
67b09aaa06
7 changed files with 51 additions and 28 deletions
|
|
@ -2,6 +2,6 @@ setSocketPath : "/tmp/wizard.sock"
|
|||
setMapRows : 40
|
||||
setMapColumns : 40
|
||||
setSpawnerProbability : 0.01
|
||||
setFPS : 1
|
||||
setFPS : 30
|
||||
setClientMaxTimeout : 5
|
||||
setFramesPerPing : 120
|
||||
|
|
|
|||
|
|
@ -47,11 +47,13 @@ sendMessage
|
|||
-> Socket
|
||||
-> IO ()
|
||||
sendMessage msg sock = do
|
||||
print msg
|
||||
putStrLn $ "sending message: " <> show msg
|
||||
let msgJson = A.encode msg
|
||||
msgList = B.unpack $ B.toStrict msgJson
|
||||
putStrLn $ "sending raw message buffer: " <> show msgList
|
||||
ptr <- newArray msgList
|
||||
void $ sendBuf sock ptr (length msgList)
|
||||
putStrLn "raw message buffer sent"
|
||||
free ptr
|
||||
|
||||
handleMessages
|
||||
|
|
@ -109,16 +111,19 @@ receiveMessage sock queue st = do
|
|||
let maxBufferLength = 4096
|
||||
ptr <- mallocArray maxBufferLength
|
||||
ebufferLength <- try $ recvBuf sock ptr maxBufferLength
|
||||
-- putStrLn $ "received buffer of length: " <> show ebufferLength
|
||||
bufferLength <- case ebufferLength of
|
||||
Left (_ :: IOException) -> do
|
||||
gracefulExit st "Quitting due to connection loss"
|
||||
pure 0
|
||||
Right len -> pure len
|
||||
rawMsg <- B.pack <$> peekArray bufferLength ptr
|
||||
-- putStrLn $ "received raw message: " <> show rawMsg
|
||||
let msgs =
|
||||
if B.length rawMsg < 1
|
||||
then []
|
||||
else map B8.tail $ init $ B8.split '>' $ B8.fromStrict rawMsg
|
||||
-- putStrLn $ "resulting split messages: " <> show msgs
|
||||
mapM_
|
||||
(\msg -> do
|
||||
let mJsonMsg = A.decode' msg
|
||||
|
|
|
|||
|
|
@ -28,15 +28,22 @@ runGame = do
|
|||
st <- get
|
||||
vty <- clientVty <$> liftIO (atomically $ readTMVar (scClientState st))
|
||||
liftIO $ sendMessage (ClientMessage clientId ClientReady) sock
|
||||
liftIO $ putStrLn "entering game loop"
|
||||
whileM_
|
||||
(liftIO (not <$> readIORef (scStopper st)))
|
||||
(do
|
||||
liftIO $ receiveMessage sock messageQueue st
|
||||
-- liftIO $ putStrLn "received messages"
|
||||
handleMessages
|
||||
-- liftIO $ putStrLn "handled messages"
|
||||
pumpEvents vty
|
||||
-- liftIO $ putStrLn "pumped events"
|
||||
handleEvents
|
||||
-- liftIO $ putStrLn "handled events"
|
||||
draw
|
||||
-- liftIO $ putStrLn "drew"
|
||||
)
|
||||
liftIO $ do
|
||||
liftIO $ putStrLn "left game loop"
|
||||
partingMessage clientId sock
|
||||
threadDelay (10 ^ 6)
|
||||
|
|
|
|||
|
|
@ -73,9 +73,11 @@ main = do
|
|||
initState = StateContainer (initWizard playerWizard) clientState initSlice stopper
|
||||
-- putStrLn "sending quit message"
|
||||
-- sendMessage (ClientMessage clientId ClientQuit) sock
|
||||
putStrLn "entering Game Monad"
|
||||
void $ execRWST
|
||||
(do
|
||||
terminateGameOnSigint stopper
|
||||
liftIO $ putStrLn "entering main game function"
|
||||
runGame
|
||||
)
|
||||
initRead
|
||||
|
|
|
|||
|
|
@ -28,35 +28,40 @@ handleMessage
|
|||
-> ClientMessage
|
||||
-> IO ()
|
||||
handleMessage stateContainer readerContainer msg = do
|
||||
let clientList = scClientSockets stateContainer
|
||||
queueList <- STM.atomically $ STM.readTMVar $ scClientQueues stateContainer
|
||||
clients <- liftIO $ STM.atomically $ STM.readTMVar clientList
|
||||
let socketList = scClientSockets stateContainer
|
||||
queueList = scClientQueues stateContainer
|
||||
socks <- liftIO $ STM.atomically $ STM.readTMVar socketList
|
||||
queues <- liftIO $ STM.atomically $ STM.readTMVar queueList
|
||||
-- putStrLn $ "Handling: " <> show msg
|
||||
case msg of
|
||||
IdRequest -> do
|
||||
clientId <- nextRandom
|
||||
let clientIdx = findIndex (isNothing . csUUID) clients
|
||||
clientSock = csSocket $ clients !! fromJust clientIdx
|
||||
newClients = map
|
||||
(\old@(ClientSocket mUUID oldClientSock _ _) ->
|
||||
if oldClientSock == clientSock && isNothing mUUID
|
||||
then
|
||||
old
|
||||
let clientIdx = findIndex (isNothing . csUUID) socks
|
||||
sock = socks !! fromJust clientIdx
|
||||
queue = queues !! fromJust clientIdx
|
||||
if csUUID sock == cqUUID queue
|
||||
then do
|
||||
let otherSocks = delete sock socks
|
||||
newSocks = sock
|
||||
{ csUUID = Just clientId
|
||||
}
|
||||
} : otherSocks
|
||||
otherQueues = delete queue queues
|
||||
newQueues = queue
|
||||
{ cqUUID = Just clientId
|
||||
} : otherQueues
|
||||
liftIO $ STM.atomically $ do
|
||||
void $ STM.swapTMVar socketList newSocks
|
||||
void $ STM.swapTMVar queueList newQueues
|
||||
putStrLn $ "Accepted Client with UUID: " <> show clientId
|
||||
queueMessage (AcceptClient clientId) clientId newQueues
|
||||
else
|
||||
old
|
||||
)
|
||||
clients
|
||||
void $ liftIO $ STM.atomically $ STM.swapTMVar clientList newClients
|
||||
putStrLn $ "Accepted Client with UUID " <> show clientId
|
||||
queueMessage (AcceptClient clientId) clientId queueList
|
||||
putStrLn $ "Unable to assign ID to Socket and queue: " <> show clientId
|
||||
ClientMessage clientId payload ->
|
||||
case payload of
|
||||
ClientQuit -> do
|
||||
putStrLn $ "client has quit the game: " <> show clientId
|
||||
let client = find (\a -> csUUID a == Just clientId) clients
|
||||
dropClient clientList (csSocket $ fromJust client)
|
||||
let client = find (\a -> csUUID a == Just clientId) socks
|
||||
dropClient socketList (csSocket $ fromJust client)
|
||||
ClientRequestWizard -> do
|
||||
putStrLn "initializing new wizard"
|
||||
let arena = rcMap readerContainer
|
||||
|
|
@ -68,7 +73,7 @@ handleMessage stateContainer readerContainer msg = do
|
|||
currentPlayers <- STM.readTMVar (scPlayers stateContainer)
|
||||
void $ STM.swapTMVar (scPlayers stateContainer) $
|
||||
Player clientId freshWizard False (now, uuid) : currentPlayers
|
||||
queueMessage (ProvideInitialWizard freshWizard) clientId queueList
|
||||
queueMessage (ProvideInitialWizard freshWizard) clientId queues
|
||||
ClientReady -> do
|
||||
now <- getCurrentTime
|
||||
STM.atomically $ do
|
||||
|
|
@ -84,7 +89,7 @@ handleMessage stateContainer readerContainer msg = do
|
|||
: otherPlayers
|
||||
putStrLn $ "client ready: " <> show clientId
|
||||
Pong pongUuid -> do
|
||||
let mclient = find (\c -> csUUID c == Just clientId) clients
|
||||
let mclient = find (\c -> csUUID c == Just clientId) socks
|
||||
players <- STM.atomically $ STM.readTMVar (scPlayers stateContainer)
|
||||
maybe
|
||||
(putStrLn $ "Unknown client: " <> show clientId)
|
||||
|
|
|
|||
|
|
@ -35,21 +35,23 @@ receiveMessage
|
|||
receiveMessage sockContainer queue = do
|
||||
randSleep <- randomRIO (1, 1000)
|
||||
threadDelay randSleep
|
||||
sock <- STM.atomically $ STM.readTMVar sockContainer
|
||||
sock <- STM.atomically $ STM.takeTMVar sockContainer
|
||||
let maxBufferLength = 4096
|
||||
putStrLn "read socket container for receiving"
|
||||
putStrLn "took socket container for receiving"
|
||||
mMsg <- do
|
||||
ptr <- mallocArray maxBufferLength
|
||||
putStrLn "receiving data"
|
||||
eBufferLength <-
|
||||
try $ recvBuf sock ptr maxBufferLength
|
||||
putStrLn $ "received raw buffer length of: " <> show eBufferLength
|
||||
free ptr
|
||||
bufferLength <- case eBufferLength of
|
||||
Left (e :: IOException) -> do
|
||||
-- putStrLn ("Socket vanished, cleaning up after " <> show e)
|
||||
-- dropClient clientList sock
|
||||
pure 0
|
||||
Right len -> pure len
|
||||
free ptr
|
||||
putStrLn $ "received buffer of length: " <> show bufferLength
|
||||
msg <- B.pack <$> peekArray bufferLength ptr
|
||||
putStrLn $ "received data: " <> show msg
|
||||
if bufferLength > 0 && msg /= ""
|
||||
|
|
|
|||
|
|
@ -65,6 +65,8 @@ sendMessageQueue
|
|||
-> STM.TQueue ServerMessage
|
||||
-> IO ()
|
||||
sendMessageQueue sockContainer queue = do
|
||||
randTime <- randomRIO (1, 1000)
|
||||
threadDelay randTime
|
||||
msgs <- STM.atomically $ STM.flushTQueue queue
|
||||
mapM_
|
||||
(\msg -> do
|
||||
|
|
|
|||
Loading…
Reference in a new issue