module Util where import Affection as A import Data.Matrix as M import qualified Data.HashSet as HS import qualified Data.Set as S import qualified Data.Map as Map import Data.ByteString.Lazy (toStrict) import Data.Graph.AStar import Data.Maybe import qualified Data.Text as T import qualified SDL import qualified Graphics.Rendering.OpenGL as GL hiding (get) import System.Exit (exitFailure) import Linear hiding (E(..)) import NanoVG hiding (V2(..)) import NanoVG.Internal.Image (ImageFlags(..)) import Codec.Picture as CP import Codec.Picture.Extra -- 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 Double, Boundaries Double)] -> V2 Int -> V2 Int -> Maybe [V2 Int] astarAppl imgmat animBounds target = aStar (naviGraph imgmat animBounds) (\a b -> distance (fmap (fromIntegral :: Int -> Double) a) (fmap (fromIntegral :: Int -> Double) b) ) (\a -> distance (fmap fromIntegral target) (fmap fromIntegral a)) (== target) naviGraph :: Matrix (Maybe ImgId) -> [(V2 Double, Boundaries Double)] -> V2 Int -> HS.HashSet (V2 Int) naviGraph imgmat animBounds (V2 r c) = let list1 = foldl (\acc (rr, cc) -> if null ((maybe [] collisionObstacle (fromMaybe Nothing $ M.safeGet (r + rr) (c + cc) imgmat)) ++ (map snd $ filter (\(V2 br bc, _) -> floor br == r + rr && floor bc == c + cc) animBounds)) then V2 (r + rr) (c + cc): acc else acc ) [] [(0, 1), (0, -1), (1, 0), (-1, 0)] list2 = foldl (\acc (rr, cc) -> if null ((maybe [] collisionObstacle (fromMaybe Nothing $ M.safeGet (r + rr) (c + cc) imgmat)) ++ (map snd $ filter (\(V2 br bc, _) -> floor br == r + rr && floor bc == c + cc) animBounds)) && all null (map (\(oor, ooc) -> (maybe [] collisionObstacle (fromMaybe Nothing $ M.safeGet (r + oor) (c + ooc) imgmat)) ++ (map snd $ filter (\(V2 br bc, _) -> floor br == r + oor && floor bc == c + ooc) animBounds)) [(0, cc), (rr, 0)]) then V2 (r + rr) (c + cc): acc else acc ) [] [(-1, -1), (-1, 1), (1, -1), (1, 1)] in HS.fromList (list1 ++ list2) drawLoadScreen :: UserData -> (Float, T.Text) -> IO () drawLoadScreen ud (progress, msg) = do let ctx = nano ud save ctx fillColor ctx (rgb 255 128 0) fontSize ctx 100 fontFace ctx (assetFonts ud Map.! FontBedstead) textAlign ctx (S.fromList [AlignCenter, AlignTop]) textBox ctx 0 300 1280 "Loading" beginPath ctx rect ctx (640 - 640 * realToFrac progress) 450 (1280 * realToFrac progress) 20 closePath ctx fill ctx fontSize ctx 25 textBox ctx 0 500 1280 msg restore ctx loadAnimationSprites :: FilePath -- Path to Sprite map -> Context -- NanoVG context -> [(AnimId, AnimationConfig)] -> IO [(AnimId, Animation)] loadAnimationSprites fp nvg idconfs = do eimg <- readImage fp case eimg of Left err -> do logIO Error err exitFailure Right dimg -> do let img = convertRGBA8 dimg mapM (\(i, (AnimationConfig (xoffs, yoffs) (w, h) (sx, sy) count dur pb)) -> do let crs = map (\iid -> crop (xoffs + (iid * sx)) (yoffs + (iid * sy)) w h img) [0 .. (count - 1)] mresimgs <- mapM (\cr -> createImageMem nvg ImagePremultiplied (toStrict $ encodePng cr)) crs imgs <- if any isNothing mresimgs then do logIO Error ("failed to load: " ++ fp ++ " " ++ show i) exitFailure else return $ catMaybes mresimgs return $ ( i , Animation dur imgs pb ) ) idconfs direction :: V2 Double -> Maybe Direction direction vel'@(V2 vr _) = if sqrt (vel' `dot` vel') > 0 then let xuu = acos ((vel' `dot` V2 0 1) / sqrt (vel' `dot` vel')) / pi * 180 xu = if vr < 0 then 360 - xuu else xuu d | xu < 22.5 = NE | xu > 22.5 && xu < 67.5 = E | xu > 67.5 && xu < 112.5 = SE | xu > 112.5 && xu < 157.5 = S | xu > 157.5 && xu < 202.5 = SW | xu > 202.5 && xu < 247.5 = W | xu > 247.5 && xu < 292.5 = NW | xu > 292.5 && xu < 337.5 = N | xu > 337.5 = NE | otherwise = NE in Just d else Nothing