Work on cleaning up item effects/attachments etc

src/Dodge/Euse.hs

@@ -1,9 +1,22 @@
 module Dodge.Euse where
+
+import Dodge.LightSource
+import Dodge.Item.HeldOffset
+import Dodge.Wall.Create
+import Color
+import Dodge.Default.Wall
+import Dodge.Creature.Test
+import Dodge.Creature.HandPos
+import Geometry
+import Dodge.Wall.Move
+import Dodge.Wall.Delete
+import Dodge.Wall.ForceField
+import Dodge.Item.Location
 import Dodge.Data
 import Dodge.Item.Weapon.ExtraEffect
 import Dodge.Item.Weapon.Radar
 import Dodge.SoundLogic.ExternallyGeneratedSounds
-import Dodge.Item.Equipment
+import qualified IntMapHelp as IM
 import LensHelp
 
 useE :: Euse -> Item -> Creature -> World -> World
@@ -14,7 +27,108 @@ useE eo = case eo of
     EWristShield -> setWristShieldPos
     EHeadLamp -> createHeadLamp
     ECamouflage vis -> overCID (crCamouflage .~ vis)
-
     EonWristShield -> onEquipWristShield
-
     EoffWristShield -> onRemoveWristShield
+
+useMagShield :: Item -> Creature -> World -> World
+useMagShield it cr w = w & cWorld . magnets . at mgid ?~ themagnet
+  where
+    themagnet =
+        Magnet
+            { _mgID = mgid
+            , _mgUpdate = MagnetUpdateTimer 1
+            , _mgPos = _crPos cr
+            , _mgField = MagnetBuBuCurveAroundField 50 200
+            }
+    mgid = case it ^? itParams . magShieldMgMIX . _Just of
+        Just mgid' -> mgid'
+        Nothing -> IM.newKey $ _magnets (_cWorld w)
+
+onEquipWristShield :: Item -> Creature -> World -> World
+onEquipWristShield itm cr w =
+    w
+        & pointerToItem itm . itUse . eqEq . eqParams .~ EquipID i
+        & cWorld . walls . at i ?~ forceField{_wlID = i}
+        & setWristShieldPos (itm & itUse . eqEq . eqParams .~ EquipID i) cr
+  where
+    i = IM.newKey (_walls (_cWorld w))
+
+onRemoveWristShield :: Item -> Creature -> World -> World
+onRemoveWristShield itm _ =
+    (pointerToItem itm . itUse . eqEq . eqParams .~ NoEquipParams) . deleteWallID i
+  where
+    i = _eparamID $ _eqParams $ _eqEq $ _itUse itm
+
+setWristShieldPos :: Item -> Creature -> World -> World
+setWristShieldPos itm cr w =
+    w
+        & moveWallIDUnsafe i wlline
+  where
+    i = _eparamID $ _eqParams $ _eqEq $ _itUse itm
+    wlline = (f (V3 (-10) 7 0), f (V3 10 7 0))
+    invid = _ipInvID (_itLocation itm)
+    handtrans = case cr ^? crInvEquipped . ix invid of
+        Just OnLeftWrist -> \cr' -> translatePointToLeftHand cr' . g
+        _ -> translatePointToRightHand
+    g
+        | twists cr = (+.+.+ V3 (-5) 10 0)
+        | otherwise = id
+    f = (+.+ _crPos cr) . stripZ . rotate3 (_crDir cr) . handtrans cr
+
+shieldWall :: Int -> Wall
+shieldWall crid =
+    defaultWall
+        { _wlColor = yellow
+        , _wlOpacity = SeeAbove
+        , _wlPathable = True
+        , _wlWalkable = True
+        , _wlFireThrough = True
+        , _wlReflect = True
+        , _wlUnshadowed = False
+        , _wlRotateTo = False
+        , _wlStructure = CreaturePart crid -- shieldWallDamage
+        }
+
+-- TODO the reflection should be controled by the particle
+--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
+
+createShieldWall :: Item -> Creature -> World -> World
+createShieldWall it cr w = case it ^? itParams . flatShieldWlMIX . _Just of
+    Nothing ->
+        let (wlid, w') = createWall ((shieldWall crid){_wlLine = wlline, _wlID = wlid}) w
+         in w' & pointerToItem it . itParams .~ FlatShieldParams (Just wlid)
+    Just wid -> moveWallID wid wlline w
+  where
+    crid = _crID cr
+    wlline = (a, b)
+    crdirv = unitVectorAtAngle $ _crDir cr
+    crpos = _crPos cr
+    rad = _crRad cr + 2
+    a = crpos +.+ rad *.* crdirv -.- 10 *.* therot crdirv
+    b = crpos +.+ rad *.* crdirv +.+ 10 *.* therot crdirv
+    therot
+        | crIsAiming cr = vNormal
+        | otherwise = rotateV (twoFlatHRot cr) . vNormal
+
+removeShieldWall :: Item -> Creature -> World -> World
+removeShieldWall it _ w = case it ^? itParams . flatShieldWlMIX . _Just of
+    Nothing -> w
+    Just wid ->
+        w & deleteWallID wid
+            & pointerToItem it . itParams . flatShieldWlMIX .~ Nothing
+
+createHeadLamp :: Item -> Creature -> World -> World
+createHeadLamp _ cr =
+    cWorld . tempLightSources
+        .:~ tlsTimeRadColPos
+            1
+            200
+            0.7
+            ((_crPos cr `v2z` 0) +.+.+ rotate3 (_crDir cr) (translatePointToHead cr (V3 5 0 3)))
+
+overCID :: (Creature -> Creature) -> Item -> Creature -> World -> World
+overCID f _ cr = cWorld . creatures . ix (_crID cr) %~ f