tracer/src/Util.hs

module Util where

import Affection as A

import Data.Matrix as M

import qualified SDL
import qualified Graphics.Rendering.OpenGL as GL hiding (get)

import Linear

-- internal imports

import Types

convertTileToImg :: Matrix TileState -> Matrix (Maybe ImgId)
convertTileToImg mat = fromLists conversion
  where
    conversion =
      map (\(i, ls) -> map (uncurry $ convertTile i) (zip [1..] ls))
        (zip [1..] (toLists mat))
    convertTile irow icol tile =
      case tile of
        Wall -> Just (case neighWalls irow icol mat of
          4 ->
            ImgWallCross
          3
            | M.safeGet (irow + 1) icol mat /= Just Wall &&
              M.safeGet (irow + 1) icol mat /= Just Door ->
              ImgWallTNW
            | M.safeGet irow (icol + 1) mat /= Just Wall &&
              M.safeGet irow (icol + 1) mat /= Just Door ->
              ImgWallTSW
            | M.safeGet (irow - 1) icol mat /= Just Wall &&
              M.safeGet (irow - 1) icol mat /= Just Door ->
              ImgWallTSE
            | otherwise ->
              ImgWallTNE
          2
            | (M.safeGet (irow + 1) icol mat == Just Wall ||
              M.safeGet (irow + 1) icol mat == Just Door) &&
              (M.safeGet (irow - 1) icol mat == Just Wall ||
              M.safeGet (irow - 1) icol mat == Just Door) ->
                ImgWallDesc
            | (M.safeGet irow (icol + 1) mat == Just Wall ||
              M.safeGet irow (icol + 1) mat == Just Door) &&
              (M.safeGet irow (icol - 1) mat == Just Wall ||
              M.safeGet irow (icol - 1) mat == Just Door) ->
                ImgWallAsc
            | (M.safeGet (irow - 1) icol mat == Just Wall ||
              M.safeGet (irow - 1) icol mat == Just Door) &&
              (M.safeGet irow (icol - 1) mat == Just Wall ||
              M.safeGet irow (icol - 1) mat == Just Door) ->
                ImgWallCornerW
            | (M.safeGet irow (icol - 1) mat == Just Wall ||
              M.safeGet irow (icol - 1) mat == Just Door) &&
              (M.safeGet (irow + 1) icol mat == Just Wall ||
              M.safeGet (irow + 1) icol mat == Just Door) ->
                ImgWallCornerS
            | (M.safeGet (irow + 1) icol mat == Just Wall ||
              M.safeGet (irow + 1) icol mat == Just Door) &&
              (M.safeGet irow (icol + 1) mat == Just Wall ||
              M.safeGet irow (icol + 1) mat == Just Door) ->
                ImgWallCornerE
            | otherwise ->
                ImgWallCornerN
          1
            | M.safeGet (irow - 1) icol mat == Just Wall ||
              M.safeGet (irow - 1) icol mat == Just Door ->
              ImgWallDesc
            | M.safeGet (irow + 1) icol mat == Just Wall ||
              M.safeGet (irow + 1) icol mat == Just Door ->
              ImgWallDesc
            | M.safeGet irow (icol + 1) mat == Just Wall ||
              M.safeGet irow (icol + 1) mat == Just Door ->
              ImgWallAsc
            | otherwise ->
              ImgWallAsc
          0 ->
            ImgWallCross
          _ ->
            error "unexpected number if neighbouring walls"
          )
        Offi
          | any
            (\(rr, cc) -> M.safeGet (irow + rr) (icol + cc) mat == Just Door)
            ((,) <$> [-1 .. 1] <*> [-1 .. 1]) ->
            Just ImgEmpty
          | otherwise ->
            Nothing
        _ ->
          Nothing

neighWalls :: Int -> Int -> Matrix TileState -> Int
neighWalls row col mat =
  Prelude.foldl (\acc (ir, ic) ->
    if M.safeGet (row + ir) (col + ic) mat == Just Wall ||
       M.safeGet (row + ir) (col + ic) mat == Just Door
    then acc + 1
    else acc
    )
    0
    [ (0, -1)
    , (-1, 0)
    , (0, 1)
    , (1, 0)
    ]

relativizeMouseCoords :: V2 Int32 -> IO (V2 Double)
relativizeMouseCoords (V2 ix iy) = do
  (GL.Position vx vy, GL.Size vw vh) <- SDL.get GL.viewport
  let rx = ix - vx
      ry = iy - vy
      hx = fromIntegral vw / 2
      hy = fromIntegral vh / 2
      dx = fromIntegral rx - hx
      dy = fromIntegral ry - hy
  return $ V2 (dx / hx) (dy / hy)