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)