Improve wrist forcefield positioning

Not perfect for left wrist when aiming two handed twist weapons

src/Dodge/Creature/Impulse/UseItem.hs

@@ -2,6 +2,7 @@
 
 module Dodge.Creature.Impulse.UseItem (useItem) where
 
+import Dodge.Euse
 import NewInt
 import Control.Lens
 import Data.Maybe
@@ -9,7 +10,6 @@ import Dodge.Data.ComposedItem
 import Dodge.Data.DoubleTree
 import Dodge.Data.World
 import Dodge.DoubleTree
-import Dodge.Equipment
 import Dodge.HeldUse
 import Dodge.Inventory
 import Dodge.Item.Grammar

src/Dodge/Debug.hs

@@ -258,7 +258,7 @@ showMuzzlePositions  u = fold $ do
         ^? 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)
+    f cr loc = foldMap (g . muzzlePos loc cr)  (itemMuzzles $ loc ^. locDT . dtValue . _1)
       where
         g :: Point3Q -> Picture
         g pq = translate3 (pq ^. _1) $ crossPic 5

src/Dodge/Equipment.hs

@@ -1,63 +0,0 @@
-module Dodge.Equipment (
-    effectOnRemove,
-    effectOnEquip,
-) where
-
-import Control.Lens
-import Dodge.Creature.HandPos
-import Dodge.Data.World
-import Dodge.Item.Location
-import Dodge.Wall.Delete
-import Dodge.Wall.ForceField
-import Dodge.Wall.Move
-import Geometry
-import qualified IntMapHelp as IM
-import Linear
-import NewInt
-
-effectOnRemove :: Item -> Creature -> World -> World
-effectOnRemove itm = case itm ^. itType of
-    EQUIP WRISTARMOUR -> onRemoveWristShield itm
-    _ -> const id
-
-onRemoveWristShield :: Item -> Creature -> World -> World
-onRemoveWristShield itm _ =
-    (pointerToItem itm . itParams .~ NoParams)
-        . maybe id deleteWallID (itm ^? itParams . itParamID)
-
-effectOnEquip :: Item -> Creature -> World -> World
-effectOnEquip itm = case itm ^. itType of
-    EQUIP WRISTARMOUR -> onEquipWristShield itm
-    _ -> const id
-
-onEquipWristShield :: Item -> Creature -> World -> World
-onEquipWristShield itm cr w =
-    w
-        & pointerToItem itm . itParams .~ ItemParamID i
-        & cWorld . lWorld . walls . at i ?~ forceField{_wlID = i}
-        & setWristShieldPos
-            ( itm & itParams .~ ItemParamID{_itParamID = i}
-            )
-            cr
-  where
-    i = IM.newKey (w ^. cWorld . lWorld . walls)
-
-setWristShieldPos :: Item -> Creature -> World -> World
-setWristShieldPos itm cr w = w & moveWallIDUnsafe i wlline
-  where
-    i = _itParamID $ _itParams itm
-    wlline = (f (V3 (-10) 7 0), f (V3 10 7 0))
-    handtrans = case w
-        ^? cWorld
-            . lWorld
-            . items
-            . ix (itm ^. itID . unNInt)
-            . itLocation
-            . ilEquipSite
-            . _Just of
-        Just x -> translateToES cr x -- . g
-        _ -> undefined
-    --    g
-    --        | twists cr = (+.+.+ V3 (-5) 10 0)
-    --        | otherwise = id
-    f = (+.+ cr ^. crPos . _xy) . stripZ . rotate3 (_crDir cr) . handtrans

src/Dodge/Euse.hs

@@ -1,22 +1,25 @@
-module Dodge.Euse (equipBackgroundEffect) where
+module Dodge.Euse (
+    equipBackgroundEffect,
+    effectOnRemove,
+    effectOnEquip,
+) where
 
 import Dodge.Creature.HandPos
-import Dodge.Creature.Test
 import Dodge.Data.ComposedItem
 import Dodge.Data.DoubleTree
 import Dodge.Data.Equipment.Misc
 import Dodge.Data.World
