Cleanup

src/Dodge/Item/Equipment.hs

@@ -1,109 +1,120 @@
-module Dodge.Item.Equipment 
-    ( module Dodge.Item.Equipment.Booster
-    , torch
-    , magShield
-    , powerLegs
-    , flatShield
-    , wristInvisibility
-    , wristArmour
-    , hat
-    , brainHat
-    , frontArmour
-    , headLamp
-    , headLamp1
-    , jetPack
-    , speedLegs
-    , jumpLegs
-    , flameShield
+module Dodge.Item.Equipment (
+    module Dodge.Item.Equipment.Booster,
+    torch,
+    magShield,
+    powerLegs,
+    flatShield,
+    wristInvisibility,
+    wristArmour,
+    hat,
+    brainHat,
+    frontArmour,
+    headLamp,
+    headLamp1,
+    jetPack,
+    speedLegs,
+    jumpLegs,
+    flameShield,
+    useMagShield,
+    setWristShieldPos,
+    createHeadLamp,
+    overCID,
+    onEquipWristShield,
+    onRemoveWristShield,
+    createShieldWall,
+    removeShieldWall,
+) where
 
-    , useMagShield
-    , setWristShieldPos
-    , createHeadLamp
-    , overCID
-    , onEquipWristShield
-    , onRemoveWristShield
-
-    , createShieldWall
-    , removeShieldWall
-    ) where
-import Dodge.Data
-import Dodge.Item.Draw
-import Dodge.Item.Equipment.Booster
-import Dodge.LightSource
-import Dodge.Default
-import Dodge.Creature.Test
+import Data.Maybe
 import Dodge.Creature.HandPos
+import Dodge.Creature.Test
+import Dodge.Data
+import Dodge.Default
+import Dodge.Item.Equipment.Booster
+import Dodge.Item.HeldOffset
+import Dodge.LightSource
 import Dodge.Wall
 import Dodge.Wall.ForceField
-import Picture
 import Geometry
 import qualified IntMapHelp as IM
 import LensHelp
-
-import Data.Maybe
+import Picture
 
 magShield :: Item
-magShield = defaultEquipment
-    { _itID = Nothing
-    , _itAttachment = AttachMInt Nothing
-    }
-    & itUse . eqEq . eqUse .~ EMagShield --useMagShield 
-    & itUse . eqEq . eqSite .~ GoesOnWrist
-    & itType . iyBase .~ EQUIP MAGSHIELD
+magShield =
+    defaultEquipment
+        { _itID = Nothing
+        , _itAttachment = AttachMInt Nothing
+        }
+        & itUse . eqEq . eqUse .~ EMagShield --useMagShield
+        & itUse . eqEq . eqSite .~ GoesOnWrist
+        & itType . iyBase .~ EQUIP MAGSHIELD
+
 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
-        }
+    themagnet =
+        Magnet
+            { _mgID = mgid
+            , _mgUpdate = MagnetUpdateTimer 1
+            , _mgPos = _crPos cr
+            , _mgField = MagnetBuBuCurveAroundField 50 200
+            }
     mgid = case it ^? itAttachment . atMInt . _Just of
         Just mgid' -> mgid'
         Nothing -> IM.newKey $ _magnets (_cWorld w)
+
 --    it = _crInv cr IM.! invid
 
-flameShield :: Item 
-flameShield = defaultEquipment
-    { _itID = Nothing
-    } & itUse . eqEq . eqSite .~ GoesOnChest
-    & itType . iyBase .~ EQUIP FLAMESHIELD
-{- | Slows you down, blocks forward projectiles. -}
+flameShield :: Item
+flameShield =
+    defaultEquipment
+        { _itID = Nothing
+        }
+        & itUse . eqEq . eqSite .~ GoesOnChest
+        & itType . iyBase .~ EQUIP FLAMESHIELD
+
+-- | Slows you down, blocks forward projectiles.
 frontArmour :: Item
-frontArmour = defaultEquipment
-    {  _itID = Nothing
-    }
-    & itUse . eqEq . eqSite .~ GoesOnChest
-    & itType . iyBase .~ EQUIP FRONTARMOUR
+frontArmour =
+    defaultEquipment
+        { _itID = Nothing
+        }
+        & itUse . eqEq . eqSite .~ GoesOnChest
+        & itType . iyBase .~ EQUIP FRONTARMOUR
 
 wristArmour :: Item
