163 lines
5.4 KiB
Haskell
163 lines
5.4 KiB
Haskell
module Util where
|
|
|
|
import Affection as A
|
|
|
|
import Data.Matrix as M
|
|
import qualified Data.HashSet as HS
|
|
import Data.Graph.AStar
|
|
import Data.Maybe (fromMaybe)
|
|
|
|
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, 0), (-1, 0), (0, 1), (0, -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)
|
|
|
|
inBounds :: V2 Int -> Boundaries Int -> Bool
|
|
inBounds (V2 r c) (Boundaries (minr, minc) (maxr, maxc)) =
|
|
(r >= minr && r <= maxr) && (c >= minc && c <= maxc)
|
|
|
|
astarAppl :: Matrix (Maybe ImgId) -> V2 Int -> V2 Int -> Maybe [V2 Int]
|
|
astarAppl imgmat target start = aStar
|
|
(naviGraph imgmat)
|
|
(\a b -> distance (fmap fromIntegral a) (fmap fromIntegral b))
|
|
(\a -> distance (fmap fromIntegral target) (fmap fromIntegral a))
|
|
(== target)
|
|
start
|
|
|
|
naviGraph :: Matrix (Maybe ImgId) -> V2 Int -> HS.HashSet (V2 Int)
|
|
naviGraph imgmat (V2 r c) =
|
|
let list1 =
|
|
foldl
|
|
(\acc (or, oc) ->
|
|
if null
|
|
(fromMaybe [] $
|
|
imgObstacle <$> M.safeGet (r + or) (c + oc) imgmat)
|
|
then V2 (r + or) (c + oc): acc
|
|
else acc
|
|
)
|
|
[]
|
|
[(0, 1), (0, -1), (1, 0), (-1, 0)]
|
|
list2 =
|
|
foldl
|
|
(\acc (or, oc) ->
|
|
if null (fromMaybe [] $
|
|
imgObstacle <$> M.safeGet (r + or) (c + oc) imgmat)
|
|
&& all null
|
|
(map
|
|
(\(oor, ooc) -> fromMaybe [] $
|
|
imgObstacle <$> M.safeGet (r + oor) (c + ooc) imgmat)
|
|
[(0, oc), (or, 0)])
|
|
then V2 (r + or) (c + oc): acc
|
|
else acc
|
|
)
|
|
[]
|
|
[(-1, -1), (-1, 1), (1, -1), (1, 1)]
|
|
in HS.fromList (list1 ++ list2)
|