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

module Client.Graphics where

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

import Graphics.Vty

import Linear hiding (trace)

import Debug.Trace

-- internal imports

import Client.Types
import Library.Types

vFOV :: Float
vFOV = pi / 2

hFOV :: Float
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 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