-wristArmour = defaultEquipment
-    {_itID = Nothing
-    }
-    & itUse . eqEq . eqSite .~ GoesOnWrist
-    & itUse . eqEq . eqOnEquip .~ EonWristShield --onEquipWristShield
-    & itUse . eqEq . eqUse .~ EWristShield --setWristShieldPos
-    & itUse . eqEq . eqOnRemove .~ EoffWristShield --onRemoveWristShield
-    & itType . iyBase .~ EQUIP WRISTARMOUR
+wristArmour =
+    defaultEquipment
+        { _itID = Nothing
+        }
+        & itUse . eqEq . eqSite .~ GoesOnWrist
+        & itUse . eqEq . eqOnEquip .~ EonWristShield --onEquipWristShield
+        & itUse . eqEq . eqUse .~ EWristShield --setWristShieldPos
+        & itUse . eqEq . eqOnRemove .~ EoffWristShield --onRemoveWristShield
+        & itType . iyBase .~ EQUIP WRISTARMOUR
 
 onEquipWristShield :: Item -> Creature -> World -> World
-onEquipWristShield itm cr w = w
-    & cWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID (_itPos itm)) . itUse . eqEq . eqParams .~ EquipID i
-    & cWorld . walls . at i ?~ forceField {_wlID = i}
-    & setWristShieldPos (itm & itUse . eqEq . eqParams .~ EquipID i) cr
+onEquipWristShield itm cr w =
+    w
+        & cWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID (_itPos 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 cr w = w
-    & cWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID (_itPos itm)) . itUse . eqEq . eqParams .~ NoEquipParams
-    & deleteWallID i
+onRemoveWristShield itm cr w =
+    w
+        & cWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID (_itPos 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
+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))
@@ -112,160 +123,185 @@ setWristShieldPos itm cr w = w
     handtrans = case cr ^? crInvEquipped . ix invid of
         Just OnLeftWrist -> \cr' -> translatePointToLeftHand cr' . g
         _ -> translatePointToRightHand
-    g | twists cr = (+.+.+ V3 (-5) 10 0)
-      | otherwise = id
+    g
+        | twists cr = (+.+.+ V3 (-5) 10 0)
+        | otherwise = id
     f = (+.+ _crPos cr) . stripZ . rotate3 (_crDir cr) . handtrans cr
 
 torch :: Item
-torch = defaultWeapon
-    & itEffect .~ effectOnOffHeld CreateHeldLight NoInvEffect-- createHeldLight (const $ const id)
-    & itType . iyBase .~ HELD TORCH
-    & itUse . useAim . aimHandlePos .~ 5
-    & itUse . useAim . aimMuzPos .~ 10
+torch =
+    defaultWeapon
+        & itEffect .~ effectOnOffHeld CreateHeldLight NoInvEffect -- createHeldLight (const $ const id)
+        & itType . iyBase .~ HELD TORCH
+        & itUse . useAim . aimHandlePos .~ 5
+        & itUse . useAim . aimMuzPos .~ 10
 
 flatShield :: Item
-flatShield = defaultWeapon
-    & 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
-        { _rUse = HeldDoNothing
-        , _useDelay = NoDelay
-        , _useMods = HeldModNothing
-        , _useHammer = HammerUp
-        , _useAim = AimParams
-            { _aimWeight = 5
-            , _aimRange = 0
-            , _aimZoom = ItZoom 20 0.2 1
-            , _aimStance = TwoHandFlat
-            , _aimHandlePos = 0
-            , _aimMuzPos = 0
-            }
-        }
-    & itInvSize .~ 3
-    & itType . iyBase .~ HELD FLATSHIELD
+flatShield =
+    defaultWeapon
+        & itEffect .~ effectOnOffHeld CreateShieldWall RemoveShieldWall
+        & itUse
+            .~ defaultrUse
+                { _useAim =
+                    AimParams
+                        { _aimWeight = 5
+                        , _aimRange = 0
+                        , _aimZoom = ItZoom 20 0.2 1
+                        , _aimStance = TwoHandFlat
+                        , _aimHandlePos = 0
+                        , _aimMuzPos = 0
+                        }
+                }
+        & itInvSize .~ 3
+        & itType . iyBase .~ HELD FLATSHIELD
 
 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
