Move hands to touch walls

src/Dodge/WallCreatureCollisions.hs

@@ -9,7 +9,6 @@ import Data.Maybe
 import qualified Data.IntMap.Strict as IM
 import Control.Lens
 import Data.Foldable
-import qualified Data.IntSet as IS
 import Dodge.Base
 import Dodge.Creature.Radius
 import Dodge.Data.Universe
@@ -56,14 +55,14 @@ pushCr w wls cr
     | otherwise = ecr
   where
 --    stwls = IM.filter (\wl -> uncurry circOnSegNoEndpoints (wl ^. wlLine) sp r) wls
-    twls = IM.elems $ IM.restrictKeys wls (ecr ^. crWallTouch) -- `IM.union` stwls
+    twls = IM.elems $ IM.intersection wls (ecr ^. crWallTouch) -- `IM.union` stwls
 --    ep = ecr ^. crPos . _xy
     ap = cr ^. crOldPos . _xy
 --    sp = cr ^. crPos . _xy
     ecr = foldl' f (cr & crWallTouch .~ mempty) wls
     r = crRad (cr ^. crType)
-    f acr wl = case pushOutFromWall r (acr ^. crPos . _xy) (wl ^. wlLine) of
-        Just p -> acr & crPos . _xy .~ p & crWallTouch %~ IS.insert (wl ^. wlID)
+    f acr wl = case pushOutFromWall' r (acr ^. crPos . _xy) (wl ^. wlLine) of
+        Just (p,hitp) -> acr & crPos . _xy .~ p & crWallTouch . at (wl ^. wlID) ?~ hitp
         Nothing -> acr
 
 wallMovement :: LWorld -> Point2 -> Wall -> Point2
@@ -100,11 +99,22 @@ wlWlCrush' w p w1 w2 = (t w1 w2 || t w2 w1) -- test either wall is moving toward
 wallBuffer :: Float
 wallBuffer = 0
 
--- 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
+---- 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
+--    | otherwise = Nothing
+--  where
+--    n = errorNormalizeV 61 $ vNormal (wp1 - wp2)
+--    wp1' = wp1 + rad *^ n
+--    wp2' = wp2 + rad *^ n
+--    newP = errorClosestPointOnLine 5 wp1' wp2' cp2
+--    isOnWall = circOnSegNoEndpoints wp1 wp2 cp2 rad
+
+pushOutFromWall' :: Float -> Point2 -> (Point2, Point2) -> Maybe (Point2,Point2)
+pushOutFromWall' rad cp2 (wp1, wp2)
+    | isOnWall = Just (newP,newP - rad *^ n)
     | otherwise = Nothing
   where
     n = errorNormalizeV 61 $ vNormal (wp1 - wp2)