tinkering graphics

This commit is contained in:
nek0 2024-06-09 07:32:03 +02:00
parent 7a58d222ad
commit 6f93ead9d9
7 changed files with 93 additions and 55 deletions

View file

@ -81,13 +81,13 @@ handleMessage (Ping id') = do
)
sock
-- handleMessage (TickUpdate !slice !wizard) = do
-- st <- get
-- let !newState = st
-- { scWizard = wizard
-- , scMapSlice = slice
-- }
-- put newState
handleMessage (TickUpdate !slice !wizard) = do
st <- get
let !newState = st
{ scWizard = wizard
, scMapSlice = slice
}
put newState
handleMessage x =
liftIO $ putStrLn $ "received unexpected message from server: " <> show x

View file

@ -23,16 +23,14 @@ runGame = do
queue <- asks rcQueue
clientId <- asks rcClientUUID
st <- get
-- recvThread <- liftIO $ forkIO $ forever $ receiveMessage sock queue st
liftIO $ sendMessage (ClientMessage clientId ClientReady) sock
whileM_
(liftIO (not <$> readIORef (scStopper st)))
(do
liftIO $ receiveMessage sock queue st
handleMessages
-- draw
draw
)
-- liftIO $ killThread recvThread
handleEvent
:: Maybe Event

View file

@ -12,7 +12,9 @@ import qualified Data.Vector as V
import Graphics.Vty
import Linear
import Linear hiding (trace)
import Debug.Trace
-- internal imports
@ -23,7 +25,7 @@ vFOV :: Float
vFOV = pi / 2
hFOV :: Float
hFOV = pi / 1.5
hFOV = pi / 2
draw :: Game ()
draw = do
@ -34,90 +36,87 @@ draw = do
(w, h) <- liftIO $ displayBounds (outputIface vty)
let dims@(dw, dh) = (w, h - 4)
result = V.generate (fromIntegral dh)
(\mh -> string defAttr $ map
(\mh -> map
(\mw -> drawPixel mapSlice wizard dims (fromIntegral mw, fromIntegral mh))
[1 .. dw]
[dw, dw - 1 .. 1]
)
image = V.foldl (<->)
emptyImage
(result V.++
(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
-> Wizard
-> (Int, Int)
-> (Float, Float)
-> Char
:: 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)
(wizardPos wizard)
(wizardRot wizard - pi / 2)
slice
(fromIntegral w, fromIntegral h)
currentPixel
in getPixel (fromMaybe 5 rayLength)
castRay
:: Float
-> V2 Float
-> MapSlice
-> (Float, Float)
-> (Float, Float)
-> Maybe Float
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))
view@(V2 vr vc) = V2 0 1 `rotVec` (wizardRot + (- hFOV / 2 + dw * hFOV / w))
:: 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 $ wr + stepR - wr) / vr
tMaxC = (fromIntegral $ floor $ wc + stepC - wc) / vc
tMaxR = (fromIntegral $ floor $ 5 + stepR - 5) / vr
tMaxC = (fromIntegral $ floor $ 5 + stepC - 5) / 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)
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)
-> V2 Float
-> [(Float, Float)]
buildRay (tMaxR, tMaxC) delta@(tDeltaR, tDeltaC) rstep@(stepR, stepC) (r, c) slicePos =
if distance slicePos (V2 r c) < 4
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) slicePos
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) slicePos
in (r, nc) : buildRay (tMaxR, ntMaxC) delta rstep (r, nc)
else []
getRayCollision
:: V2 Float
-> V2 Float
-> MapSlice
-> [(Float, Float)]
-> Maybe Float
getRayCollision _ _ _ [] = Nothing
getRayCollision _ _ _ [_] = Nothing
getRayCollision pos@(V2 pr pc) view@(V2 vr vc) mapSlice ((wizR, _):tile@(tr, tc):ts) =
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) + pc) / vc
else (fromIntegral (floor tr) + pr) / vr
then (fromIntegral (floor tc) + 5) / vc
else (fromIntegral (floor tr) + 5) / vr
vec = (* t) <$> view
in Just (sqrt $ vec `dot` vec)
_ -> getRayCollision pos view mapSlice (tile:ts)
--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

View file

@ -66,7 +66,7 @@ main = do
-- shutdown vty
stopper <- newIORef False
clientState <- STM.newTMVarIO (ClientState undefined False)
clientState <- STM.newTMVarIO (ClientState vty False)
let initSlice = MapSlice (M.matrix 9 9 (const Nothing)) []
let initRead = ReaderContainer sock clientId queue
initState = StateContainer (initWizard playerWizard) clientState initSlice stopper

View file

@ -105,6 +105,7 @@ handleMessage stateContainer readerContainer msg = do
{ playerLastPong = (now, uuid)
}
void $ STM.swapTMVar (scPlayers stateContainer) (modPlayer : otherPlayers)
sendUpdate stateContainer (rcMap readerContainer) player
)
mPlayer
)

View file

@ -1,3 +1,4 @@
{-# LANGUAGE RecordWildCards #-}
module Server.Communication.Send where
import Control.Concurrent
@ -14,6 +15,8 @@ import Control.Monad.State
import qualified Data.Aeson as A
import qualified Data.Matrix as M
import Data.Maybe
import qualified Data.ByteString as B
@ -28,6 +31,8 @@ import Data.List
import Data.UUID
import Data.UUID.V4
import Linear
import Network.Socket
-- internal imports
@ -122,6 +127,42 @@ dropClient clientList sock = do
mClient
close sock
sendUpdates
:: Game ()
sendUpdates = pure ()
sendUpdate
:: StateContainer
-> ServerMap
-> Player
-> IO ()
sendUpdate stateContainer tileMap player = do
slice <- buildSlice player
sendSlice slice player
where
buildSlice :: Player -> IO MapSlice
buildSlice (Player _ (Wizard {..}) _ _) = do
let V2 wr wc = wizardPos
subCoords = (,) <$> [floor wr - 4 .. floor wr + 4] <*> [floor wc - 4 .. floor wc + 4]
leftBound = wizardRot + (pi / 4)
rightBound = wizardRot - (pi / 4)
leftLine row = cos leftBound * row
rightLine row = sin rightBound * row
correctionLeft = if wizardRot < pi / 2 || wizardRot > 2 * pi
then ceiling
else floor
correctionRight = if wizardRot < pi / 2 || wizardRot > 2 * pi
then ceiling
else floor
initViewMatrix = M.fromList 9 9 $ map
(\(qr, qc) ->
if qc - floor wc <= correctionLeft (leftLine (wr - fromIntegral qr))
&& qc - floor wc >= correctionRight (rightLine (wr - fromIntegral qr))
then
M.safeGet qr qc tileMap
else
Nothing
)
subCoords
pure (MapSlice initViewMatrix [])
sendSlice :: MapSlice -> Player -> IO ()
sendSlice slice (Player playerId wizard _ _) = do
let msg = TickUpdate slice wizard
print slice
liftIO $ sendMessage msg playerId (scClientSockets stateContainer)

View file

@ -38,7 +38,6 @@ runGame = do
handleMessages
updateSpawners delta
updateWizards delta
sendUpdates
modify'
(\s -> s
{ scServerLastTick = now