Move towards implementing wrist shields

src/Dodge/Creature/HandPos.hs

@@ -23,8 +23,30 @@ aimingMuzzlePos :: Creature -> Item -> Float
 aimingMuzzlePos cr it = aimingWeaponZeroPos cr it 
     + fromMaybe 0 (it ^? itDimension . dimPortage . muzPos)
 
+translatePointToRightHand :: Creature -> Point3 -> Point3
+translatePointToRightHand cr = translatePointToRightHand' cr . mirrorV3xz
+
+mirrorV3xz :: Point3 -> Point3
+mirrorV3xz (V3 x y z) = V3 x (-y) z
+
+translatePointToRightHand' :: Creature -> Point3 -> Point3
+translatePointToRightHand' cr
+    | oneH cr = (+.+.+ V3 11 (-3) 20) . rotate3 (-0.5)-- . scaleSH (V3 1 1.5 1)
+    | twists cr = (+.+.+ V3 0 5 20) . rotate3 (-1) . (+.+.+ V3 4 (-10) 0)
+    | twoFlat cr = (+.+.+ V3 4 (-8) 10)
+    | otherwise = case cr ^? crStance . carriage of
+        Just (Walking sa LeftForward)  -> (+.+.+ V3 (-f sa) (-off) 10)
+        _ -> (+.+.+ V3 0 (-off) 10)
+  where
+    off = 8
+    sLen = _strideLength $ _crStance cr
+    f i = negate 2 + negate 6 * fromIntegral (sLen - i) / fromIntegral sLen
+
 translateToRightHand :: Creature -> SPic -> SPic
-translateToRightHand cr
+translateToRightHand cr = translateToRightHand' cr . mirrorSPxz
+
+translateToRightHand' :: Creature -> SPic -> SPic
+translateToRightHand' cr
     | oneH cr = shoulderSP . translateSPf 11 (-3) . rotateSP (-0.5)-- . scaleSH (V3 1 1.5 1)
     | twists cr = shoulderSP . translateSPf 0 5 . rotateSP (-1) . translateSPf 4 (-10)
     | twoFlat cr = waistSP . translateSPf 4 (-8)
@@ -36,6 +58,19 @@ translateToRightHand cr
     sLen = _strideLength $ _crStance cr
     f i = negate 2 + negate 6 * fromIntegral (sLen - i) / fromIntegral sLen
 
+translatePointToLeftHand :: Creature -> Point3 -> Point3
+translatePointToLeftHand cr
+    | oneH cr = (+.+.+ V3 0 0 10) . rotate3 0.4 . (+.+.+ V3 0 off 0)
+    | twists cr = (+.+.+ V3 0 5 20) . rotate3 (-1) . (+.+.+ V3 12 4 0)
+    | twoFlat cr = (+.+.+ V3 4 8 10)
+    | otherwise = case cr ^? crStance . carriage of
+        Just (Walking sa RightForward)  -> (+.+.+ V3 (-f sa) off 10)
+        _ -> (+.+.+ V3 0 off 10)
+  where
+    off = 8
+    sLen = _strideLength $ _crStance cr
+    f i = negate 2 + negate 6 * fromIntegral (sLen - i) / fromIntegral sLen
+
 translateToLeftHand :: Creature -> SPic -> SPic
 translateToLeftHand cr
     | oneH cr = waistSP . rotateSP 0.4 . translateSPf 0 off

src/Dodge/Creature/Impulse/UseItem.hs

@@ -32,42 +32,49 @@ itemEffect cr it w = case it ^? itUse of
     hammerTest f = case _crHammerPosition cr of
         HammerUp -> f w
         _ -> w & setuhamdown
-    lhammer f' = w & case _crHammerPosition cr of
-        HammerUp -> creatures . ix (_crID cr) %~ f'
-        _ -> id
     setuhamdown = creatures . ix (_crID cr) . crHammerPosition .~ HammerDown
-    doequipmentchange = setuhamdown $ lhammer (toggleEquipmentAt (_rbOptions w) (_crInvSel cr)
+    doequipmentchange = setuhamdown $ hammerTest (toggleEquipmentAt (_rbOptions w) (_crInvSel cr) cr
-        . activateEquipmentAt (_rbOptions w))
+        . activateEquipmentAt (_rbOptions w) cr)
 