-    }
+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 
+----    Lasering -> w
 --    _ | isMovementDam dm -> w & creatures . ix crid . crState . crDamage .:~ dm
 --    _ -> w
 
 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' & cWorld . creatures . ix crid . crInv . ix invid . itEffect . ieMID ?~ wlid
+createShieldWall it cr w = case it ^? itEffect . ieMID . _Just of
+    Nothing ->
+        let (wlid, w') = createWall ((shieldWall crid){_wlLine = wlline, _wlID = wlid}) w
+         in w' & cWorld . creatures . ix crid . crInv . ix invid . itEffect . ieMID ?~ wlid
     Just wid -> moveWallID wid wlline w
   where
     invid = fromJust $ _itID it
     crid = _crID cr
-    wlline = (a,b)
+    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
+    therot
+        | crIsAiming cr = vNormal
+        | otherwise = rotateV (twoFlatHRot cr) . vNormal
+
 removeShieldWall :: Item -> Creature -> World -> World
 removeShieldWall it cr w = case _ieMID $ _itEffect it of
     Nothing -> w
-    Just wid -> w & deleteWallID wid 
-        & cWorld . creatures . ix crid . crInv . ix invid . itEffect . ieMID .~ Nothing
+    Just wid ->
+        w & deleteWallID wid
+            & cWorld . creatures . ix crid . crInv . ix invid . itEffect . ieMID .~ Nothing
   where
     crid = _crID cr
     invid = fromJust (_itID it)
 
-effectOnOffHeld 
-    :: ItInvEffect     -- ^ effect when held
-    -> ItInvEffect     -- ^ effect when not held
-    -> ItEffect
-effectOnOffHeld f f' = ItInvEffectID
-    { _ieInv = OnOffHeldEffect f f'
-    , _ieMID = Nothing
-    }
+effectOnOffHeld ::
+    -- | effect when held
+    ItInvEffect ->
+    -- | effect when not held
+    ItInvEffect ->
+    ItEffect
+effectOnOffHeld f f' =
+    ItInvEffectID
+        { _ieInv = OnOffHeldEffect f f'
+        , _ieMID = Nothing
+        }
 
-{- | Increases speed, reduces friction, cannot only move forwards. -}
+-- | Increases speed, reduces friction, cannot only move forwards.
 jetPack :: Item
-jetPack = defaultEquipment
-    { _itEffect = NoItEffect
-    , _itID = Nothing
-    }   & itUse . eqEq . eqSite .~ GoesOnBack
-    & itType . iyBase .~ EQUIP JETPACK
+jetPack =
+    defaultEquipment
+        { _itEffect = NoItEffect
+        , _itID = Nothing
+        }
+        & itUse . eqEq . eqSite .~ GoesOnBack
+        & itType . iyBase .~ EQUIP JETPACK
 
 brainHat :: Item
-brainHat = defaultEquipment
-    { _itEffect = NoItEffect
-    , _itID = Nothing
-    }
-    & itUse . eqEq . eqSite .~ GoesOnHead
-    & itType . iyBase .~ EQUIP BRAINHAT
+brainHat =
+    defaultEquipment
+        { _itEffect = NoItEffect
+        , _itID = Nothing
+        }
+        & itUse . eqEq . eqSite .~ GoesOnHead
+        & itType . iyBase .~ EQUIP BRAINHAT
+
 hat :: Item
-hat = defaultEquipment
-    { _itEffect = NoItEffect
-    , _itID = Nothing
-    }
-    & itUse . eqEq . eqSite .~ GoesOnHead
-    & itType . iyBase .~ EQUIP HAT
+hat =
+    defaultEquipment
+        { _itEffect = NoItEffect
+        , _itID = Nothing
+        }
+        & itUse . eqEq . eqSite .~ GoesOnHead
+        & itType . iyBase .~ EQUIP HAT
 
 headLamp1 :: Item
-headLamp1 = defaultEquipment
-    { _itEffect = NoItEffect
-    , _itID = Nothing
-    }
-    & itUse . eqEq . eqUse .~ EHeadLamp --createHeadLamp
-    & itUse . eqEq . eqSite .~ GoesOnHead
-    & itType . iyBase .~ EQUIP HEADLAMP1
-headLamp :: Item
-headLamp = defaultEquipment
-    { _itEffect = NoItEffect
-    , _itID = Nothing
-    }
-    & itUse . eqEq . eqUse .~ EHeadLamp --createHeadLamp
-    & itUse . eqEq . eqSite .~ GoesOnHead
-    & itType . iyBase .~ EQUIP HEADLAMP
+headLamp1 =
+    defaultEquipment
+        { _itEffect = NoItEffect
+        , _itID = Nothing
+        }
+        & itUse . eqEq . eqUse .~ EHeadLamp --createHeadLamp
+        & itUse . eqEq . eqSite .~ GoesOnHead
+        & itType . iyBase .~ EQUIP HEADLAMP1
 
+headLamp :: Item
+headLamp =
+    defaultEquipment
+        { _itEffect = NoItEffect
+        , _itID = Nothing
+        }
+        & itUse . eqEq . eqUse .~ EHeadLamp --createHeadLamp
+        & itUse . eqEq . eqSite .~ GoesOnHead
+        & itType . iyBase .~ EQUIP HEADLAMP
 
 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)))
