Better check for wall collisions when expanding creature

src/Dodge/Base.hs

@@ -367,7 +367,8 @@ collidePointCrsWithoutPoint cid p1 p2 w
     $ _creatures w
   where 
     f (cID,(p,_)) = (p,cID)
-{- | Test if a circle collides with any wall. -}
+{- | Test if a circle collides with any wall. 
+ - Note no check on whether the wall is walkable. -}
 circOnSomeWall :: Point2 -> Float -> World -> Bool
 circOnSomeWall p rad w 
     = any (\(x,y) -> circOnSeg x y p rad) 

src/Dodge/Creature/Action.hs

@@ -8,7 +8,7 @@ module Dodge.Creature.Action
     , dropUnselected
     , startReloadingWeapon
     , blinkAction
-    , maybeSizeSelf
+    , sizeSelf
     , crAutoReload
     , copyInvItemToFloor
     , youDropItem
@@ -295,9 +295,10 @@ pickUpItem cid flit w = case maybeInvSlot of
         Nothing -> w'
         Just j  -> w' & itemPositions . ix j .~ InInv 0 invid
 
-maybeSizeSelf :: Float -> Creature -> World -> Maybe World
+sizeSelf :: Float -> Creature -> World -> Maybe World
-maybeSizeSelf x cr w 
+sizeSelf x cr w 
-    | _crPos cr1 == _crPos cr2 = Just $ w
+    -- | _crPos cr1 == _crPos cr2 = Just $ w
+    | not (crOnWall cr1 w) = Just $ w
         & soundMultiFrom [TeleSound 0,TeleSound 1] cpos teleS Nothing
         & over distortions (distortionBulge :)
         & creatures . ix cid %~ 

src/Dodge/Item/Weapon/Utility.hs

@@ -47,7 +47,7 @@ useShrinkGun it cr w = if _itBool $ _itAttachment it
     then tryResize 0.5 $ stripNoItems cr . f False UndroppableIdentified . dropUnselected cr
     else tryResize 1   $ f True Uncursed . setMinInvSize defaultInvSize cr
   where
-    tryResize x g = maybe w g $ maybeSizeSelf x cr w
+    tryResize x g = maybe w g $ sizeSelf x cr w
     f isInUse cstatus = creatures . ix (_crID cr) . crInv . ix (_crInvSel cr) %~
         ( (itAttachment . itBool .~ isInUse) . (itCurseStatus .~ cstatus) )
 

src/Dodge/WallCreatureCollisions.hs

@@ -3,6 +3,7 @@ module Dodge.WallCreatureCollisions
     ( colCrsWalls
     , colCrWall
     , pushCreatureOutFromWalls
+    , crOnWall
     ) where
 import Dodge.Data
 --import Dodge.Data.DamageType
@@ -30,7 +31,7 @@ colCrWall w c
   where 
 --    c'' = c' & crPos %~ pushOutFromWalls rad ls
     --c'  = c & crPos %~ pushOutFromWalls' rad (reverse ls)
-    c'  = c & crPos %~ pushOutFromCorners rad (reverse ls)
+    c'  = c & crPos %~ pushOutFromCorners rad ls
         . pushOutFromWalls rad ls 
         . flip (collidePointWalls p1) wls  -- check push throughs
     rad = _crRad c + wallBuffer
@@ -57,11 +58,11 @@ pushOutFromWalls rad wls p1 = case (getFirst . foldMap (First . pushOutFromWall
     Just p2 -> fromMaybe p2 $ (getLast . foldMap (Last . pushOutFromWall rad p2)) wls
     -- possible improvement: choose between the closer of p2 and "p3" to p1
 
-pushOutFromWalls' :: Float -> [(Point2,Point2)] -> Point2 -> Point2
+--pushOutFromWalls' :: Float -> [(Point2,Point2)] -> Point2 -> Point2
-pushOutFromWalls' rad wls p1 = case (getFirst . foldMap (First . pushOutFromWall' rad p1)) wls of
+--pushOutFromWalls' rad wls p1 = case (getFirst . foldMap (First . pushOutFromWall' rad p1)) wls of
-    Nothing -> p1
+--    Nothing -> p1
-    Just p2 -> fromMaybe p2 $ (getLast . foldMap (Last . pushOutFromWall' rad p2)) wls
+--    Just p2 -> fromMaybe p2 $ (getLast . foldMap (Last . pushOutFromWall' rad p2)) wls
-    -- possible improvement: choose between the closer of p2 and "p3" to p1
+--    -- 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
@@ -73,6 +74,14 @@ pushOrCrush wls cr = case mapMaybe (pushOutFromWall (_crRad cr) cpos) wls of
   where
     cpos = _crPos cr
 
+-- note the inclusion of endpoints in circOnSeg
+crOnWall :: Creature -> World -> Bool
+crOnWall cr w = any (\(a,b) -> circOnSeg a b p r) wls
+  where
+    p = _crPos cr
+    r = _crRad cr
+    wls = fmap _wlLine . IM.filter (not . _wlWalkable) $ wallsNearPoint p w
+ 
 -- assumes that the wall is orientated
 -- assumes wall points are different
 pushOutFromWall :: Float -> Point2 -> (Point2,Point2) -> Maybe Point2
@@ -85,17 +94,17 @@ pushOutFromWall rad cp2 (wp1,wp2)
     wp2' = wp2 +.+ rad *.* norm
     newP = errorClosestPointOnLine 5 wp1' wp2' cp2
     isOnWall = circOnSegNoEndpoints wp1 wp2 cp2 rad
-pushOutFromWall' :: Float -> Point2 -> (Point2,Point2) -> Maybe Point2
+--pushOutFromWall' :: Float -> Point2 -> (Point2,Point2) -> Maybe Point2
-pushOutFromWall' rad cp2 (wp1,wp2) 
+--pushOutFromWall' rad cp2 (wp1,wp2) 
-    | isOnWall  = Just newP
+--    | isOnWall  = Just newP
-    | otherwise = Nothing
+--    | otherwise = Nothing
-  where 
+--  where 
-    norm = errorNormalizeV 61 $ vNormal (wp1 -.- wp2)
+--    norm = errorNormalizeV 61 $ vNormal (wp1 -.- wp2)
-    wp1' = wp1 +.+ rad *.* norm
+--    wp1' = wp1 +.+ rad *.* norm
-    wp2' = wp2 +.+ rad *.* norm
+--    wp2' = wp2 +.+ rad *.* norm
-    newP = errorClosestPointOnLine 5 wp1' wp2' cp2
+--    newP = errorClosestPointOnLine 5 wp1' wp2' cp2
-    --isOnWall = circOnSegNoEndpoints wp1 wp2 cp2 rad
+--    --isOnWall = circOnSegNoEndpoints wp1 wp2 cp2 rad
-    isOnWall = circOnSeg wp1 wp2 cp2 rad
+--    isOnWall = circOnSeg wp1 wp2 cp2 rad
 
 pushOutFromCorners :: Float -> [(Point2,Point2)] -> Point2 -> Point2
 pushOutFromCorners r ls p = foldr (intersectCirclePoint r) p (map fst ls)