-activateEquipmentAt :: RightButtonOptions -> Creature -> Creature
+activateEquipmentAt :: RightButtonOptions -> Creature -> World -> World
-activateEquipmentAt rbo = case (rbo ^? opActivateEquipment . activateEquipment, rbo ^? opActivateEquipment . deactivateEquipment) of
+activateEquipmentAt rbo cr = creatures . ix (_crID cr) %~ case (rbo ^? opActivateEquipment . activateEquipment, rbo ^? opActivateEquipment . deactivateEquipment) of
     (Just i,_) -> crLeftInvSel ?~ i
     (_,Just _) -> crLeftInvSel .~ Nothing
     _ -> id
 
-toggleEquipmentAt :: RightButtonOptions -> Int -> Creature -> Creature
+toggleEquipmentAt :: RightButtonOptions -> Int -> Creature -> World -> World
-toggleEquipmentAt rbops invid cr = case rbops ^? opAllocateEquipment of
+toggleEquipmentAt rbops invid cr w = case rbops ^? opAllocateEquipment of
-    Just DoNotMoveEquipment -> cr
+    Just DoNotMoveEquipment -> w
     Just PutOnEquipment {_allocNewPos = newp}
-        -> cr & crEquipment . at newp ?~ invid
+        -> w & crpoint . crEquipment . at newp ?~ invid
-            & crInvEquipped . at invid ?~ newp
+            & crpoint . crInvEquipped . at invid ?~ newp
+            & onequip itm cr
     Just MoveEquipment {_allocNewPos=newp,_allocOldPos = oldp }
-        -> cr & crEquipment . at newp ?~ invid
+        -> w & crpoint . crEquipment . at newp ?~ invid
-            & crEquipment . at oldp .~ Nothing
+            & crpoint . crEquipment . at oldp .~ Nothing
-            & crInvEquipped . at invid ?~ newp
+            & crpoint . crInvEquipped . at invid ?~ newp
     Just SwapEquipment {_allocNewPos=newp, _allocOldPos = oldp, _allocSwapID = sid }
-        -> cr & crEquipment . at newp ?~ invid
+        -> w & crpoint . crEquipment . at newp ?~ invid
-            & crEquipment . at oldp ?~ sid
+            & crpoint . crEquipment . at oldp ?~ sid
-            & crInvEquipped . at invid ?~ newp
+            & crpoint . crInvEquipped . at invid ?~ newp
-            & crInvEquipped . at sid ?~ oldp
+            & crpoint . crInvEquipped . at sid ?~ oldp
     Just ReplaceEquipment {_allocNewPos = newp, _allocRemoveID = rid }
-        -> cr & crEquipment . at newp ?~ invid
+        -> w & crpoint . crEquipment . at newp ?~ invid
-            & crInvEquipped . at invid ?~ newp
+            & crpoint . crInvEquipped . at invid ?~ newp
-            & crInvEquipped . at rid .~ Nothing
+            & crpoint . crInvEquipped . at rid .~ Nothing
+            & onremove (itmat rid) cr
+            & onequip itm cr
     Just RemoveEquipment {_allocOldPos = oldp }
-        -> cr & crEquipment . at oldp .~ Nothing
+        -> w & crpoint . crEquipment . at oldp .~ Nothing
-            & crInvEquipped . at invid .~ Nothing
+            & crpoint . crInvEquipped . at invid .~ Nothing
+            & onremove itm cr
     Nothing -> error "tried to toggle equipment whilst not prepared"
+  where
+    crpoint = creatures . ix (_crID cr)
+    itmat i = _crInv cr IM.! i
+    itm = itmat (_crInvSel cr)
+    onequip itm' = (_eqOnEquip . _itUse) itm' itm'
+    onremove itm' = (_eqOnRemove . _itUse) itm' itm'
 
 useLeftItem :: Int -> World -> World
 useLeftItem cid w 

src/Dodge/Creature/State.hs

@@ -145,7 +145,9 @@ useUpdate = (useHammer . hammerPosition %~ moveHammerUp)
     . (useDelay . rateTime %~ decreaseToZero)
 
 useEquipment :: Creature -> Int -> World -> World
