tinkering graphics

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

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

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

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

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
             )

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)

src-server/Server/Game.hs

@@ -38,7 +38,6 @@ runGame = do
       handleMessages
       updateSpawners delta
       updateWizards delta
-      sendUpdates
       modify'
         (\s -> s
           { scServerLastTick = now