Move item effect functions

src/Dodge/Item/Equipment.hs

@@ -22,9 +22,11 @@ module Dodge.Item.Equipment
     , overCID
     , onEquipWristShield
     , onRemoveWristShield
+
+    , createShieldWall
+    , removeShieldWall
     ) where
 import Dodge.Data
-import Dodge.LightSource.Torch
 import Dodge.Item.Draw
 import Dodge.Item.Equipment.Booster
 import Dodge.LightSource
@@ -38,7 +40,8 @@ import Picture
 import Geometry
 import qualified IntMapHelp as IM
 import LensHelp
---import ShortShow
+
+import Data.Maybe
 
 magShield :: Item
 magShield = defaultEquipment
@@ -116,22 +119,14 @@ setWristShieldPos itm cr w = w
 
 torch :: Item
 torch = defaultWeapon
-    & itEffect .~ effectOnOffHeld createHeldLight (const $ const id)
+    & itEffect .~ effectOnOffHeld CreateHeldLight NoInvEffect-- createHeldLight (const $ const id)
     & itType . iyBase .~ HELD TORCH
     & itUse . useAim . aimHandlePos .~ 5
     & itUse . useAim . aimMuzPos .~ 10
 
-createHeldLight :: Creature -> Int -> World -> World
-createHeldLight cr i = createTorchLightOffset cr itm 0
---     tempLightSources .:~ tlsTimeRadColPos 1 250 0.7 
---        (p +.+.+ rotate3 (_crDir cr) (heldItemOffset itm cr (V3 8 0 1.5)))
-  where
---    p = addZ 0 $ _crPos cr
-    itm = cr ^?! crInv . ix i
-
 flatShield :: Item
 flatShield = defaultWeapon
-    & itEffect .~ effectOnOffHeld createShieldWall removeShieldWall
+    & itEffect .~ effectOnOffHeld CreateShieldWall RemoveShieldWall --createShieldWall removeShieldWall
         -- the above seems to work, but I am not sure why: it may break on edge
         -- cases
     & itUse .~ defaultrUse
@@ -171,14 +166,14 @@ shieldWall crid = defaultWall
 --    _ | isMovementDam dm -> w & creatures . ix crid . crState . crDamage .:~ dm
 --    _ -> w
 
-createShieldWall :: Creature -> Int -> World -> World
-createShieldWall cr invid w = case _ieMID $ _itEffect it of
+createShieldWall :: Item -> Creature -> World -> World
+createShieldWall it cr w = case _ieMID $ _itEffect it of
     Nothing -> let (wlid,w') = createWall ((shieldWall crid) {_wlLine = wlline,_wlID = wlid}) w
         in w' & creatures . ix crid . crInv . ix invid . itEffect . ieMID ?~ wlid
     Just wid -> moveWallID wid wlline w
   where
+    invid = fromJust $ _itID it
     crid = _crID cr
-    it = _crInv (_creatures w IM.! crid) IM.! invid
     wlline = (a,b)
     crdirv = unitVectorAtAngle $ _crDir cr
     crpos = _crPos cr
@@ -187,29 +182,23 @@ createShieldWall cr invid w = case _ieMID $ _itEffect it of
     b = crpos +.+ rad *.* crdirv +.+ 10 *.* therot crdirv
     therot  | crIsAiming cr = vNormal
             | otherwise = rotateV (twoFlatHRot cr) . vNormal
-removeShieldWall :: Creature -> Int -> World -> World
-removeShieldWall cr invid w = case _ieMID $ _itEffect it of
+removeShieldWall :: Item -> Creature -> World -> World
+removeShieldWall it cr w = case _ieMID $ _itEffect it of
     Nothing -> w
     Just wid -> w & deleteWallID wid 
         & creatures . ix crid . crInv . ix invid . itEffect . ieMID .~ Nothing
   where
     crid = _crID cr
-    it = _crInv (_creatures w IM.! crid) IM.! invid
+    invid = fromJust (_itID it)
 
 effectOnOffHeld 
-    :: (Creature -> Int -> World -> World)     -- ^ effect when held
-    -> (Creature -> Int -> World -> World)     -- ^ effect when not held
+    :: ItInvEffect     -- ^ effect when held
+    -> ItInvEffect     -- ^ effect when not held
     -> ItEffect
 effectOnOffHeld f f' = ItInvEffectID
-    { _ieInv = g
+    { _ieInv = OnOffHeldEffect f f'
     , _ieMID = Nothing
     }
-  where
-    g itm cr w
-        | crSel cr == invid = f  cr invid w
-        | otherwise         = f' cr invid w
-      where
-        invid = _ipInvID $ _itPos itm
 
 {- | Increases speed, reduces friction, cannot only move forwards. -}
 jetPack :: Item