Partial implementation of wrist shields

src/Dodge/Item/Equipment.hs

@@ -15,6 +15,7 @@ import ShapePicture
 import Shape
 import qualified IntMapHelp as IM
 import LensHelp
+--import ShortShow
 
 import Data.Maybe
 magShield :: Item
@@ -80,19 +81,21 @@ wristArmour = defaultEquipment
 onEquipWristShield :: Item -> Creature -> World -> World
 onEquipWristShield itm cr w = w
     & creatures . ix (_crID cr) . crInv . ix (fromJust (_itInvPos itm)) . itUse . eqParams .~ EquipID i
-    & walls . at i ?~ (shieldWall (_crID cr)) {_wlDraw = True}
+    & walls . at i ?~ (shieldWall (_crID cr)) {_wlDraw = True,_wlID = i}
     & setWristShieldPos (itm & itUse . eqParams .~ EquipID i) cr
   where
-    i = IM.newKey $ _walls w
+    i = IM.newKey (_walls w)
+
 onRemoveWristShield :: Item -> Creature -> World -> World
 onRemoveWristShield itm cr w = w
     & creatures . ix (_crID cr) . crInv . ix (fromJust (_itInvPos itm)) . itUse . eqParams .~ NoEquipParams
---    & walls . at i .~ Nothing
+    & deleteWallID i
   where
     i = _eparamID $ _eqParams $ _itUse itm
 setWristShieldPos :: Item -> Creature -> World -> World
 setWristShieldPos itm cr w = w
     & moveWallIDUnsafe i wlline
+--    & testString .~ (\w' -> [shortShow $ _wlLine (_walls w' IM.! i)])
 --    & tempLightSources .:~ tlsTimeRadColPos 1 200 0.7 (fst wlline `v2z` 40)
   where
     i = _eparamID $ _eqParams $ _itUse itm
@@ -104,7 +107,6 @@ setWristShieldPos itm cr w = w
         _ -> translatePointToRightHand
     f = (+.+ _crPos cr) . stripZ . rotate3 (_crDir cr) . handtrans cr
 
-
 spicForWrist :: SPic -> Creature -> Item -> SPic
 spicForWrist = pictureOnEquip . translateSP (V3 0 4 (-4))
 pictureOnEquip :: SPic -> Creature -> Item -> SPic
@@ -188,7 +190,7 @@ shieldWallDamage dm _ crid w = case _dmType dm of
 
 createShieldWall :: Creature -> Int -> World -> World
 createShieldWall cr invid w = case _itEffectID $ _itEffect it of
-    Nothing -> let (wlid,w') = createWall ((shieldWall crid) {_wlLine = wlline}) w
+    Nothing -> let (wlid,w') = createWall ((shieldWall crid) {_wlLine = wlline,_wlID = wlid}) w
         in w' & creatures . ix crid . crInv . ix invid . itEffect . itEffectID ?~ wlid
     Just wid -> moveWallID wid wlline w
   where

src/Dodge/Render/ShapePicture.hs

@@ -59,11 +59,13 @@ extraPics cfig w = pictures (_decorations w)
     <> viewBoundaries cfig w
     <> viewClipBounds cfig w
     <> drawMousePosition cfig w
+    <> drawWallIDs cfig w
     <> drawPathing cfig w
     <> drawCrInfo cfig w
 
 testPic :: World -> Picture
-testPic _ = []
+testPic _ = mempty
+
 clDraw :: Cloud -> Picture
 clDraw c = translate3 (_clPos c) (_clPict c c)
 ppDraw :: PressPlate -> Picture
@@ -111,6 +113,20 @@ drawMousePosition cfig w
     p = worldPosToScreen w mwp
     mwp = mouseWorldPos w
 
+drawWallIDs :: Configuration -> World -> Picture
+drawWallIDs cfig w = setLayer FixedCoordLayer 
+    $ foldMap f (_walls w)
+  where
+    f wl 
+        | dist (_crPos $ you w) (fst (_wlLine wl)) > 200 = mempty  -- this should be improved with a better "on screen test"
+        | otherwise = winScale cfig
+            . uncurryV translate p
+            . scale 0.1 0.1
+            . text 
+            $ show $ _wlID wl 
+      where
+        p = worldPosToScreen w $ 0.5 *.* ( uncurry (+.+) $ _wlLine wl)
+
 drawPathing :: Configuration -> World -> Picture
 drawPathing cfig w
     | _debug_pathing cfig