graphics now works

This commit is contained in:
nek0 2024-11-25 03:48:18 +01:00
parent 3ae9c714df
commit 0f5101f7bb
5 changed files with 96 additions and 112 deletions

View file

@ -4,5 +4,5 @@ setMapColumns : 40
setSpawnerProbability : 0.01 setSpawnerProbability : 0.01
setFPS : 30 setFPS : 30
setClientMaxTimeout : 5 setClientMaxTimeout : 5
setFramesPerPing : 120 setFramesPerPing : 10
setLogLevel : Info setLogLevel : Verbose

View file

@ -35,15 +35,15 @@ runGame = do
(liftIO (not <$> readIORef (scStopper st))) (liftIO (not <$> readIORef (scStopper st)))
(do (do
liftIO $ receiveMessage curLevel sock messageQueue st liftIO $ receiveMessage curLevel sock messageQueue st
-- liftIO $ putStrLn "received messages" logPrint Verbose "received messages"
handleMessages handleMessages
-- liftIO $ putStrLn "handled messages" logPrint Verbose "handled messages"
pumpEvents vty pumpEvents vty
-- liftIO $ putStrLn "pumped events" logPrint Verbose "pumped events"
handleEvents handleEvents
-- liftIO $ putStrLn "handled events" logPrint Verbose "handled events"
draw draw
-- liftIO $ putStrLn "drew" logPrint Verbose "drew"
) )
logPrint Info "left game loop" logPrint Info "left game loop"
liftIO $ do liftIO $ do

View file

@ -6,9 +6,7 @@ import Control.Monad.RWS
import qualified Data.Matrix as M import qualified Data.Matrix as M
import Data.Maybe import Debug.Trace
import qualified Data.Vector as V
import Graphics.Vty import Graphics.Vty
@ -25,97 +23,6 @@ vFOV = pi / 2
hFOV :: Float hFOV :: Float
hFOV = pi / 2 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 :: Float -> Char
getPixel l getPixel l
| l <= 1 = '█' | l <= 1 = '█'
@ -129,3 +36,80 @@ rotVec (V2 x y) rad = V2 nx ny
where where
nx = x * cos rad + y * sin rad nx = x * cos rad + y * sin rad
ny = x * sin rad - y * cos 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 wStepCol wStepRow) = 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
in
if tMin < tMax
then
let result = sqrt (quadrance ((tMin *) <$> direction)) * abs ((- 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

View file

@ -32,9 +32,9 @@ main :: IO ()
main = do main = do
putStrLn "Hello, Arena!" putStrLn "Hello, Arena!"
(Options logLevel socketLocation) <- execParser opts (Options logLevel socketLocation) <- execParser opts
logPrintIO Info logLevel $ "connecting to Socket " <> socketLocation logPrintIO logLevel Info $ "connecting to Socket " <> socketLocation
sock <- connectSocket socketLocation sock <- connectSocket socketLocation
logPrintIO Info logLevel "connected" logPrintIO logLevel Info "connected"
messageQueue <- STM.newTQueueIO messageQueue <- STM.newTQueueIO
@ -56,7 +56,7 @@ main = do
sendMessage logLevel IdRequest sock sendMessage logLevel IdRequest sock
clientIdMsg <- awaitResponse logLevel sock messageQueue mockState 0 clientIdMsg <- awaitResponse logLevel sock messageQueue mockState 0
let clientId = acClientUUID clientIdMsg let clientId = acClientUUID clientIdMsg
logPrintIO Info logLevel $ "received client UUID: " <> show clientId logPrintIO logLevel Info $ "received client UUID: " <> show clientId
putStrLn welcomeText putStrLn welcomeText
@ -66,7 +66,7 @@ main = do
sendMessage logLevel (ClientMessage clientId ClientRequestWizard) sock sendMessage logLevel (ClientMessage clientId ClientRequestWizard) sock
-- threadDelay $ 1 * 10 ^ 6 -- threadDelay $ 1 * 10 ^ 6
playerWizard <- awaitResponse logLevel sock messageQueue mockState 1 playerWizard <- awaitResponse logLevel sock messageQueue mockState 1
logPrintIO Info logLevel $ "received wizard: " <> show (initWizard playerWizard) logPrintIO logLevel Info $ "received wizard: " <> show (initWizard playerWizard)
vty <- mkVty defaultConfig vty <- mkVty defaultConfig
hideCursor (outputIface vty) hideCursor (outputIface vty)
@ -81,7 +81,7 @@ main = do
initState = StateContainer (initWizard playerWizard) clientState initSlice stopper initState = StateContainer (initWizard playerWizard) clientState initSlice stopper
-- putStrLn "sending quit message" -- putStrLn "sending quit message"
-- sendMessage (ClientMessage clientId ClientQuit) sock -- sendMessage (ClientMessage clientId ClientQuit) sock
logPrintIO Info logLevel "entering Game Monad" logPrintIO logLevel Info "entering Game Monad"
void $ execRWST void $ execRWST
(do (do
terminateGameOnSigint stopper terminateGameOnSigint stopper
@ -90,11 +90,11 @@ main = do
) )
initRead initRead
initState initState
logPrintIO Info logLevel "Shutting down client…" logPrintIO logLevel Info "Shutting down client…"
showCursor (outputIface vty) showCursor (outputIface vty)
shutdown vty shutdown vty
threadDelay 1000 threadDelay 1000
logPrintIO Info logLevel "Closing connection to server…" logPrintIO logLevel Info "Closing connection to server…"
close sock close sock
putStrLn "bye bye" putStrLn "bye bye"
where where

View file

@ -183,10 +183,10 @@ sendUpdate curLevel stateContainer tileMap player = do
rightBound = wizardRot - (pi / 4) rightBound = wizardRot - (pi / 4)
leftLine row = cos leftBound * row leftLine row = cos leftBound * row
rightLine row = sin rightBound * row rightLine row = sin rightBound * row
correctionLeft = if wizardRot < pi / 2 || wizardRot > 2 * pi correctionLeft = if wizardRot < pi / 2 || wizardRot >= 2 * pi
then ceiling then floor
else floor else ceiling
correctionRight = if wizardRot < pi / 2 || wizardRot > 2 * pi correctionRight = if wizardRot < pi / 2 || wizardRot >= 2 * pi
then ceiling then ceiling
else floor else floor
initViewMatrix = M.fromList 9 9 $ map initViewMatrix = M.fromList 9 9 $ map