94 lines
3.6 KiB
Haskell
94 lines
3.6 KiB
Haskell
{-# LANGUAGE LambdaCase #-}
|
|
|
|
module Dodge.ItEffect (
|
|
doInvEffect,
|
|
) where
|
|
|
|
import Control.Lens
|
|
import Data.Maybe
|
|
import Dodge.BlBl
|
|
import Dodge.Data.World
|
|
import Dodge.Euse
|
|
import Dodge.Inventory.Path
|
|
import Dodge.Inventory.SelectionList
|
|
import Dodge.Item.Location
|
|
|
|
doInvEffect :: ItInvEffect -> Item -> Creature -> World -> World
|
|
doInvEffect = \case
|
|
NoInvEffect -> const $ const id
|
|
EffectRootNotroot f g -> rootNotrootEff f g
|
|
CreateShieldWall -> createShieldWall
|
|
RemoveShieldWall -> removeShieldWall
|
|
EffectWhileRoot f -> rootNotrootEff f NoInvEffect
|
|
EffectWhileAttached f -> effectWhileAttached f
|
|
ItemUseToggle f -> \itm _ ->
|
|
pointerToItemID (itm ^. itID) . itUse . useToggle %~ doBlBl f
|
|
ItemCancelExamineInventory -> \_ _ -> cancelExamineInventory
|
|
ItemCopierUpdate -> copierItemUpdate
|
|
--ItemReduceWarmTime -> \itm _ -> pointerToItem itm . itUse . heldDelay . warmTime
|
|
ItemReduceWarmTime -> \itm _ -> pointerToItem itm . itParams . wTime
|
|
%~ (max 0 . subtract 1)
|
|
-- use of pointerToItemID rather than pointerToItem because the item
|
|
-- location is changing
|
|
--ItemSetWarmTime x -> \itm _ -> pointerToItemID (_itID itm) . itUse . heldDelay . warmTime
|
|
ItemSetWarmTime x -> \itm _ -> pointerToItemID (_itID itm) . itParams . wTime
|
|
.~ x
|
|
|
|
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 :: ItInvEffect -> ItInvEffect -> Item -> Creature -> World -> World
|
|
rootNotrootEff f g it
|
|
| it ^? itLocation . ilIsRoot == Just True = doInvEffect f it
|
|
| otherwise = doInvEffect g it
|
|
|
|
effectWhileAttached :: ItInvEffect -> Item -> Creature -> World -> World
|
|
effectWhileAttached f it
|
|
| it ^? itLocation . ilIsAttached == Just True = doInvEffect f it
|
|
| otherwise = const id
|
|
|
|
--timeScrollEffect :: Item -> Creature -> World -> World
|
|
--timeScrollEffect itm _ w = w & timeFlow .~ ScrollTimeFlow
|
|
-- { _scrollSmoothing = 0
|
|
-- , _reverseAmount = itm ^?! itUse . leftConsumption . wpCharge
|
|
-- , _futureWorlds = []
|
|
-- }
|
|
|
|
--setItemCharge :: Int -> Item -> Creature -> World -> World
|
|
--setItemCharge i itm cr w =
|
|
-- w & ptrWpCharge %~ const i
|
|
-- where
|
|
-- invid = _ilInvID $ _itLocation itm
|
|
-- ptrWpCharge = cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix invid . itUse . leftConsumption . wpCharge
|
|
--
|
|
--chargeIfInInventory :: Item -> Creature -> World -> World
|
|
--chargeIfInInventory itm cr w =
|
|
-- w & ptrWpCharge %~ (min maxcharge . (+ 1))
|
|
-- where
|
|
-- invid = _ilInvID $ _itLocation itm
|
|
-- ptrWpCharge = cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix invid . itUse . leftConsumption . wpCharge
|
|
-- maxcharge = itm ^?! itUse . leftConsumption . wpMaxCharge
|
|
--
|
|
--chargeIfEquipped :: Item -> Creature -> World -> World
|
|
--chargeIfEquipped itm cr w
|
|
-- | invid `IM.member` (w ^. cWorld . lWorld . imHotkeys) = w &
|
|
-- ptrWpCharge %~ (min maxcharge . (+ 1))
|
|
-- | otherwise = w & ptrWpCharge .~ 0
|
|
-- where
|
|
-- invid = _ilInvID $ _itLocation itm
|
|
-- ptrWpCharge = cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix invid . itUse . leftConsumption . wpCharge
|
|
-- maxcharge = itm ^?! itUse . leftConsumption . wpMaxCharge
|