+import Dodge.Item.Location
+import Dodge.Wall.Delete
+import Dodge.Wall.ForceField
 import Dodge.Wall.Move
 import Geometry
+import qualified IntMapHelp as IM
 import LensHelp
 import Linear
+import NewInt
 
-equipBackgroundEffect ::
-    LocationDT OItem ->
-    Creature ->
-    EquipSite ->
-    World ->
-    World
+equipBackgroundEffect :: LocationDT OItem -> Creature -> EquipSite -> World -> World
 equipBackgroundEffect loc cr = case eo of
     EQUIP (MAGSHIELD mt) -> const $ useMagShield mt itm cr
     EQUIP WRISTARMOUR -> setWristShieldPos itm cr
@@ -29,28 +32,31 @@ equipBackgroundEffect loc cr = case eo of
 -- this should probably drain energy
 useMagShield :: MagnetBuBu -> Item -> Creature -> World -> World
 useMagShield mt _ cr w =
-    w & cWorld . lWorld . magnets
+    w
+        & cWorld
+        . lWorld
+        . magnets
         .:~ Magnet
             { _mgPos = cr ^. crPos . _xy
             , _mgField = mt
             }
 
-setWristShieldPos :: Item -> Creature -> EquipSite -> World -> World
-setWristShieldPos itm cr x = moveWallIDUnsafe i wlline
-  where
-    i = _itParamID $ _itParams itm
-    wlline = (f (V3 (-10) 7 0), f (V3 10 7 0))
-    handtrans = case x of
-        OnLeftWrist -> \cr' -> translatePointToLeftHand cr' . g
-        _ -> translatePointToRightHand
-    g
-        | twists cr = (+.+.+ V3 (-5) 10 0)
-        | otherwise = id
-    f = (+.+ cr ^. crPos . _xy) . stripZ . rotate3 (_crDir cr) . handtrans cr
+--setWristShieldPos :: Item -> Creature -> EquipSite -> World -> World
+--setWristShieldPos itm cr x = moveWallIDUnsafe i wlline
+--  where
+--    i = _itParamID $ _itParams itm
+--    wlline = (f (V3 (-10) 7 0), f (V3 10 7 0))
+--    handtrans = case x of
+--        OnLeftWrist -> \cr' -> translatePointToLeftHand cr' . g
+--        _ -> translatePointToRightHand
+--    g
+--        | twists cr = (+.+.+ V3 (-5) 10 0)
+--        | otherwise = id
+--    f = (+.+ cr ^. crPos . _xy) . stripZ . rotate3 (_crDir cr) . handtrans cr
 
 -- TODO the reflection should be controled by the particle
---shieldWallDamage :: Damage -> Wall -> Int -> World -> World
---shieldWallDamage dm _ crid w = case _dmType dm of
+-- shieldWallDamage :: Damage -> Wall -> Int -> World -> World
+-- shieldWallDamage dm _ crid w = case _dmType dm of
 ----    Lasering -> w
 --    _ | isMovementDam dm -> w & creatures . ix crid . crState . crDamage .:~ dm
 --    _ -> w
@@ -58,7 +64,9 @@ setWristShieldPos itm cr x = moveWallIDUnsafe i wlline
 createHeadLamp :: Item -> Creature -> World -> World
 createHeadLamp _ cr w =
     w
-        & cWorld . lWorld . lights
+        & cWorld
+        . lWorld
+        . lights
         .:~ LSParam
             ( _crPos cr
                 +.+.+ rotate3
@@ -67,3 +75,61 @@ createHeadLamp _ cr w =
             )
             200
             0.7
