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

src/Bound.hs

@@ -1,6 +1,5 @@
-module Bound (
+module Bound (boundPoints
-    boundPoints,
+    ,boundPointsRect) where
-) where
 
 import qualified Control.Foldl as L
 import Control.Lens
@@ -20,3 +19,8 @@ boundPoints =
             )
   where
     f (mn, ms, me, mw) = (,,,) <$> mn <*> ms <*> me <*> mw
+
+boundPointsRect :: [Point2] -> Maybe (Point2,Point2)
+boundPointsRect ps = do
+    (n,s,e,w) <- boundPoints ps
+    return (V2 w s, V2 e n)

src/Dodge/HeldUse.hs

@@ -6,6 +6,8 @@ module Dodge.HeldUse (
     gadgetEffect,
     mcUseHeld,
     heldEffectMuzzles,
+    muzzlePos,
+    itemMuzzles,
 ) where
 
 import Color

src/Dodge/Render/ShapePicture.hs

@@ -1,6 +1,12 @@
 --{-# LANGUAGE LambdaCase #-}
 module Dodge.Render.ShapePicture (worldSPic) where
 
+import Dodge.DoubleTree
+import Dodge.Data.DoubleTree
+import Dodge.HeldUse
+import NewInt
+import Dodge.Item.Grammar
+import Dodge.Render.Label
 import Dodge.Debug
 import Control.Lens
 import Data.Foldable
@@ -40,6 +46,7 @@ worldSPic cfig u =
         <> foldup (mcSPic (w ^. cWorld)) (filtOn _mcPos _machines)
         <> foldMap' drawChasm (w ^. cWorld . chasms)
         <> w ^. cWorld . lWorld . tempSPic
+        <> testSPic cfig u
   where
     w = u ^. uvWorld
     lw = w ^. cWorld . lWorld
@@ -48,6 +55,24 @@ worldSPic cfig u =
     filtOn' f g = filter (pointIsClose . f) (g lw)
     pointIsClose = cullPoint cfig w
 
+testSPic :: Config -> Universe -> SPic
+testSPic cfig u = noShape $ testPic cfig u
+
+testPic :: Config -> Universe -> Picture
+testPic _ u = fold $ do
+    cr <- u ^? uvWorld . cWorld . lWorld . creatures . ix 0
+--    return mempty
+    invid <- cr ^? crManipulation . manObject . imRootSelectedItem . unNInt
+    loc <- invIndents ((\k -> u ^?! uvWorld . cWorld . lWorld . items . ix k) <$> _crInv cr) 
+        ^? ix invid . _2
+    return . color red $ setLayer DebugLayer $ reduceLocDT (f cr) loc
+  where
+    f cr loc = foldMap g $ map (muzzlePos loc cr)  (itemMuzzles $ loc ^. locDT . dtValue . _1)
+      where
+        g :: Point3Q -> Picture
+        g pq = translate3 (pq ^. _1) $ crossPic 5
+
+
 drawBlock :: Block -> SPic
 drawBlock = noPic . _blDraw
 

src/Dodge/Room/Room.hs

@@ -450,6 +450,3 @@ distributerRoom atype aamount = do
 
 tmDistributeLines :: [TerminalLine]
 tmDistributeLines = [TLine 1 [TerminalLineConst "ATTEMPTING TO DISTRIBUTE MATERIAL..." white] TmDistributeAmmo]
-
---    cor <- shuffleLinks corridor
---    return $ tToBTree "corDoor" $ treePost [door,cor,cleatOnward door]

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
 

src/Dodge/WorldEffect.hs

@@ -130,8 +130,6 @@ tmDistributeAmmo tm w = fromMaybe w $ do
             [TLine 1 [TerminalLineConst (g (aamount - newaamount)) white] TmWdId
             ,TLine 1 [TerminalLineConst (shortShow newaamount <>" "<>show atype<>" AVAILABLE") white] TmWdId
             ,TLine 1 [] (TmWdWdTermSound (getsid (aamount - newaamount)))
---            ,TLine 1 [TerminalLineConst "" yellow] (TmTmSetStatus (TerminalPressTo ""))
---            ,TLine 1 [TerminalLineConst "" white] (TmWdWdLeaveTerminal "")
             ]
   where
     getsid x | x > 0 = reloadS