+createHeadLamp _ cr =
+    cWorld . tempLightSources
+        .:~ tlsTimeRadColPos
+            1
+            200
+            0.7
+            ((_crPos cr `v2z` 0) +.+.+ rotate3 (_crDir cr) (translatePointToHead cr (V3 5 0 3)))
 
 powerLegs :: Item
-powerLegs = defaultEquipment
-    { _itEffect = NoItEffect
-    , _itID = Nothing
-    }
-    & itUse . eqEq . eqSite .~ GoesOnLegs
-    & itType . iyBase .~ EQUIP POWERLEGS
+powerLegs =
+    defaultEquipment
+        { _itEffect = NoItEffect
+        , _itID = Nothing
+        }
+        & itUse . eqEq . eqSite .~ GoesOnLegs
+        & itType . iyBase .~ EQUIP POWERLEGS
+
 speedLegs :: Item
-speedLegs = powerLegs
-    & itType . iyBase .~ EQUIP SPEEDLEGS
+speedLegs =
+    powerLegs
+        & itType . iyBase .~ EQUIP SPEEDLEGS
+
 jumpLegs :: Item
-jumpLegs = powerLegs
-    & itType . iyBase .~ EQUIP JUMPLEGS
+jumpLegs =
+    powerLegs
+        & itType . iyBase .~ EQUIP JUMPLEGS
 
 wristInvisibility :: Item
-wristInvisibility = defaultEquipment
-    { _itID = Nothing
-    }
-    & itUse . eqEq . eqSite .~ GoesOnWrist
-    & itUse . eqEq . eqOnEquip  .~ ECamouflage Invisible --overCID (crCamouflage .~ Invisible)
-    & itUse . eqEq . eqOnRemove .~ ECamouflage FullyVisible --overCID (crCamouflage .~ FullyVisible)
-    & itType . iyBase .~ EQUIP (INVISIBILITYEQUIPMENT GoesOnWrist)
+wristInvisibility =
+    defaultEquipment
+        { _itID = Nothing
+        }
+        & itUse . eqEq . eqSite .~ GoesOnWrist
+        & itUse . eqEq . eqOnEquip .~ ECamouflage Invisible --overCID (crCamouflage .~ Invisible)
+        & itUse . eqEq . eqOnRemove .~ ECamouflage FullyVisible --overCID (crCamouflage .~ FullyVisible)
+        & itType . iyBase .~ EQUIP (INVISIBILITYEQUIPMENT GoesOnWrist)
 
 overCID :: (Creature -> Creature) -> Item -> Creature -> World -> World
 overCID f _ cr = cWorld . creatures . ix (_crID cr) %~ f