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 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 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) drawLoadScreen :: UserData -> Float -> IO () drawLoadScreen ud progress = do let ctx = nano ud -- fontSize ctx 100 -- fontFace ctx (assetFonts ud Map.! FontBedstead) -- textAlign ctx (S.fromList [AlignCenter, AlignTop]) fillColor ctx (rgb 255 128 0) rect ctx (640 - 640 * realToFrac progress) 450 (1280 * realToFrac progress) 20 fill 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 (\(id, (AnimationConfig (xoffs, yoffs) (w, h) count dur pb)) -> do let crs = map (\i -> crop (xoffs + (i * 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 id) exitFailure else return $ catMaybes mresimgs return $ ( id , Animation dur imgs pb ) ) idconfs