105 lines
3.8 KiB
Haskell
105 lines
3.8 KiB
Haskell
module Dodge.Creature.Impulse.UseItem
|
|
( useItem
|
|
, useLeftItem
|
|
) where
|
|
import Dodge.Data
|
|
import Dodge.Inventory
|
|
|
|
import qualified Data.IntMap.Strict as IM
|
|
import qualified Data.IntSet as IS
|
|
import Control.Lens
|
|
import Data.Maybe
|
|
|
|
useItem :: Creature -> World -> World
|
|
useItem cr' w = fromMaybe (f w) $ do
|
|
cr <- w ^? creatures . ix (_crID cr')
|
|
it <- cr ^? crInv . ix (_crInvSel cr)
|
|
return $ itemEffect cr it w
|
|
where
|
|
f = creatures . ix (_crID cr') . crHammerPosition .~ HammerDown
|
|
|
|
itemEffect :: Creature -> Item -> World -> World
|
|
itemEffect cr it w = case it ^? itUse of
|
|
Just RightUse {_rUse = eff,_useMods = usemods}
|
|
-> hammerTest $ foldr ($) eff usemods it cr
|
|
Just LeftUse {} -> setuhamdown $ lhammer setEquipLeftItem
|
|
Just EquipUse{} -> setuhamdown $ lhammer $ toggleEquipmentAt (_crInvSel cr) it
|
|
-- ConsumeUse will cause problems if the item is not selected
|
|
Just (ConsumeUse eff) -> setuhamdown $ hammerTest $ eff it cr . rmInvItem (_crID cr) (_crInvSel cr)
|
|
Just NoUse -> setuhamdown w
|
|
Nothing -> setuhamdown w
|
|
where
|
|
hammerTest f = case _crHammerPosition cr of
|
|
HammerUp -> f w
|
|
_ -> w & setuhamdown
|
|
lhammer f' = w & case _crHammerPosition cr of
|
|
HammerUp -> creatures . ix (_crID cr) %~ f'
|
|
_ -> id
|
|
setEquipLeftItem cr' = case _crLeftInvSel cr' of
|
|
Just i | i == _crInvSel cr' -> cr' & crLeftInvSel .~ Nothing
|
|
_ -> cr' & crLeftInvSel ?~ _crInvSel cr'
|
|
setuhamdown = creatures . ix (_crID cr) . crHammerPosition .~ HammerDown
|
|
|
|
toggleEquipmentAt :: Int -> Item -> Creature -> Creature
|
|
toggleEquipmentAt invid itm cr = case cr ^? crInvEquipped . ix invid of
|
|
Just epos -> cr & crInvEquipped . at invid .~ Nothing
|
|
& crEquipment . at epos .~ Nothing
|
|
Nothing -> equipUsingSite invid itm cr
|
|
|
|
equipUsingSite :: Int -> Item -> Creature -> Creature
|
|
equipUsingSite invid itm cr = cr
|
|
& crInvEquipped . at invid .~ Just epos
|
|
& crEquipment . at epos .~ Just invid
|
|
& removeOtherEquipment
|
|
where
|
|
epos = eqSiteToPos cr (_eqSite $ _itUse itm)
|
|
removeOtherEquipment = case cr ^? crEquipment . ix epos of
|
|
Nothing -> id
|
|
Just oid -> crInvEquipped . at oid .~ Nothing
|
|
|
|
eqSiteToPos :: Creature -> EquipSite -> EquipPosition
|
|
eqSiteToPos cr es = case es of
|
|
GoesOnHead -> OnHead
|
|
GoesOnChest -> OnChest
|
|
GoesOnBack -> OnBack
|
|
GoesOnLegs -> OnLegs
|
|
GoesOnSpecial -> OnSpecial
|
|
GoesOnWrist -> case cr ^? crEquipment . ix OnLeftWrist of
|
|
Nothing -> OnLeftWrist
|
|
_ -> OnRightWrist
|
|
|
|
removeEquipmentUsingSite :: EquipSite -> Creature -> Creature
|
|
removeEquipmentUsingSite esite cr = case esite of
|
|
GoesOnSpecial -> cr
|
|
_ -> case cr ^? crEquipment . esiteToPoint of
|
|
Just invid -> cr & crInvEquipped . at invid .~ Nothing
|
|
_ -> cr
|
|
where
|
|
esiteToPoint = case esite of
|
|
GoesOnHead -> ix OnHead
|
|
GoesOnChest -> ix OnChest
|
|
GoesOnBack -> ix OnBack
|
|
GoesOnWrist -> ix OnLeftWrist
|
|
GoesOnLegs -> ix OnLegs
|
|
|
|
setEquipmentSite :: EquipSite -> Maybe Int -> Creature -> Creature
|
|
setEquipmentSite esite = case esite of
|
|
GoesOnHead -> set (crEquipment . at OnHead)
|
|
GoesOnChest -> set (crEquipment . at OnChest)
|
|
GoesOnBack -> set (crEquipment . at OnBack)
|
|
GoesOnWrist -> set (crEquipment . at OnLeftWrist)
|
|
GoesOnLegs -> set (crEquipment . at OnLegs)
|
|
GoesOnSpecial -> const id
|
|
|
|
useLeftItem :: Int -> World -> World
|
|
useLeftItem cid w
|
|
| _crInvLock cr = w
|
|
| itConsumable = useItem cr w
|
|
| otherwise = fromMaybe w $ do
|
|
invid <- _crLeftInvSel cr
|
|
f <- cr ^? crInv . ix invid . itUse . lUse
|
|
return $ f cr invid w
|
|
where
|
|
cr = _creatures w IM.! cid
|
|
itConsumable = isJust $ cr ^? crInv . ix (_crInvSel cr) . itUse . cUse
|