-useEquipment cr i = _eqUse (_itUse $ _crInv cr IM.! i) cr i
+useEquipment cr i = _eqUse (_itUse itm) itm cr
+  where
+    itm = _crInv cr IM.! i
 -- a map updating all inventory items
 upInv :: Creature -> World -> World
 upInv cr = creatures . ix (_crID cr) . crInv %~ IM.mapWithKey (itemUpdate cr)

src/Dodge/Data.hs

@@ -418,16 +418,20 @@ data ItemUse
         , _useDelay     :: UseDelay
         , _useHammer    :: HammerType
         , _eqSite       :: EquipSite
-        , _eqUse        :: Creature -> Int -> World -> World
+        , _eqUse        :: Item -> Creature -> World -> World
+        , _eqOnEquip    :: Item -> Creature -> World -> World
+        , _eqOnRemove   :: Item -> Creature -> World -> World
+        , _eqParams     :: EquipParams
         }
     | ConsumeUse 
         { _cUse :: Item -> Creature -> World -> World
         }
     | EquipUse
-        { _eqUse        :: Creature -> Int -> World -> World
+        { _eqUse        :: Item -> Creature -> World -> World
-        , _eqOnEquip    :: Creature -> Int -> World -> World
+        , _eqOnEquip    :: Item -> Creature -> World -> World
-        , _eqOnRemove   :: Creature -> Int -> World -> World
+        , _eqOnRemove   :: Item -> Creature -> World -> World
         , _eqSite       :: EquipSite
+        , _eqParams     :: EquipParams
         }
     | NoUse
 data EquipSite
@@ -725,6 +729,9 @@ data GunBarrels
         , _brlInaccuracy :: Float
         }
     | SingleBarrel  {_brlInaccuracy :: Float}
+data EquipParams
+    = NoEquipParams
+    | EquipID {_eparamID :: Int}
 data ItemParams
     = NoParams
     | ShellLauncher
@@ -1360,3 +1367,4 @@ makeLenses ''CreatureStatistics
 makeLenses ''RightButtonOptions
 makeLenses ''AllocateEquipment
 makeLenses ''ActivateEquipment
+makeLenses ''EquipParams

src/Dodge/Default.hs

@@ -163,6 +163,7 @@ defaultEquipment = Item
         ,_eqOnEquip = \_ _ -> id
         ,_eqOnRemove = \_ _ -> id
         ,_eqSite = GoesOnSpecial
+        ,_eqParams = NoEquipParams
         }
     , _itAttachment = NoItAttachment
     , _itParams = NoParams

src/Dodge/Default/Weapon.hs

@@ -70,15 +70,16 @@ defaultlUse = LeftUse
     , _useHammer  = NoHammer
     , _eqSite = GoesOnSpecial
     , _eqUse = \_ _ -> id
+    , _eqOnEquip = \_ _ -> id
+    , _eqOnRemove = \_ _ -> id
+    , _eqParams = NoEquipParams
     }
 
 luseInstantNoH :: (Item -> Creature -> World -> World) -> ItemUse
-luseInstantNoH f = LeftUse
+luseInstantNoH f = defaultlUse
     { _lUse = f
     , _useDelay = NoDelay
     , _useHammer  = NoHammer
-    , _eqSite = GoesOnSpecial
-    , _eqUse = \_ _ -> id
     }
 defaultAimParams :: AimParams
 defaultAimParams = AimParams

src/Dodge/Item/Equipment.hs

@@ -27,8 +27,8 @@ magShield = defaultEquipment
     }
     & itUse . eqUse .~ useMagShield 
     & itUse . eqSite .~ GoesOnWrist
