Collision.hs

module Screen.Collision where

import Meeple.Operate
import Screen.Check
import Screen.Primitives
import Tile

import Lens.Micro.Platform
import Terminal.Game

import qualified Data.Ix    as I
import qualified Data.List  as L
import qualified Data.Tuple as T


-- Index of the meeple in [Meeples]
type Index = Int

-----------------------
-- MEEPLE COLLISIONS --
-----------------------

-- single you-on-everything collision
meepleCollision :: Index -> [Meeple] -> [Meeple]
meepleCollision i ms =
        let
            ei = length ms - 1
            pp  = [(i, j) | j <- [0..ei], j /= i] -- all possible pairs
            ppf = filter (areColliding ms) pp     -- only overlapping
        in
        L.foldl' collideMod ms ppf

-- Takes the position of two meeples and a list of meeples,
-- Sees if something has to happen, if so it can mark one or both the
-- indices ad 'Dead', or add to the list, but never shrink it or modify
-- it otherwise
collideMod :: [Meeple] -> (Index, Index) -> [Meeple]
collideMod ms (ia, ib) = ms & ix ia .~ na
                            & ix ib .~ nb
    where
          (na, nb) = collTable False (ms !! ia) (ms !! ib)


---------------------
-- COLLISION TABLE --
---------------------

type SecondRound = Bool
collTable :: Bool -> Meeple -> Meeple -> (Meeple, Meeple)

-- PLAYER --
collTable _ (MPlayer p) (MStar s) =
        (MPlayer p, MDead $ PlusStar (s ^. position))
collTable _ (MPlayer p) (MWin _) =
        (MPlayer p, MDead Won)
collTable _ (MPlayer _) m@(MDumb _) =
        (MDead None, m)
collTable _ (MPlayer _) m@(MSmart _) =
        (MDead None, m)
collTable _ (MPlayer _) m@(MBird _) =
        (MDead None, m)
collTable _ (MPlayer _) m@(MStone _) =
        (MDead None, m)
collTable _ (MPlayer _) m@(MKram _) =
        (MDead None, m)
collTable _ (MPlayer _) m@(MSickle _) =
        (MDead None, m)
collTable _ p@(MPlayer _) m@(MNettle n)
        | isStingy n = (MDead None, m)
        | otherwise  = (p, m)
collTable _ p@(MPlayer v) m@(MSave s)
        | v ^. isNew = (p, m)
        | otherwise  = (MPlayer $ v & amSaving .~ True,
                        MSave $ touchSave s)
collTable _ (MPlayer _) m@(MWitch _) =
        (MDead None, m)

-- DUMB --
collTable _ d@(MDumb _) (MStar _) =
        (d, MDead $ NeutralStar (d ^. position))
collTable _ (MDumb _) (MStone _) =
        (MDead None, MDead None)
collTable _ (MDumb _) (MSickle _) =
        (MDead None, MDead None)

-- SMART --
collTable _ s@(MSmart _) (MStar _) =
        (s, MDead $ NeutralStar (s ^. position))
collTable _ (MSmart _) (MStone _) =
        (MDead None, MDead None)
collTable _ (MSmart _) (MSickle _) =
        (MDead None, MDead None)

-- BIRD --
collTable _ b@(MBird _) (MStar _) =
        (b, MDead $ NeutralStar (b ^. position))
collTable _ (MBird _) (MSickle _) =
        (MDead None, MDead None)

-- KRAMPUS --
collTable _ k@(MKram _) (MStar _) =
        (k, MDead $ NeutralStar (k ^. position))


-- REPEAT? --
collTable False a b = T.swap $ collTable True b a -- inverted!
collTable True  a b = (a, b)   -- no effect


---------------------
-- ROOM COLLISIONS --
---------------------

roomCollision :: HasScreen s => s -> Meeple -> Meeple
roomCollision _ m@(MDead _) = m
roomCollision s m           = generalCollide s m

generalCollide :: HasScreen s => s -> Meeple -> Meeple
generalCollide _ m@(MDead _) = m
generalCollide s m@(MStone _)
        | checkSolid s (m ^. position) = MDead None
generalCollide s m
        | meepleTile s m (==Water) = MDead None
        | meepleTile s m (==Spike) = MDead None
        | meepleTile s m (==Slow)  = slowDown m
generalCollide _ m = m

slowDown :: Meeple -> Meeple
slowDown (MPlayer p) = MPlayer $ p & amSlow .~ True
slowDown m           = m

-----------------
-- ANCILLARIES --
-----------------

-- are two meeples in a collection (by index) colliding?
areColliding :: [Meeple] -> (Int, Int) -> Bool
areColliding ms (ia, ib) | isDead a ||
                           isDead b      = False
                                -- dead stuff can't collide
                         | pa == pb      = True
                         | isDiagonal &&
                           elem pb pas   = True
                         | otherwise     = False
    where
          a, b :: Meeple
          a = ms ^?! ix ia
          b = ms ^?! ix ib

          pa, pb :: Coords
          pa = a ^. position
          pb = b ^. position

          -- diagonal collision --


          isDiagonal :: Bool
          isDiagonal = let (px, py) = safePrevPos a
                           (cx, cy) = pa
                       in px /= cx && py /= cy

          pas :: [Coords]
          pas = diagonalArea pa (safePrevPos a)

-- rectangle between two points
diagonalArea :: Coords -> Coords -> [Coords]
diagonalArea (ra, ca) (rb, cb) =
        let p1 = (min ra rb, min ca cb)
            p2 = (max ra rb, max ca cb)
        in I.range (p1, p2)