+
+effectOnRemove :: Item -> Creature -> World -> World
+effectOnRemove itm = case itm ^. itType of
+    EQUIP WRISTARMOUR -> onRemoveWristShield itm
+    _ -> const id
+
+onRemoveWristShield :: Item -> Creature -> World -> World
+onRemoveWristShield itm _ =
+    (pointerToItem itm . itParams .~ NoParams)
+        . maybe id deleteWallID (itm ^? itParams . itParamID)
+
+effectOnEquip :: Item -> Creature -> World -> World
+effectOnEquip itm = case itm ^. itType of
+    EQUIP WRISTARMOUR -> onEquipWristShield itm
+    _ -> const id
+
+onEquipWristShield :: Item -> Creature -> World -> World
+onEquipWristShield itm cr w =
+    w
+        & pointerToItem itm
+        . itParams
+        .~ ItemParamID i
+        & cWorld
+        . lWorld
+        . walls
+        . at i
+        ?~ forceField{_wlID = i}
+        & setWristShieldPos
+            ( itm & itParams .~ ItemParamID{_itParamID = i}
+            )
+            cr esite
+  where
+    i = IM.newKey (w ^. cWorld . lWorld . walls)
+    esite = w ^?! cWorld . lWorld . items . ix (itm ^. itID . unNInt) . itLocation . ilEquipSite . _Just
+
+setWristShieldPos :: Item -> Creature -> EquipSite -> World -> World
+setWristShieldPos itm cr esite w = w & moveWallIDUnsafe i wlline
+  where
+    i = _itParamID $ _itParams itm
+    wlline = (f (V3 (-10) y 0), f (V3 10 y 0))
+    y = case esite of
+        OnLeftWrist -> 7
+        OnRightWrist -> -7
+        _ -> error "setWristShieldPos esite is not a wrist"
+    handtrans = case w
+        ^? cWorld
+        . lWorld
+        . items
+        . ix (itm ^. itID . unNInt)
+        . itLocation
+        . ilEquipSite
+        . _Just of
+        Just x -> translateToES cr x -- . g
+        _ -> undefined
+    --    g
+    --        | twists cr = (+.+.+ V3 (-5) 10 0)
+    --        | otherwise = id
+    f = (+.+ cr ^. crPos . _xy) . stripZ . rotate3 (_crDir cr) . handtrans

src/Dodge/Inventory.hs

@@ -16,13 +16,13 @@ module Dodge.Inventory (
     destroyAllInvItems,
 ) where
 
+import Dodge.Euse
 import Linear
 import Data.Function
 import Data.Maybe
 import Dodge.Base
 import Dodge.Data.SelectionList
 import Dodge.Data.World
-import Dodge.Equipment
 import Dodge.Inventory.Location
 import Dodge.Inventory.RBList
 import Dodge.Inventory.Swap

src/Dodge/ListDisplayParams.hs

@@ -38,7 +38,7 @@ invCursorParams w = BoundCurs $ case w ^? hud . subInventory of
     Just CombineInventory{} -> []
     _
         | ButtonRight `M.member` _mouseButtons (_input w)
-            && (null $ w ^? rbState . opSel) ->
+            && null (w ^? rbState . opSel) ->
             [North, South, East, West]
     _ -> [North, South, West]
 

src/Dodge/Update.hs

@@ -258,8 +258,8 @@ functionalUpdate =
         . over (uvWorld . cWorld . lWorld) updateMagnets
         . over uvWorld (cWorld . lWorld . lClock +~ 1)
         . over uvWorld updateDistortions
-        . over uvWorld pushYouOutFromWalls
         . over uvWorld updateCreatureSoundPositions
+        . over uvWorld pushYouOutFromWalls
         . over uvWorld updateCreatureStrides
         . colCrsWalls
         . over uvWorld simpleCrSprings
@@ -327,6 +327,7 @@ muzzleWallCheck w cr = fromMaybe cr $ do
         ^? ix invid . _2
     let ps = reduceLocDT f loc ^.. each . _1 . _xy
         cp = cr ^. crPos . _xy
+--        cop = cr ^. crOldPos . _xy
     r <- boundPointsRect (cp : ps)
     let wls = uncurry wlsNearRect r w & filter (not . _wlTouchThrough)
         vs = mapMaybe (g cp wls) ps