wizard-wipeout/src-client/Client/Graphics.hs

134 lines
3.7 KiB
Haskell
Raw Normal View History

2023-12-22 15:18:08 +00:00
module Client.Graphics where
2023-12-23 02:19:32 +00:00
import qualified Control.Concurrent.STM as STM
import Control.Monad.RWS
2023-12-23 10:39:34 +00:00
import qualified Data.Matrix as M
2023-12-23 02:19:32 +00:00
import Data.Maybe
import qualified Data.Vector as V
import Graphics.Vty
2024-06-09 05:32:03 +00:00
import Linear hiding (trace)
import Debug.Trace
2023-12-23 02:19:32 +00:00
-- internal imports
2023-12-22 15:18:08 +00:00
import Client.Types
2023-12-23 02:19:32 +00:00
import Library.Types
2023-12-23 10:39:34 +00:00
vFOV :: Float
vFOV = pi / 2
hFOV :: Float
2024-06-09 05:32:03 +00:00
hFOV = pi / 2
2023-12-23 10:39:34 +00:00
2023-12-23 02:19:32 +00:00
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)
2024-06-09 05:32:03 +00:00
(\mh -> map
2023-12-23 02:19:32 +00:00
(\mw -> drawPixel mapSlice wizard dims (fromIntegral mw, fromIntegral mh))
2024-06-09 05:32:03 +00:00
[dw, dw - 1 .. 1]
2023-12-23 02:19:32 +00:00
)
2023-12-23 10:39:34 +00:00
image = V.foldl (<->)
2023-12-23 02:19:32 +00:00
emptyImage
2024-06-09 05:32:03 +00:00
(V.map (string currentAttr) result V.++
2023-12-23 10:39:34 +00:00
V.foldl (V.++) V.empty (V.generate 4 (const $ V.singleton emptyImage)))
2023-12-23 02:19:32 +00:00
picture = picForImage image
liftIO $ update vty picture
drawPixel
2024-06-09 05:32:03 +00:00
:: MapSlice -- ^ visible slice of the map
-> Wizard -- ^ Player
-> (Int, Int) -- ^ Screen dimensions
-> (Float, Float) -- ^ current "Pixel"
-> Char -- ^ resulting "Color"
2023-12-23 02:19:32 +00:00
drawPixel slice wizard (w, h) currentPixel =
let rayLength = castRay
2024-06-09 05:32:03 +00:00
(wizardRot wizard - pi / 2)
2023-12-23 02:19:32 +00:00
slice
(fromIntegral w, fromIntegral h)
currentPixel
2023-12-23 10:39:34 +00:00
in getPixel (fromMaybe 5 rayLength)
2023-12-23 02:19:32 +00:00
castRay
2024-06-09 05:32:03 +00:00
:: 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))
2023-12-23 10:39:34 +00:00
stepR = signum vr
stepC = signum vc
2024-06-09 05:32:03 +00:00
tMaxR = (fromIntegral $ floor $ 5 + stepR - 5) / vr
tMaxC = (fromIntegral $ floor $ 5 + stepC - 5) / vc
2023-12-23 10:39:34 +00:00
tDeltaR = stepR / vc
tDeltaC = stepC / vc
2024-06-09 05:32:03 +00:00
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
2023-12-23 10:39:34 +00:00
buildRay
:: (Float, Float)
-> (Float, Float)
-> (Float, Float)
-> (Float, Float)
-> [(Float, Float)]
2024-06-09 05:32:03 +00:00
buildRay (tMaxR, tMaxC) delta@(tDeltaR, tDeltaC) rstep@(stepR, stepC) (r, c) =
if distance (V2 5 5) (V2 r c) < 4
2023-12-23 10:39:34 +00:00
then if tMaxR < tMaxC
then
let ntMaxR = tMaxR - tDeltaR
nr = r - stepR
2024-06-09 05:32:03 +00:00
in (nr, c) : buildRay (ntMaxR, tMaxC) delta rstep (nr, c)
2023-12-23 10:39:34 +00:00
else
let ntMaxC = tMaxC - tDeltaC
nc = c - stepC
2024-06-09 05:32:03 +00:00
in (r, nc) : buildRay (tMaxR, ntMaxC) delta rstep (r, nc)
2023-12-23 10:39:34 +00:00
else []
getRayCollision
2023-12-23 02:19:32 +00:00
:: V2 Float
-> MapSlice
2023-12-23 10:39:34 +00:00
-> [(Float, Float)]
2023-12-23 02:19:32 +00:00
-> Maybe Float
2024-06-09 05:32:03 +00:00
getRayCollision _ _ [] = Nothing
getRayCollision view@(V2 vr vc) mapSlice ((wizR, _):tile@(tr, tc):ts) =
2023-12-23 10:39:34 +00:00
case msViewMap mapSlice M.! (floor tr, floor tc) of
Just Wall ->
let t = if floor wizR == floor tr
2024-06-09 05:32:03 +00:00
then (fromIntegral (floor tc) + 5) / vc
else (fromIntegral (floor tr) + 5) / vr
2023-12-23 10:39:34 +00:00
vec = (* t) <$> view
2024-06-09 05:32:03 +00:00
--in trace ("boing" ++ show tile) $ Just (sqrt $ vec `dot` vec)
in Just (distance vec (V2 5 5))
_ -> getRayCollision view mapSlice (tile:ts)
getRayCollision _ _ [_] = Nothing
2023-12-22 15:18:08 +00:00
2023-12-23 02:19:32 +00:00
getPixel :: Float -> Char
getPixel l
| l <= 1 = '█'
| l <= 2 = '▓'
| l <= 3 = '▒'
| l <= 4 = '░'
| otherwise = ' '
2023-12-22 15:18:08 +00:00
2023-12-23 02:19:32 +00:00
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