diff --git a/src-client/Client/Graphics.hs b/src-client/Client/Graphics.hs index 23f6ef5..730a73d 100644 --- a/src-client/Client/Graphics.hs +++ b/src-client/Client/Graphics.hs @@ -1,5 +1,97 @@ module Client.Graphics where +import qualified Control.Concurrent.STM as STM + +import Control.Monad.RWS + +import Data.Maybe + +import qualified Data.Vector as V + +import Graphics.Vty + +import Linear + +-- internal imports + import Client.Types +import Library.Types +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 -> string defAttr $ map + (\mw -> drawPixel mapSlice wizard dims (fromIntegral mw, fromIntegral mh)) + [0 .. dw] + ) + image = V.foldl + (<->) + emptyImage + (result V.++ + -- TODO: placeholder Status bar + V.generate 3 (const emptyImage) + ) + picture = picForImage image + liftIO $ update vty picture +drawPixel + :: MapSlice + -> Wizard + -> (Int, Int) + -> (Float, Float) + -> Char +drawPixel slice wizard (w, h) currentPixel = + let rayLength = castRay + (wizardRot wizard) + (wizardPos wizard) + slice + (fromIntegral w, fromIntegral h) + currentPixel + in getPixel (fromMaybe 6 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)) + 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) + +getRayColl + :: V2 Float + -> V2 Float + -> MapSlice + -> Maybe Float +getRayColl wizardPos@(V2 wr wc) v@(V2 vx vy) slice = + undefined + +getPixel :: Float -> Char +getPixel l + | l <= 1 = '█' + | l <= 2 = '▓' + | l <= 3 = '▒' + | l <= 4 = '░' + | otherwise = ' ' + +rotVec :: V2 Float -> Float -> V2 Float +rotVec (V2 x y) rad = V2 nx ny + where + nx = x * cos rad + y * sin rad + ny = x * sin rad - y * cos rad diff --git a/wizard-wipeout.cabal b/wizard-wipeout.cabal index e4a04ee..7b7f270 100644 --- a/wizard-wipeout.cabal +++ b/wizard-wipeout.cabal @@ -43,6 +43,7 @@ executable wizard-wipeout-client build-depends: base ^>=4.17.2.1 , aeson , bytestring + , linear , matrix , monad-loops , mtl