Check.hs

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