Move background item effects out of records

src/Dodge/Creature/Action.hs

@@ -13,6 +13,7 @@ module Dodge.Creature.Action (
     youDropItem,
 ) where
 
+import Dodge.Item.BackgroundEffect
 import Control.Applicative
 import Control.Monad
 import Data.Bifunctor
@@ -178,9 +179,10 @@ dropItem cr invid =
         . copyItemToFloor (_crPos cr) itm -- . mayberemoveequip
         . soundStart (CrSound (_crID cr)) (_crPos cr) whiteNoiseFadeOutS Nothing
   where
-    doanyitemdropeffect = fromMaybe id $ do
-        rmf <- itm ^? itEffect . ieOnDrop
-        return $ doInvEffect rmf itm cr
+    --doanyitemdropeffect = fromMaybe id $ do
+    --    rmf <- itm ^? itEffect . ieOnDrop
+    --    return $ doInvEffect rmf itm cr
+    doanyitemdropeffect = itEffectOnDrop itm cr
     itm = fromMaybe (error "dropItem cannot find item") $ cr ^? crInv . ix invid
     maybeshiftseldown w = fromMaybe w $ do
         3 <- w ^? hud . hudElement . diSelection . _Just . _1

src/Dodge/Creature/State.hs

@@ -3,6 +3,7 @@ module Dodge.Creature.State (
     doDamage,
 ) where
 
+import Dodge.Item.BackgroundEffect
 import Dodge.Item.MaxAmmo
 import Control.Applicative
 import Dodge.HeldUse
@@ -166,7 +167,8 @@ applyPastDamages cr w
 invSideEff :: Creature -> World -> World
 invSideEff cr = alaf Endo foldMap f (_crInv cr) . updateHeldRootItem cr
   where
-    f it = maybe id (\g -> doInvEffect g it cr) (it ^? itEffect . ieInv)
+    --f it = maybe id (\g -> doInvEffect g it cr) (it ^? itEffect . ieInv)
+    f it = itBackgroundEffect it cr
 
 -- a loop going over all root inventory items
 invRootItemEffs :: Creature -> World -> World
@@ -358,7 +360,6 @@ shineTorch cr itmtree (p, q) = fromMaybe id $ do
     guard $ i >= x
     invid <- mag ^? ldtValue . _1 . itLocation . ilInvID
     return $
-        --(cWorld . lWorld . tempLightSources .:~ tlsTimeRadColPos 1 250 0.7 pos'')
         (cWorld . lWorld . lights .:~ LSParam pos'' 250 0.7)
             . (cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix invid . itConsumables . _Just -~ x)
   where

src/Dodge/Data/Item.hs

@@ -42,7 +42,7 @@ data Item = Item
     , _itType :: ItemType
     , _itID :: NewInt ItmInt
     , _itLocation :: ItemLocation
-    , _itEffect :: ItEffect
+--    , _itEffect :: ItEffect
     , _itTargeting :: ItemTargeting
     , _itParams :: ItemParams
     , _itScroll :: ItemScroll

src/Dodge/Default/Item.hs

@@ -11,7 +11,7 @@ defaultHeldItem =
     Item
         { _itType = HELD PISTOL
         , _itConsumables = Nothing
-        , _itEffect = defaultItEffect
+--        , _itEffect = defaultItEffect
         , _itID = 0 -- should this return an error ? const $ error "itID not correctly initialised" ?
         , _itTargeting = NoItTargeting
         , _itLocation = InVoid

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 =