module Client.Graphics where 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 import Graphics.Vty import Linear -- internal imports import Client.Types import Library.Types vFOV :: Float vFOV = pi / 2 hFOV :: Float hFOV = pi / 1.5 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)) [1 .. dw] ) image = V.foldl (<->) emptyImage (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 drawPixel slice wizard (w, h) currentPixel = let rayLength = castRay (wizardRot wizard) (wizardPos wizard) 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)) 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) 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 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 | 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