some graphics code

src-client/Client/Graphics.hs

@@ -1,5 +1,97 @@
 module Client.Graphics where
 
+import qualified Control.Concurrent.STM as STM
+
+import Control.Monad.RWS
+
+import Data.Maybe
+
+import qualified Data.Vector as V
+
+import Graphics.Vty
+
+import Linear
+
+-- internal imports
+
 import Client.Types
+import Library.Types
 
+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 -> string defAttr $ map
+          (\mw -> drawPixel mapSlice wizard dims (fromIntegral mw, fromIntegral mh))
+          [0 .. dw]
+         )
+      image = V.foldl
+        (<->)
+        emptyImage
+        (result V.++
+          -- TODO: placeholder Status bar
+          V.generate 3 (const emptyImage)
+        )
+      picture = picForImage image
+  liftIO $ update vty picture
 
+drawPixel
+  :: MapSlice
+  -> Wizard
+  -> (Int, Int)
+  -> (Float, Float)
+  -> Char
+drawPixel slice wizard (w, h) currentPixel =
+  let rayLength = castRay
+        (wizardRot wizard)
+        (wizardPos wizard)
+        slice
+        (fromIntegral w, fromIntegral h)
+        currentPixel
+  in getPixel (fromMaybe 6 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))
+      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)
+
+getRayColl
+  :: V2 Float
+  -> V2 Float
+  -> MapSlice
+  -> Maybe Float
+getRayColl wizardPos@(V2 wr wc) v@(V2 vx vy) slice =
+  undefined
+
+getPixel :: Float -> Char
+getPixel l
+  | l <= 1    = '█'
+  | l <= 2    = '▓'
+  | l <= 3    = '▒'
+  | l <= 4    = '░'
+  | otherwise = ' '
+
+rotVec :: V2 Float -> Float -> V2 Float
+rotVec (V2 x y) rad = V2 nx ny
+  where
+    nx = x * cos rad + y * sin rad
+    ny = x * sin rad - y * cos rad

wizard-wipeout.cabal

@@ -43,6 +43,7 @@ executable wizard-wipeout-client
     build-depends:    base ^>=4.17.2.1
                     , aeson
                     , bytestring
+                    , linear
                     , matrix
                     , monad-loops
                     , mtl