diff --git a/src-client/Client/Game.hs b/src-client/Client/Game.hs index 5c27713..6e15ba7 100644 --- a/src-client/Client/Game.hs +++ b/src-client/Client/Game.hs @@ -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 diff --git a/src-client/Client/Graphics.hs b/src-client/Client/Graphics.hs index 730a73d..74ac914 100644 --- a/src-client/Client/Graphics.hs +++ b/src-client/Client/Graphics.hs @@ -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 diff --git a/src-client/Main.hs b/src-client/Main.hs index c91517e..a7990b2 100644 --- a/src-client/Main.hs +++ b/src-client/Main.hs @@ -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)) []