Start to implement equipment sites on body

src/Dodge/Creature/Impulse/UseItem.hs

@@ -6,6 +6,7 @@ import Dodge.Data
 import Dodge.Inventory
 
 import qualified Data.IntMap.Strict as IM
+import qualified Data.IntSet as IS
 import Control.Lens
 import Data.Maybe
 
@@ -22,7 +23,7 @@ itemEffect cr it w = case it ^? itUse of
     Just RightUse {_rUse = eff,_useMods = usemods} 
                     -> hammerTest $ foldr ($) eff usemods it cr
     Just LeftUse {} -> setuhamdown $ lhammer setEquipLeftItem
-    Just EquipUse{} -> setuhamdown $ lhammer setEquipment
+    Just EquipUse{} -> setuhamdown $ lhammer $ toggleEquipmentAt (_crInvSel cr) it
     -- ConsumeUse will cause problems if the item is not selected
     Just (ConsumeUse eff) -> setuhamdown $ hammerTest $ eff it cr . rmInvItem (_crID cr) (_crInvSel cr)
     Just NoUse -> setuhamdown w
@@ -37,15 +38,44 @@ itemEffect cr it w = case it ^? itUse of
     setEquipLeftItem cr' = case _crLeftInvSel cr' of
         Just i | i == _crInvSel cr' -> cr' & crLeftInvSel .~ Nothing
         _ -> cr' & crLeftInvSel ?~ _crInvSel cr'
-    setEquipment = toggleEquipmentAt (_crInvSel cr)
     setuhamdown = creatures . ix (_crID cr) . crHammerPosition .~ HammerDown
 
-toggleEquipmentAt :: Int -> Creature -> Creature
-toggleEquipmentAt invid cr = cr & crInvEquipped . at invid %~ f
+toggleEquipmentAt :: Int -> Item -> Creature -> Creature
+toggleEquipmentAt invid itm cr 
+    | invid `IS.member` _crInvEquipped cr = cr & crInvEquipped . at invid .~ Nothing
+        & removeEquipmentUsingSite esite
+        & setEquipmentSite esite Nothing'
+    | otherwise = cr & crInvEquipped . at invid .~ Just ()
+        & removeEquipmentUsingSite esite
+        & setEquipmentSite esite (Just' invid)
   where
+    esite = _eqSite (_itUse itm)
     f Nothing = Just ()
     f (Just ()) = Nothing
 
+removeEquipmentUsingSite :: EquipSite -> Creature -> Creature
+removeEquipmentUsingSite esite cr = case esite of
+    GoesOnSpecial   -> cr
+    _ -> case cr ^? crEquipment . esiteToPoint . _Just' of
+        Just invid -> cr & crInvEquipped . at invid .~ Nothing
+        _ -> cr
+  where
+    esiteToPoint = case esite of
+        GoesOnHead      -> onHead
+        GoesOnChest     -> onChest
+        GoesOnBack      -> onBack
+        GoesOnWrist     -> onWristL
+        GoesOnLegs      -> onLegs
+
+setEquipmentSite :: EquipSite -> Maybe' Int -> Creature -> Creature
+setEquipmentSite esite = case esite of
+    GoesOnHead      -> set (crEquipment . onHead)
+    GoesOnChest     -> set (crEquipment . onChest)
+    GoesOnBack      -> set (crEquipment . onBack)
+    GoesOnWrist     -> set (crEquipment . onWristL)
+    GoesOnLegs      -> set (crEquipment . onLegs)
+    GoesOnSpecial   -> const id
+
 useLeftItem :: Int -> World -> World
 useLeftItem cid w 
     | _crInvLock cr = w

src/Dodge/Creature/Perception.hs

@@ -169,9 +169,8 @@ rememberSounds w cr = cr
 
 -- TODO work out correct form for sounds passing through walls
 soundIsClose :: World -> Creature -> (Point2,Float) -> Bool
-soundIsClose w cr (pos,vol) 
-    | dist cpos pos > 2000 = False
-    | hasLOS cpos pos w = vol > (_auDist . _crAudition $ _crPerception cr) (dist pos cpos)
-    | otherwise = False
+soundIsClose w cr (pos,vol) = dist cpos pos < 2000 
+    && vol > (_auDist . _crAudition $ _crPerception cr) (dist pos cpos)
+    && hasLOS cpos pos w
   where
     cpos = _crPos cr

src/Dodge/Creature/Property.hs

@@ -8,11 +8,14 @@ import Geometry
 
 import Control.Lens
 
+-- the use of crOldPos is because the damage position is calculated on the
+-- previous frame
+-- Not sure if it is a good idea
 crIsArmouredFrom :: Point2 -> Creature -> Bool
 crIsArmouredFrom p cr 
-    = p /= _crPos cr 
+    = p /= _crOldPos cr 
         && any (\it -> it ^? itType == Just FRONTARMOUR) (_crInv cr)
-        && angleVV (unitVectorAtAngle $ _crDir cr) (p -.- _crPos cr) < pi/2
+        && angleVV (unitVectorAtAngle $ _crDir cr) (p -.- _crOldPos cr) < pi/2
 -- even though angleVV can generate NaN, the comparison seems to deal with it
 
 --crOnSeg :: Point2 -> Point2 -> Creature -> Bool