-useMagShield :: Creature -> Int -> World -> World
+useMagShield :: Item -> Creature -> World -> World
-useMagShield cr invid w = w & magnets . at mgid ?~ themagnet
+useMagShield it cr w = w & magnets . at mgid ?~ themagnet
   where
     themagnet = Magnet
         {_mgID = mgid
@@ -39,7 +39,7 @@ useMagShield cr invid w = w & magnets . at mgid ?~ themagnet
     mgid = case it ^? itAttachment . itMInt . _Just of
         Just mgid' -> mgid'
         Nothing -> IM.newKey $ _magnets w
-    it = _crInv cr IM.! invid
+--    it = _crInv cr IM.! invid
 
 flameShield :: Item 
 flameShield = defaultEquipment
@@ -68,16 +68,42 @@ wristArmour :: Item
 wristArmour = defaultEquipment
     { _itType = WRISTARMOUR
     , _itName = "WRISTARMOUR"
-    , _itEquipPict = spicForWrist (emptySH , setDepth 20 $ pictures
+    , _itEquipPict = spicForWrist mempty
-        [color thecol $ thickArc 0        (pi/2) 10 5
-        ,color thecol $ thickArc (3*pi/2) (2*pi) 10 5
-        ])
     , _itEffect = NoItEffect
     , _itID = Nothing
     }
     & itUse . eqSite .~ GoesOnWrist
+    & itUse . eqOnEquip .~ onEquipWristShield
+    & itUse . eqUse .~ setWristShieldPos
+    & itUse . eqOnRemove .~ onRemoveWristShield
+
+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}
+    & setWristShieldPos (itm & itUse . eqParams .~ EquipID i) cr
   where
-    thecol = yellow -- (greyN 0.1)
+    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
+  where
+    i = _eparamID $ _eqParams $ _itUse itm
+setWristShieldPos :: Item -> Creature -> World -> World
+setWristShieldPos itm cr w = w
+    & moveWallIDUnsafe i wlline
+--    & tempLightSources .:~ tlsTimeRadColPos 1 200 0.7 (fst wlline `v2z` 40)
+  where
+    i = _eparamID $ _eqParams $ _itUse itm
+    wlline = (f (V3 (-10) 7 0), f (V3 10 7 0))
+    invid = fromJust (_itInvPos itm)
+    --wlline = (V2 10 0, V2 (-10) 100)
+    handtrans = case cr ^? crInvEquipped . ix invid of
+        Just OnLeftWrist -> translatePointToLeftHand
+        _ -> translatePointToRightHand
+    f = (+.+ _crPos cr) . stripZ . rotate3 (_crDir cr) . handtrans cr
+
 
 spicForWrist :: SPic -> Creature -> Item -> SPic
 spicForWrist = pictureOnEquip . translateSP (V3 0 4 (-4))
@@ -89,7 +115,7 @@ pictureOnEquip sp cr itm = fromMaybe mempty $ do
 equipPosition :: EquipPosition -> Creature -> SPic -> SPic
 equipPosition epos cr sh = case epos of
     OnLeftWrist -> translateToLeftHand cr sh
-    OnRightWrist -> translateToRightHand cr $ mirrorSPxz sh
+    OnRightWrist -> translateToRightHand cr sh
     OnLegs -> translateToLeftLeg cr sh <> 
         translateToRightLeg cr (mirrorSPxz sh)
     OnHead -> translateToHead cr sh
@@ -253,8 +279,8 @@ headLampShape = colorSH yellow $
     <> translateSH (V3 5 (-2) 4) (upperPrismPoly 4 $ rectWH 4 1)
     <> translateSH (V3 5 (-2) 0) (upperPrismPoly 4 $ rectWH 4 1)
 
-createHeadLamp :: Creature -> Int -> World -> World
+createHeadLamp :: Item -> Creature -> World -> World
-createHeadLamp cr _ = tempLightSources .:~ tlsTimeRadColPos 1 200 0.7 
+createHeadLamp _ cr = tempLightSources .:~ tlsTimeRadColPos 1 200 0.7 
     ((_crPos cr `v2z` 0) +.+.+ rotate3 (_crDir cr) (translatePointToHead cr (V3 5 0 3)))
 
 powerLegs :: Item

src/Dodge/Wall/Move.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE BangPatterns #-}
 module Dodge.Wall.Move
     ( moveWallID
+    , moveWallIDUnsafe
     , moveWall
     , moveWallIDToward
     , mvPs
@@ -12,6 +13,12 @@ import Dodge.Wall.Zone
 
 import Control.Lens
 import qualified Data.IntMap.Strict as IM
+
+moveWallIDUnsafe :: Int -> (Point2,Point2) -> World -> World
+moveWallIDUnsafe wlid wlline w = case w ^? walls . ix wlid of
+    Nothing -> error "tried moving nonexistant wall"
+    Just wl -> moveWall wlid wl wlline w
+
 moveWallID :: Int -> (Point2,Point2) -> World -> World
 moveWallID wlid wlline w = case w ^? walls . ix wlid of
     Nothing -> w