From 0f5101f7bb20484b46d245275b8c8f241945c4ff Mon Sep 17 00:00:00 2001 From: nek0 Date: Mon, 25 Nov 2024 03:48:18 +0100 Subject: [PATCH] graphics now works --- configuration.yaml | 4 +- src-client/Client/Game.hs | 10 +- src-client/Client/Graphics.hs | 172 +++++++++++------------- src-client/Main.hs | 14 +- src-server/Server/Communication/Send.hs | 8 +- 5 files changed, 96 insertions(+), 112 deletions(-) diff --git a/configuration.yaml b/configuration.yaml index f2ebd33..c915a37 100644 --- a/configuration.yaml +++ b/configuration.yaml @@ -4,5 +4,5 @@ setMapColumns : 40 setSpawnerProbability : 0.01 setFPS : 30 setClientMaxTimeout : 5 -setFramesPerPing : 120 -setLogLevel : Info +setFramesPerPing : 10 +setLogLevel : Verbose diff --git a/src-client/Client/Game.hs b/src-client/Client/Game.hs index e60abf3..7e985eb 100644 --- a/src-client/Client/Game.hs +++ b/src-client/Client/Game.hs @@ -35,15 +35,15 @@ runGame = do (liftIO (not <$> readIORef (scStopper st))) (do liftIO $ receiveMessage curLevel sock messageQueue st - -- liftIO $ putStrLn "received messages" + logPrint Verbose "received messages" handleMessages - -- liftIO $ putStrLn "handled messages" + logPrint Verbose "handled messages" pumpEvents vty - -- liftIO $ putStrLn "pumped events" + logPrint Verbose "pumped events" handleEvents - -- liftIO $ putStrLn "handled events" + logPrint Verbose "handled events" draw - -- liftIO $ putStrLn "drew" + logPrint Verbose "drew" ) logPrint Info "left game loop" liftIO $ do diff --git a/src-client/Client/Graphics.hs b/src-client/Client/Graphics.hs index c821cbb..4ad70ff 100644 --- a/src-client/Client/Graphics.hs +++ b/src-client/Client/Graphics.hs @@ -6,9 +6,7 @@ import Control.Monad.RWS import qualified Data.Matrix as M -import Data.Maybe - -import qualified Data.Vector as V +import Debug.Trace import Graphics.Vty @@ -25,97 +23,6 @@ vFOV = pi / 2 hFOV :: Float hFOV = pi / 2 -draw :: Game () -draw = do - mapSlice <- gets scMapSlice - wizard <- gets scWizard - clientStatVar <- gets scClientState - vty <- clientVty <$> liftIO (STM.atomically $ STM.readTMVar clientStatVar) - (w, h) <- liftIO $ displayBounds (outputIface vty) - let dims@(dw, dh) = (w, h - 4) - result = V.generate (fromIntegral dh) - (\mh -> map - (\mw -> drawPixel mapSlice wizard dims (fromIntegral mw, fromIntegral mh)) - [dw, dw - 1 .. 1] - ) - image = V.foldl (<->) - emptyImage - (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 -- ^ 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 - pi / 2) - slice - (fromIntegral w, fromIntegral h) - currentPixel - in getPixel (fromMaybe 5 rayLength) - -castRay - :: 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 $ 5 + stepR - 5) / vr - tMaxC = (fromIntegral $ floor $ 5 + stepC - 5) / vc - tDeltaR = stepR / vc - tDeltaC = stepC / vc - 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) - -> [(Float, Float)] -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) - else - let ntMaxC = tMaxC - tDeltaC - nc = c - stepC - in (r, nc) : buildRay (tMaxR, ntMaxC) delta rstep (r, nc) - else [] - -getRayCollision - :: V2 Float - -> MapSlice - -> [(Float, Float)] - -> Maybe Float -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) + 5) / vc - else (fromIntegral (floor tr) + 5) / vr - vec = (* t) <$> view - --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 | l <= 1 = '█' @@ -129,3 +36,80 @@ rotVec (V2 x y) rad = V2 nx ny where nx = x * cos rad + y * sin rad ny = x * sin rad - y * cos rad + +draw :: Game () +draw = do + mapSlice <- msViewMap <$> gets scMapSlice + wizard <- gets scWizard + clientStateVar <- gets scClientState + vty <- clientVty <$> liftIO (STM.atomically $ STM.readTMVar clientStateVar) + (w, h) <- liftIO $ displayBounds (outputIface vty) + let result = map + (\y -> + map + (\x -> + getPixel $ foldl + (\acc coord@(row, col) -> + if mapSlice M.! coord == Just Wall + then + let rayLength = castRay + wizard + (fromIntegral row, fromIntegral col) + (fromIntegral x, fromIntegral y) + (fromIntegral w, fromIntegral h) + in min rayLength acc + else + acc + ) + 5 + ((,) <$> [1 .. 9] <*> [1 .. 9]) + ) + [1 .. w] + ) + [1 .. h] + image = foldl + (\img line -> + img <-> string defAttr line + ) + (string defAttr $ head result) + (tail result) + liftIO $ do + update vty (picForImage image) + -- mapM_ putStrLn result + +castRay + :: Wizard -- Player + -> (Float, Float) -- coordinates of inspected tile + -> (Float, Float) -- screen pixel coordinates + -> (Float, Float) -- screen dimensions + -> Float -- Ray length +castRay wizard (row, col) (x, y) (width, height) = + let direction = angle (wizardRot wizard - pi / 2 - hFOV / 2 + x * hFOV / width) + invdir@(V2 invDirCol invDirRow) = (1 /) <$> direction + wStep@(V2 wStepCol wStepRow) = wizardPos wizard - (fromIntegral . floor <$> wizardPos wizard) + ulCol = col - 1 + ulRow = row - 1 + brCol = col + brRow = row + dMinCol = ((if signum invDirCol <= 0 then brCol else ulCol) - (4 + wStepCol)) * invDirCol + dMaxCol = ((if signum invDirCol <= 0 then ulCol else brCol) - (4 + wStepCol)) * invDirCol + dMinRow = ((if signum invDirRow <= 0 then brRow else ulRow) - (4 + wStepRow)) * invDirRow + dMaxRow = ((if signum invDirRow <= 0 then ulRow else brRow) - (4 + wStepRow)) * invDirRow + tMinCol = max dMinCol 0 + tMaxCol = min dMaxCol (recip 0) + tMinRow = max dMinRow 0 + tMaxRow = min dMaxRow (recip 0) + tMin = max 0 $ max dMinCol dMinRow + tMax = min (recip 0) $ min dMaxCol dMaxRow + in + if tMin < tMax + then + let result = sqrt (quadrance ((tMin *) <$> direction)) * abs ((- vFOV) / 2 + y * vFOV / height) + -- in trace ("ray length: " <> show result) result + -- in trace ("vector: " <> show (sqrt $ quadrance $ (tMin *) <$> direction)) result + -- in trace ("wStep: " <> show wStep) result + in result + else + -- trace (show (tMin, tMax)) 5 + -- trace (show invdir) 5 + 5 diff --git a/src-client/Main.hs b/src-client/Main.hs index 0b63ccd..3a22082 100644 --- a/src-client/Main.hs +++ b/src-client/Main.hs @@ -32,9 +32,9 @@ main :: IO () main = do putStrLn "Hello, Arena!" (Options logLevel socketLocation) <- execParser opts - logPrintIO Info logLevel $ "connecting to Socket " <> socketLocation + logPrintIO logLevel Info $ "connecting to Socket " <> socketLocation sock <- connectSocket socketLocation - logPrintIO Info logLevel "connected" + logPrintIO logLevel Info "connected" messageQueue <- STM.newTQueueIO @@ -56,7 +56,7 @@ main = do sendMessage logLevel IdRequest sock clientIdMsg <- awaitResponse logLevel sock messageQueue mockState 0 let clientId = acClientUUID clientIdMsg - logPrintIO Info logLevel $ "received client UUID: " <> show clientId + logPrintIO logLevel Info $ "received client UUID: " <> show clientId putStrLn welcomeText @@ -66,7 +66,7 @@ main = do sendMessage logLevel (ClientMessage clientId ClientRequestWizard) sock -- threadDelay $ 1 * 10 ^ 6 playerWizard <- awaitResponse logLevel sock messageQueue mockState 1 - logPrintIO Info logLevel $ "received wizard: " <> show (initWizard playerWizard) + logPrintIO logLevel Info $ "received wizard: " <> show (initWizard playerWizard) vty <- mkVty defaultConfig hideCursor (outputIface vty) @@ -81,7 +81,7 @@ main = do initState = StateContainer (initWizard playerWizard) clientState initSlice stopper -- putStrLn "sending quit message" -- sendMessage (ClientMessage clientId ClientQuit) sock - logPrintIO Info logLevel "entering Game Monad" + logPrintIO logLevel Info "entering Game Monad" void $ execRWST (do terminateGameOnSigint stopper @@ -90,11 +90,11 @@ main = do ) initRead initState - logPrintIO Info logLevel "Shutting down client…" + logPrintIO logLevel Info "Shutting down client…" showCursor (outputIface vty) shutdown vty threadDelay 1000 - logPrintIO Info logLevel "Closing connection to server…" + logPrintIO logLevel Info "Closing connection to server…" close sock putStrLn "bye bye" where diff --git a/src-server/Server/Communication/Send.hs b/src-server/Server/Communication/Send.hs index 55e4503..45a007d 100644 --- a/src-server/Server/Communication/Send.hs +++ b/src-server/Server/Communication/Send.hs @@ -183,10 +183,10 @@ sendUpdate curLevel stateContainer tileMap player = do 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 + correctionLeft = if wizardRot < pi / 2 || wizardRot >= 2 * pi + then floor + else ceiling + correctionRight = if wizardRot < pi / 2 || wizardRot >= 2 * pi then ceiling else floor initViewMatrix = M.fromList 9 9 $ map