first graphics experiments

src-client/Client/Game.hs

@@ -13,6 +13,7 @@ import Control.Monad.RWS
 -- internal imports
 
 import Client.Communication
+import Client.Graphics
 import Client.Types
 
 import Library.Types
@@ -28,5 +29,6 @@ runGame = do
     (not . clientStop <$> (liftIO . STM.atomically . STM.readTMVar =<< gets scClientState))
     (do
       handleMessages
+      draw
     )
   liftIO $ killThread recvThread

src-client/Client/Graphics.hs

@@ -4,6 +4,8 @@ import qualified Control.Concurrent.STM as STM
 
 import Control.Monad.RWS
 
+import qualified Data.Matrix as M
+
 import Data.Maybe
 
 import qualified Data.Vector as V
@@ -17,6 +19,12 @@ import Linear
 import Client.Types
 import Library.Types
 
+vFOV :: Float
+vFOV = pi / 2
+
+hFOV :: Float
+hFOV = pi / 1.5
+
 draw :: Game ()
 draw = do
   mapSlice <- gets scMapSlice
@@ -28,15 +36,12 @@ draw = do
       result = V.generate (fromIntegral dh)
         (\mh -> string defAttr $ map
           (\mw -> drawPixel mapSlice wizard dims (fromIntegral mw, fromIntegral mh))
-          [0 .. dw]
+          [1 .. dw]
          )
-      image = V.foldl
-        (<->)
+      image = V.foldl (<->)
         emptyImage
         (result V.++
-          -- TODO: placeholder Status bar
-          V.generate 3 (const emptyImage)
-        )
+        V.foldl (V.++) V.empty (V.generate 4 (const $ V.singleton emptyImage)))
       picture = picForImage image
   liftIO $ update vty picture
 
@@ -53,7 +58,7 @@ drawPixel slice wizard (w, h) currentPixel =
         slice
         (fromIntegral w, fromIntegral h)
         currentPixel
-  in getPixel (fromMaybe 6 rayLength)
+  in getPixel (fromMaybe 5 rayLength)
 
 castRay
   :: Float
@@ -65,22 +70,54 @@ castRay
 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))
-      v@(V2 vx vy) = V2 0 1 `rotVec` (wizardRot + (- (pi / 1.5) / 2 + dw * (pi / 1.5) / w))
-      stepX = signum vx
-      stepY = signum vy
-      tMaxX = (fromIntegral $ floor $ wr + stepX - wr) / vx
-      tMaxY = (fromIntegral $ floor $ wc + stepY - wc) / vy
-      tDeltaX = stepX / vx
-      tDeltaY = stepY / vy
-  in fmap (/ cos (- pi / 4 + dh * pi / 2 / h)) (getRayColl wizardPos v slice)
+      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
+      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)
 
-getRayColl
+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
+  then if tMaxR < tMaxC
+    then
+      let ntMaxR = tMaxR - tDeltaR
+          nr     = r - stepR
+      in  (nr, c) : buildRay (ntMaxR, tMaxC) delta rstep (nr, c) slicePos
+    else
+      let ntMaxC = tMaxC - tDeltaC
+          nc     = c - stepC
+      in  (r, nc) : buildRay (tMaxR, ntMaxC) delta rstep (r, nc) slicePos
+  else []
+
+getRayCollision
   :: V2 Float
   -> V2 Float
   -> MapSlice
+  -> [(Float, Float)]
   -> Maybe Float
-getRayColl wizardPos@(V2 wr wc) v@(V2 vx vy) slice =
-  undefined
+getRayCollision _ _ _ [] = Nothing
+getRayCollision _ _ _ [_] = Nothing
+getRayCollision pos@(V2 pr pc) 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
+          vec = (* t) <$> view
+      in  Just (sqrt $ vec `dot` vec)
+    _ -> getRayCollision pos view mapSlice (tile:ts)
 
 getPixel :: Float -> Char
 getPixel l

src-client/Main.hs

@@ -60,7 +60,7 @@ main = do
   vty <- mkVty cfg
 
   -- shut down graphical interface for now
-  shutdown vty
+  -- shutdown vty
 
   clientState <- STM.newTMVarIO (ClientState vty False False)
   let initSlice = MapSlice (M.matrix 9 9 (const Nothing)) []