graphics now works

2024-11-25 03:48:18 +01:00 · 2024-11-25 03:48:18 +01:00 · 0f5101f7bb
commit 0f5101f7bb
parent 3ae9c714df
5 changed files with 96 additions and 112 deletions
--- 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
--- 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
--- 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
--- 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
--- 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