{- | Deals with moving creature wall collisions. -} module Dodge.WallCreatureCollisions ( colCrsWalls ) where import Dodge.Data --import Dodge.Data.DamageType --import Dodge.Creature.State.Data import Dodge.Zone import Dodge.Base import Dodge.Config.Data import Geometry import Data.Monoid import Data.Maybe import Data.Function import Control.Lens import qualified Data.IntMap.Strict as IM colCrsWalls :: World -> World colCrsWalls w = over creatures (fmap (colCrWall w)) w colCrWall :: World -> Creature -> Creature colCrWall w c | noclipIsOn && _crID c == 0 = c -- for noclip | p1 == p2 = pushOrCrush ls c | otherwise = c & crPos %~ pushOutFromWalls rad ls . flip (collidePointWalls p1) wls -- check push throughs where rad = _crRad c + wallBuffer p1 = _crOldPos c p2 = _crPos c ls = IM.elems $ _wlLine <$> wls wls = IM.filter (not . _wlWalkable) $ wallsNearPoint p2 w --wallPoints = map fst ls noclipIsOn = _debug_noclip $ _config w -- the amount to push creatures out from walls, extra to their radius wallBuffer :: Float wallBuffer = 0 -- the following tests whether or not a point is on a wall, and if so pushes it -- out from the wall -- this is then repeated if the point ends up on a new wall pushOutFromWalls :: Float -> [(Point2,Point2)] -> Point2 -> Point2 pushOutFromWalls rad wls p1 = case (getFirst . foldMap (First . pushOutFromWall rad p1)) wls of Nothing -> p1 Just p2 -> fromMaybe p2 $ (getLast . foldMap (Last . pushOutFromWall rad p2)) wls -- possible improvement: choose between the closer of p2 and "p3" to p1 pushOrCrush :: [(Point2,Point2)] -> Creature -> Creature pushOrCrush wls cr = case mapMaybe (pushOutFromWall (_crRad cr) cpos) wls of [] -> cr (p:_) -> cr & crPos .~ p -- (_:p:_) -> cr -- & crPos .~ p -- & crState . crDamage %~ ( Blunt 50 cpos cpos cpos : ) where cpos = _crPos cr -- assumes that the wall is orientated -- assumes wall points are different pushOutFromWall :: Float -> Point2 -> (Point2,Point2) -> Maybe Point2 pushOutFromWall rad cp2 (wp1,wp2) | isOnWall = Just newP -- +.+ (1 *.* norm)) | otherwise = Nothing where norm = errorNormalizeV 61 $ vNormal (wp1 -.- wp2) wp1' = (rad *.* norm) +.+ wp1 wp2' = (rad *.* norm) +.+ wp2 newP = errorClosestPointOnLine 5 wp1' wp2' cp2 isOnWall = circOnSegNoEndpoints wp1 wp2 cp2 rad --pushOutFromCorners :: World -> Creature -> Creature --pushOutFromCorners w cr = cr & crPos .~ newPos -- where -- newPos = foldr (intersectCirclePoint (_crRad cr)) (_crPos cr) ls -- ls = nub . concatMap (\(x,y) -> [x,y]) . IM.elems $ _wlLine <$> wallsNearPoint (_crPos cr) w --collideCorners :: Float -> [Point2] -> Point2 -> Point2 --collideCorners rad ps p2 = foldr (intersectCirclePoint rad) p2 ps ---- collide circles with points (outer corners) --intersectCirclePoint :: Float -> Point2 -> Point2 -> Point2 --intersectCirclePoint rad p cCen -- | dist cCen p > rad = cCen -- | otherwise = p +.+ (rad *.* errorNormalizeV 65 (cCen -.- p))