wizard-wipeout/src-client/Client/Graphics.hs

module Client.Graphics where

import qualified Control.Concurrent.STM as STM

import Control.Monad.RWS

import Data.List (foldl')

import qualified Data.Matrix as M

import Graphics.Vty

import Linear hiding (trace)

-- internal imports

import Client.Types
import Library.Types

vFOV :: Float
vFOV = pi / 2

hFOV :: Float
hFOV = pi / 2

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

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