Move background item effects out of records

src/Dodge/Item/BackgroundEffect.hs

@@ -0,0 +1,103 @@
+module Dodge.Item.BackgroundEffect (
+    itBackgroundEffect,
+    itEffectOnPickup,
+    itEffectOnDrop,
+) where
+
+import Dodge.Inventory.SelectionList
+--import Dodge.Inventory.Path
+import Data.Maybe
+import Color
+import Dodge.Default.Wall
+import Dodge.Wall.Delete
+import Dodge.Item.HeldOffset
+import Dodge.Creature.Test
+import Geometry.Vector
+import Dodge.Wall.Move
+import Dodge.Wall.Create
+import Dodge.Item.Location
+import Dodge.Data.World
+import Control.Lens
+
+itBackgroundEffect :: Item -> Creature -> World -> World
+itBackgroundEffect itm cr w = case itm ^. itType of
+    COPIER _ -> copierItemUpdate' itm cr w
+    ITEMSCAN -> cancelExamineInventory' w
+    HELD FLATSHIELD -> rootNotrootEff' createShieldWall' removeShieldWall' itm cr w
+    HELD MINIGUNX{} ->
+        w & pointerToItem itm . itParams . wTime
+            %~ (max 0 . subtract 1)
+    _ -> w
+
+copierItemUpdate' :: Item -> Creature -> World -> World
+copierItemUpdate' itm cr w = fromMaybe w $ do
+    x <- itm ^? itScroll . itsInt
+    invid <- itm ^? itLocation . ilInvID
+    ip <- itm ^? itType . ibtPathing
+    i <- getInventoryPath x ip invid cr
+    itm' <- cr ^? crInv . ix i
+    v <- getItemValue itm' w cr
+    return $ w & pointerToItem itm . itUse . uValue .~ v
+
+cancelExamineInventory' :: World -> World
+cancelExamineInventory' = hud . hudElement . subInventory %~ f
+  where
+    f ExamineInventory = NoSubInventory
+    f x = x
+
+rootNotrootEff' ::
+    (Item -> Creature -> World -> World) ->
+    (Item -> Creature -> World -> World) ->
+    Item ->
+    Creature ->
+    World ->
+    World
+rootNotrootEff' f g it
+    | it ^? itLocation . ilIsRoot == Just True = f it
+    | otherwise = g it
+
+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
+
+itEffectOnPickup :: Item -> Creature -> World -> World
+itEffectOnPickup _ _ = id
+
+itEffectOnDrop :: Item -> Creature -> World -> World
+itEffectOnDrop itm _ w = case itm ^. itType of
+    HELD MINIGUNX{} -> w & pointerToItemID (_itID itm) . itParams . wTime .~ 0
+    _ -> w
+
+shieldWall' :: Int -> Wall
+shieldWall' crid =
+    defaultWall
+        { _wlColor = yellow
+        , _wlOpacity = SeeAbove
+        , _wlPathable = True
+        , _wlWalkable = True
+        , _wlFireThrough = True
+        , _wlReflect = True
+        , _wlRotateTo = False
+        , _wlStructure = CreaturePart crid -- shieldWallDamage
+        }

src/Dodge/Item/Held/Cane.hs

@@ -60,6 +60,6 @@ miniGunX i =
 --            .~ replicate i 
 --                (Muzzle (V2 30 0) 0 0.05 0 MiniGunFlare MuzzleShootBullet (UseExactly 1) 0)
         & itType .~ HELD (MINIGUNX i)
-        & itEffect . ieInv .~ ItemReduceWarmTime
-        & itEffect . ieOnDrop .~ ItemSetWarmTime 0
+--        & itEffect . ieInv .~ ItemReduceWarmTime
+--        & itEffect . ieOnDrop .~ ItemSetWarmTime 0
         & itParams .~ WarmTime 0

src/Dodge/Item/Held/Utility.hs

@@ -18,7 +18,7 @@ import Dodge.Default.Item
 flatShield :: Item
 flatShield =
     defaultHeldItem
-        & itEffect . ieInv .~ EffectRootNotroot CreateShieldWall RemoveShieldWall
+--        & itEffect . ieInv .~ EffectRootNotroot CreateShieldWall RemoveShieldWall
         & itType .~ HELD FLATSHIELD
 
 keyCard :: Int -> Item

src/Dodge/Item/MaxAmmo.hs

@@ -0,0 +1,17 @@
+module Dodge.Item.MaxAmmo (maxAmmo) where
+
+import Control.Lens
+import Dodge.Data.Item
+
+maxAmmo :: Item -> Maybe Int
+maxAmmo itm = case itm ^. itType of
+    EQUIP BATTERYPACK -> Just $ 10 ^ (9 :: Int)
+    AMMOMAG BATTERY -> Just $ 10 ^ (6 :: Int)
+    AMMOMAG TINMAG -> Just 15
+    AMMOMAG DRUMMAG -> Just 30
+    AMMOMAG BELTMAG -> Just 90
+    AMMOMAG CHEMFUELPOUCH -> Just $ 10 ^ (6 :: Int)
+    AMMOMAG SHELLMAG -> Just 1
+    EQUIP BULLETBELTPACK -> Just 10000
+    EQUIP BULLETBELTBRACER -> Just 1000
+    _ -> Nothing

src/Dodge/Item/Scope.hs

@@ -65,7 +65,7 @@ itemScan =
     defaultHeldItem
         & itType .~ ITEMSCAN
         & itUse .~ UseNothing
-        & itEffect . ieOnDrop .~ ItemCancelExamineInventory
+--        & itEffect . ieOnDrop .~ ItemCancelExamineInventory
 
 mapper :: Item
 mapper =
@@ -91,7 +91,7 @@ copier x =
         & itType .~ COPIER x
         & itUse .~ UseValue (Left 0)
         & itScroll .~ ItemScrollInt 0
-        & itEffect . ieInv .~ ItemCopierUpdate
+        -- & itEffect . ieInv .~ ItemCopierUpdate
 
 nulgate :: Item
 nulgate =