Implement (broken) push away from walls according to muzzle pos

src/Dodge/Update.hs

@@ -3,6 +3,13 @@
 
 module Dodge.Update (updateUniverse) where
 
+import Data.Function (on)
+import Dodge.Zoning.Wall
+import Bound
+import Dodge.Data.DoubleTree
+import Dodge.HeldUse
+import Dodge.DoubleTree
+import Dodge.Item.Grammar
 import Dodge.Creature.MoveType
 import Dodge.Render.List
 import Data.Foldable
@@ -251,6 +258,7 @@ functionalUpdate =
         . over (uvWorld . cWorld . lWorld) updateMagnets
         . over uvWorld (cWorld . lWorld . lClock +~ 1)
         . over uvWorld updateDistortions
+        . over uvWorld pushYouOutFromWalls
         . over uvWorld updateCreatureSoundPositions
         . over uvWorld updateCreatureStrides
         . colCrsWalls
@@ -309,6 +317,29 @@ functionalUpdate =
         . updateAimPos
         . over uvWorld updatePastWorlds  -- it might be possible to do this without storing stuff such as the temporary lights/flares etc
 
+pushYouOutFromWalls :: World -> World
+pushYouOutFromWalls w = w & cWorld . lWorld . creatures . ix 0 %~ muzzleWallCheck w
+
+muzzleWallCheck :: World -> Creature -> Creature
+muzzleWallCheck w cr = fromMaybe cr $ do
+    invid <- cr ^? crManipulation . manObject . imRootSelectedItem . unNInt
+    loc <- invIndents ((\k -> w ^?! cWorld . lWorld . items . ix k) <$> _crInv cr) 
+        ^? ix invid . _2
+    let ps = reduceLocDT f loc ^.. each . _1 . _xy
+        cp = cr ^. crPos . _xy
+    r <- boundPointsRect (cp : ps)
+    let wls = uncurry wlsNearRect r w
+        vs = mapMaybe (g cp wls) ps
+    return $ if null vs 
+        then cr
+        else let v = minimumBy (compare `on` norm) vs
+            in cr & crPos . _xy +~ normalize v
+  where
+    f loc = map (muzzlePos loc cr)  (itemMuzzles $ loc ^. locDT . dtValue . _1)
+    g cp wls p = case collidePoint cp p wls of
+        (ep,Just _) -> Just (ep - p)
+        _ -> Nothing
+
 updateCreatureStrides :: World -> World
 updateCreatureStrides w = foldl' updateCreatureStride w $ w ^. cWorld . lWorld . creatures