module Screen.Check where import Meeple.Operate import Screen.Primitives import Plant import Room import Tile import Terminal.Game import Lens.Micro.Platform import qualified Data.Maybe as M -- Checks are generally polymorphic on every creature (player, baddies, -- stars, etc.). ------------ -- PLAYER -- ------------ -- convenience, player specific -- playerDead :: HasScreen s => s -> Bool playerDead s = M.isNothing (s ^. player) playerTile :: HasScreen s => s -> (TileType -> Bool) -> Bool playerTile s bf = maybe False (\m -> meepleTile s m bf) (s ^. mplayer) ------------ -- MEEPLE -- ------------ -- tile under the player bool check meepleTile :: HasScreen s => s -> Meeple -> (TileType -> Bool) -> Bool meepleTile s m bf = checkCoords s (m ^. position) bf -- am -- amGrounded :: (HasScreen s, Meepeable m, HasStationary m) => s -> m -> Bool amGrounded s m = checkGround s m (m ^. position . to (_1 +~ 1)) amOutOfBounds :: HasScreen s => s -> Meeple -> Bool amOutOfBounds s m = let (pr, pc) = m ^. position (rr, rc) = s ^. room . to boundaries in pr > rr || pc > rc || pr < 1 || pc < 1 -- can -- canClimb :: HasScreen s => s -> Meeple -> Bool canClimb s m = meepleTile s m (== Ladder) && notSlow m where notSlow (MPlayer p) = p ^. amSlow . to not notSlow _ = True canDescend :: HasScreen s => s -> Meeple -> Bool canDescend s m = checkCoords s (m ^. position & _1 +~ 1) (==Ladder) -- can I move (1x1 move there? Diagonally, only if there passage is -- not narrow (so if we want to go to 1,1 from 0,0, only if 1,0 or 0,1 -- are not blocked and 1,1 is not blocked too). canGoThere :: (HasScreen s, Meepeable m, HasStationary m) => s -> m -> Coords -> Bool canGoThere s m c@(x, y) | meepleCategory (a2m m) == Projectile = True | otherwise = close && free && wide where -- relative position (rx, ry) = let (mx, my) = m ^. position in (mx - x, my - y) close = abs rx <= 1 && abs ry <= 1 free = not (checkGround s m c) && not (checkSimilar s m c) wide = not diag || open open = not (checkSolid s (c & _1 +~ rx)) || not (checkSolid s (c & _2 +~ ry)) diag = rx /= 0 || ry /= 0 -- exists -- isPlayerDead :: HasScreen s => s -> Bool isPlayerDead s = s ^. meeples . to (any isP) . to not where isP (MPlayer _) = True isP _ = False ------------------ -- COORDS BASED -- ------------------ -- bool: if tile does not exist checkCoords :: HasScreen s => s -> Coords -> (TileType -> Bool) -> Bool checkCoords s cs bf = maybe False (bf . tType) t where t :: Maybe Tile t = getTile (s ^. neighbourPlant) cs -- specific -- checkBaddie :: HasScreen s => s -> Coords -> Bool checkBaddie s cs = checkCoordsMeeple s cs (not . isPlayer) checkSolid :: HasScreen s => s -> Coords -> Bool checkSolid s cs = checkCoords s cs isSolid || checkLock s cs -- checks for solid or meeples I prefer to avoid (same as me) checkSolidMeeps :: (HasScreen s, Meepeable m) => s -> m -> Coords -> Bool checkSolidMeeps s m cs = checkSolid s cs || (checkBaddie s cs && checkSimilar s m cs) ----------------- -- ANCILLARIES -- ----------------- checkLock :: HasScreen s => s -> Coords -> Bool checkLock s cs = checkCoordsMeeple s cs isLock where isLock MLock {} = True isLock _ = False -- or solid, or ground *below* meeple level checkGround :: (HasScreen s, Coo m) => s -> m -> Coords -> Bool checkGround s m cs = checkSolid s cs || groundBelow cs where groundBelow :: Coords -> Bool groundBelow (r, c) = let (pr, _) = m ^. position in -- ground ground cs && -- below r > pr && -- is not rope and we're climbing (not (isMeepClim (a2m m)) && checkCoords s (r, c) (==Ladder)) isMeepClim (MPlayer p) = p ^. isClimbing isMeepClim _ = False ground :: Coords -> Bool ground wcs = checkCoords s wcs isGround || checkLock s wcs -- meeples of the same class in there? checkSimilar :: (HasScreen s, Meepeable m) => s -> m -> Coords -> Bool checkSimilar s m c = checkCoordsMeeple s c (isSimilar (a2m m)) -- check wheter meeple at coords has certain properties checkCoordsMeeple :: HasScreen s => s -> Coords -> (Meeple -> Bool) -> Bool checkCoordsMeeple s c bf = let ms = s ^.. meeples . each . filtered bf ps = map (view position) ms in elem c ps