diff --git a/src-client/Client/Communication.hs b/src-client/Client/Communication.hs index 41098c7..4955cab 100644 --- a/src-client/Client/Communication.hs +++ b/src-client/Client/Communication.hs @@ -81,13 +81,13 @@ handleMessage (Ping id') = do ) sock --- handleMessage (TickUpdate !slice !wizard) = do --- st <- get --- let !newState = st --- { scWizard = wizard --- , scMapSlice = slice --- } --- put newState +handleMessage (TickUpdate !slice !wizard) = do + st <- get + let !newState = st + { scWizard = wizard + , scMapSlice = slice + } + put newState handleMessage x = liftIO $ putStrLn $ "received unexpected message from server: " <> show x diff --git a/src-client/Client/Game.hs b/src-client/Client/Game.hs index 7d380b2..8ddd3ae 100644 --- a/src-client/Client/Game.hs +++ b/src-client/Client/Game.hs @@ -23,16 +23,14 @@ runGame = do queue <- asks rcQueue clientId <- asks rcClientUUID st <- get - -- recvThread <- liftIO $ forkIO $ forever $ receiveMessage sock queue st liftIO $ sendMessage (ClientMessage clientId ClientReady) sock whileM_ (liftIO (not <$> readIORef (scStopper st))) (do liftIO $ receiveMessage sock queue st handleMessages - -- draw + draw ) - -- liftIO $ killThread recvThread handleEvent :: Maybe Event diff --git a/src-client/Client/Graphics.hs b/src-client/Client/Graphics.hs index 74ac914..c6089bd 100644 --- a/src-client/Client/Graphics.hs +++ b/src-client/Client/Graphics.hs @@ -12,7 +12,9 @@ import qualified Data.Vector as V import Graphics.Vty -import Linear +import Linear hiding (trace) + +import Debug.Trace -- internal imports @@ -23,7 +25,7 @@ vFOV :: Float vFOV = pi / 2 hFOV :: Float -hFOV = pi / 1.5 +hFOV = pi / 2 draw :: Game () draw = do @@ -34,90 +36,87 @@ draw = do (w, h) <- liftIO $ displayBounds (outputIface vty) let dims@(dw, dh) = (w, h - 4) result = V.generate (fromIntegral dh) - (\mh -> string defAttr $ map + (\mh -> map (\mw -> drawPixel mapSlice wizard dims (fromIntegral mw, fromIntegral mh)) - [1 .. dw] + [dw, dw - 1 .. 1] ) image = V.foldl (<->) emptyImage - (result V.++ + (V.map (string currentAttr) result V.++ V.foldl (V.++) V.empty (V.generate 4 (const $ V.singleton emptyImage))) picture = picForImage image liftIO $ update vty picture drawPixel - :: MapSlice - -> Wizard - -> (Int, Int) - -> (Float, Float) - -> Char + :: MapSlice -- ^ visible slice of the map + -> Wizard -- ^ Player + -> (Int, Int) -- ^ Screen dimensions + -> (Float, Float) -- ^ current "Pixel" + -> Char -- ^ resulting "Color" drawPixel slice wizard (w, h) currentPixel = let rayLength = castRay - (wizardRot wizard) - (wizardPos wizard) + (wizardRot wizard - pi / 2) slice (fromIntegral w, fromIntegral h) currentPixel in getPixel (fromMaybe 5 rayLength) castRay - :: Float - -> V2 Float - -> MapSlice - -> (Float, Float) - -> (Float, Float) - -> Maybe Float -castRay wizardRot wizardPos@(V2 wr wc) slice (w, h) (dw, dh) = - let slicePos@(V2 sr sc) = - V2 (wr + 5 - (fromIntegral $ floor wr)) (wc + 5 - (fromIntegral $ floor wc)) - view@(V2 vr vc) = V2 0 1 `rotVec` (wizardRot + (- hFOV / 2 + dw * hFOV / w)) + :: Float -- ^ Player rotation + -> MapSlice -- ^ visible slice of the map + -> (Float, Float) -- ^ Screen dimensions + -> (Float, Float) -- ^ current "Pixel" + -> Maybe Float -- ^ resulting ray length +castRay wizardRot slice (w, h) (dw, dh) = + let view@(V2 vr vc) = V2 0 1 `rotVec` (wizardRot + (- hFOV / 2 + dw * hFOV / w)) stepR = signum vr stepC = signum vc - tMaxR = (fromIntegral $ floor $ wr + stepR - wr) / vr - tMaxC = (fromIntegral $ floor $ wc + stepC - wc) / vc + tMaxR = (fromIntegral $ floor $ 5 + stepR - 5) / vr + tMaxC = (fromIntegral $ floor $ 5 + stepC - 5) / vc tDeltaR = stepR / vc tDeltaC = stepC / vc - sliceRay = (sr, sc) : - buildRay (tMaxR, tMaxC) (tDeltaR, tDeltaC) (stepR, stepC) (sr, sc) slicePos - in fmap (/ cos (-vFOV / 2 + dh * vFOV / h)) (getRayCollision slicePos view slice sliceRay) + sliceRay = (5, 5) : + buildRay (tMaxR, tMaxC) (tDeltaR, tDeltaC) (stepR, stepC) (5, 5) + -- result = fmap (/ cos (-vFOV / 2 + dh * vFOV / h)) (getRayCollision view slice sliceRay) + result = (getRayCollision view slice sliceRay) + in result buildRay :: (Float, Float) -> (Float, Float) -> (Float, Float) -> (Float, Float) - -> V2 Float -> [(Float, Float)] -buildRay (tMaxR, tMaxC) delta@(tDeltaR, tDeltaC) rstep@(stepR, stepC) (r, c) slicePos = - if distance slicePos (V2 r c) < 4 +buildRay (tMaxR, tMaxC) delta@(tDeltaR, tDeltaC) rstep@(stepR, stepC) (r, c) = + if distance (V2 5 5) (V2 r c) < 4 then if tMaxR < tMaxC then let ntMaxR = tMaxR - tDeltaR nr = r - stepR - in (nr, c) : buildRay (ntMaxR, tMaxC) delta rstep (nr, c) slicePos + in (nr, c) : buildRay (ntMaxR, tMaxC) delta rstep (nr, c) else let ntMaxC = tMaxC - tDeltaC nc = c - stepC - in (r, nc) : buildRay (tMaxR, ntMaxC) delta rstep (r, nc) slicePos + in (r, nc) : buildRay (tMaxR, ntMaxC) delta rstep (r, nc) else [] getRayCollision :: V2 Float - -> V2 Float -> MapSlice -> [(Float, Float)] -> Maybe Float -getRayCollision _ _ _ [] = Nothing -getRayCollision _ _ _ [_] = Nothing -getRayCollision pos@(V2 pr pc) view@(V2 vr vc) mapSlice ((wizR, _):tile@(tr, tc):ts) = +getRayCollision _ _ [] = Nothing +getRayCollision view@(V2 vr vc) mapSlice ((wizR, _):tile@(tr, tc):ts) = case msViewMap mapSlice M.! (floor tr, floor tc) of Just Wall -> let t = if floor wizR == floor tr - then (fromIntegral (floor tc) + pc) / vc - else (fromIntegral (floor tr) + pr) / vr + then (fromIntegral (floor tc) + 5) / vc + else (fromIntegral (floor tr) + 5) / vr vec = (* t) <$> view - in Just (sqrt $ vec `dot` vec) - _ -> getRayCollision pos view mapSlice (tile:ts) + --in trace ("boing" ++ show tile) $ Just (sqrt $ vec `dot` vec) + in Just (distance vec (V2 5 5)) + _ -> getRayCollision view mapSlice (tile:ts) +getRayCollision _ _ [_] = Nothing getPixel :: Float -> Char getPixel l diff --git a/src-client/Main.hs b/src-client/Main.hs index 3a25eb2..28d6b8a 100644 --- a/src-client/Main.hs +++ b/src-client/Main.hs @@ -66,7 +66,7 @@ main = do -- shutdown vty stopper <- newIORef False - clientState <- STM.newTMVarIO (ClientState undefined False) + clientState <- STM.newTMVarIO (ClientState vty False) let initSlice = MapSlice (M.matrix 9 9 (const Nothing)) [] let initRead = ReaderContainer sock clientId queue initState = StateContainer (initWizard playerWizard) clientState initSlice stopper diff --git a/src-server/Server/Communication/Handler.hs b/src-server/Server/Communication/Handler.hs index e75f400..2f86775 100644 --- a/src-server/Server/Communication/Handler.hs +++ b/src-server/Server/Communication/Handler.hs @@ -105,6 +105,7 @@ handleMessage stateContainer readerContainer msg = do { playerLastPong = (now, uuid) } void $ STM.swapTMVar (scPlayers stateContainer) (modPlayer : otherPlayers) + sendUpdate stateContainer (rcMap readerContainer) player ) mPlayer ) diff --git a/src-server/Server/Communication/Send.hs b/src-server/Server/Communication/Send.hs index 921cb46..99bd015 100644 --- a/src-server/Server/Communication/Send.hs +++ b/src-server/Server/Communication/Send.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE RecordWildCards #-} module Server.Communication.Send where import Control.Concurrent @@ -14,6 +15,8 @@ import Control.Monad.State import qualified Data.Aeson as A +import qualified Data.Matrix as M + import Data.Maybe import qualified Data.ByteString as B @@ -28,6 +31,8 @@ import Data.List import Data.UUID import Data.UUID.V4 +import Linear + import Network.Socket -- internal imports @@ -122,6 +127,42 @@ dropClient clientList sock = do mClient close sock -sendUpdates - :: Game () -sendUpdates = pure () +sendUpdate + :: StateContainer + -> ServerMap + -> Player + -> IO () +sendUpdate stateContainer tileMap player = do + slice <- buildSlice player + sendSlice slice player + where + buildSlice :: Player -> IO MapSlice + buildSlice (Player _ (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 > 2 * pi + then ceiling + else floor + correctionRight = if wizardRot < pi / 2 || wizardRot > 2 * pi + then ceiling + else floor + initViewMatrix = 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 + pure (MapSlice initViewMatrix []) + sendSlice :: MapSlice -> Player -> IO () + sendSlice slice (Player playerId wizard _ _) = do + let msg = TickUpdate slice wizard + print slice + liftIO $ sendMessage msg playerId (scClientSockets stateContainer) diff --git a/src-server/Server/Game.hs b/src-server/Server/Game.hs index 04f29c7..63fd1ac 100644 --- a/src-server/Server/Game.hs +++ b/src-server/Server/Game.hs @@ -38,7 +38,6 @@ runGame = do handleMessages updateSpawners delta updateWizards delta - sendUpdates modify' (\s -> s { scServerLastTick = now