first graphics experiments

This commit is contained in:
nek0 2023-12-23 11:39:34 +01:00
parent 3e72e87e56
commit 83956203ca
3 changed files with 58 additions and 19 deletions

View file

@ -13,6 +13,7 @@ import Control.Monad.RWS
-- internal imports
import Client.Communication
import Client.Graphics
import Client.Types
import Library.Types
@ -28,5 +29,6 @@ runGame = do
(not . clientStop <$> (liftIO . STM.atomically . STM.readTMVar =<< gets scClientState))
(do
handleMessages
draw
)
liftIO $ killThread recvThread

View file

@ -4,6 +4,8 @@ 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
@ -17,6 +19,12 @@ import Linear
import Client.Types
import Library.Types
vFOV :: Float
vFOV = pi / 2
hFOV :: Float
hFOV = pi / 1.5
draw :: Game ()
draw = do
mapSlice <- gets scMapSlice
@ -28,15 +36,12 @@ draw = do
result = V.generate (fromIntegral dh)
(\mh -> string defAttr $ map
(\mw -> drawPixel mapSlice wizard dims (fromIntegral mw, fromIntegral mh))
[0 .. dw]
[1 .. dw]
)
image = V.foldl
(<->)
image = V.foldl (<->)
emptyImage
(result V.++
-- TODO: placeholder Status bar
V.generate 3 (const emptyImage)
)
V.foldl (V.++) V.empty (V.generate 4 (const $ V.singleton emptyImage)))
picture = picForImage image
liftIO $ update vty picture
@ -53,7 +58,7 @@ drawPixel slice wizard (w, h) currentPixel =
slice
(fromIntegral w, fromIntegral h)
currentPixel
in getPixel (fromMaybe 6 rayLength)
in getPixel (fromMaybe 5 rayLength)
castRay
:: Float
@ -65,22 +70,54 @@ castRay
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))
v@(V2 vx vy) = V2 0 1 `rotVec` (wizardRot + (- (pi / 1.5) / 2 + dw * (pi / 1.5) / w))
stepX = signum vx
stepY = signum vy
tMaxX = (fromIntegral $ floor $ wr + stepX - wr) / vx
tMaxY = (fromIntegral $ floor $ wc + stepY - wc) / vy
tDeltaX = stepX / vx
tDeltaY = stepY / vy
in fmap (/ cos (- pi / 4 + dh * pi / 2 / h)) (getRayColl wizardPos v slice)
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)
getRayColl
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
getRayColl wizardPos@(V2 wr wc) v@(V2 vx vy) slice =
undefined
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

View file

@ -60,7 +60,7 @@ main = do
vty <- mkVty cfg
-- shut down graphical interface for now
shutdown vty
-- shutdown vty
clientState <- STM.newTMVarIO (ClientState vty False False)
let initSlice = MapSlice (M.matrix 9 9 (const Nothing)) []