131 lines
3.7 KiB
Haskell
131 lines
3.7 KiB
Haskell
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
|