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 hiding (trace) -- internal imports import Client.Types import Library.Types vFOV :: Float 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 = '█' | 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