graphics now works
This commit is contained in:
parent
3ae9c714df
commit
0f5101f7bb
5 changed files with 96 additions and 112 deletions
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Add table
Reference in a new issue