116 lines
3.4 KiB
Haskell
116 lines
3.4 KiB
Haskell
module Client.Graphics where
|
|
|
|
import qualified Control.Concurrent.STM as STM
|
|
|
|
import Control.Monad.RWS
|
|
|
|
import Data.List (foldl')
|
|
|
|
import qualified Data.Matrix as M
|
|
|
|
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
|
|
|
|
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
|
|
|
|
draw :: Game ()
|
|
draw = do
|
|
mapSlice <- msViewMap <$> gets scMapSlice
|
|
wizard <- gets scWizard
|
|
clientStateVar <- gets scClientState
|
|
vty <- clientVty <$> liftIO (STM.atomically $ STM.readTMVar clientStateVar)
|
|
(w, h) <- liftIO $ displayBounds (outputIface vty)
|
|
let result = map
|
|
(\y ->
|
|
map
|
|
(\x ->
|
|
getPixel $ foldl'
|
|
(\acc coord@(row, col) ->
|
|
if mapSlice M.! coord == Just Wall
|
|
then
|
|
let rayLength = castRay
|
|
wizard
|
|
(fromIntegral row, fromIntegral col)
|
|
(fromIntegral x, fromIntegral y)
|
|
(fromIntegral w, fromIntegral h)
|
|
in min rayLength acc
|
|
else
|
|
acc
|
|
)
|
|
5
|
|
((,) <$> [1 .. 9] <*> [1 .. 9])
|
|
)
|
|
[1 .. w]
|
|
)
|
|
[1 .. h]
|
|
image = foldl'
|
|
(\img line ->
|
|
img <-> string defAttr line
|
|
)
|
|
(string defAttr $ head result)
|
|
(tail result)
|
|
liftIO $ do
|
|
update vty (picForImage image)
|
|
-- mapM_ putStrLn result
|
|
|
|
castRay
|
|
:: Wizard -- Player
|
|
-> (Float, Float) -- coordinates of inspected tile
|
|
-> (Float, Float) -- screen pixel coordinates
|
|
-> (Float, Float) -- screen dimensions
|
|
-> Float -- Ray length
|
|
castRay wizard (row, col) (x, y) (width, height) =
|
|
let direction = angle (wizardRot wizard - pi / 2 - hFOV / 2 + x * hFOV / width)
|
|
invdir@(V2 invDirCol invDirRow) = (1 /) <$> direction
|
|
wStep@(V2 wStepRow wStepCol) = wizardPos wizard - (fromIntegral . floor <$> wizardPos wizard)
|
|
ulCol = col - 1
|
|
ulRow = row - 1
|
|
brCol = col
|
|
brRow = row
|
|
dMinCol = ((if signum invDirCol <= 0 then brCol else ulCol) - (4 + wStepCol)) * invDirCol
|
|
dMaxCol = ((if signum invDirCol <= 0 then ulCol else brCol) - (4 + wStepCol)) * invDirCol
|
|
dMinRow = ((if signum invDirRow <= 0 then brRow else ulRow) - (4 + wStepRow)) * invDirRow
|
|
dMaxRow = ((if signum invDirRow <= 0 then ulRow else brRow) - (4 + wStepRow)) * invDirRow
|
|
tMinCol = max dMinCol 0
|
|
tMaxCol = min dMaxCol (recip 0)
|
|
tMinRow = max dMinRow 0
|
|
tMaxRow = min dMaxRow (recip 0)
|
|
tMin = max 0 $ max dMinCol dMinRow
|
|
tMax = min (recip 0) $ min dMaxCol dMaxRow
|
|
vec = (tMin *) <$> direction
|
|
in
|
|
if tMin < tMax
|
|
then
|
|
let result = sqrt (vec `dot` vec) / cos ((- vFOV) / 2 + y * vFOV / height)
|
|
-- in trace ("ray length: " <> show result) result
|
|
-- in trace ("vector: " <> show (sqrt $ quadrance $ (tMin *) <$> direction)) result
|
|
-- in trace ("wStep: " <> show wStep) result
|
|
in result
|
|
else
|
|
-- trace (show (tMin, tMax)) 5
|
|
-- trace (show invdir) 5
|
|
5
|