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 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 Int -> V2 Int -> Maybe [V2 Int] astarAppl imgmat target = aStar (naviGraph imgmat) (\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 Int -> HS.HashSet (V2 Int) naviGraph imgmat (V2 r c) = let list1 = foldl (\acc (rr, cc) -> if null (maybe [] collisionObstacle (fromMaybe Nothing $ M.safeGet (r + rr) (c + cc) imgmat)) 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)) && all null (map (\(oor, ooc) -> maybe [] collisionObstacle (fromMaybe Nothing $ M.safeGet (r + oor) (c + ooc) imgmat)) [(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 -> IO () drawLoadScreen ud progress = 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 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) count dur pb)) -> do let crs = map (\iid -> crop (xoffs + (iid * w)) yoffs 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