some graphics code

This commit is contained in:
nek0 2023-12-23 03:19:32 +01:00
parent 1ebc6961a2
commit b2d75ca3fd
2 changed files with 93 additions and 0 deletions

View file

@ -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

View file

@ -43,6 +43,7 @@ executable wizard-wipeout-client
build-depends: base ^>=4.17.2.1
, aeson
, bytestring
, linear
, matrix
, monad-loops
, mtl