loop/src/Dodge/Creature/Impulse/UseItem.hs

module Dodge.Creature.Impulse.UseItem (
    useRootItem,
    useItemLeftClick,
    itemUseEffect,
    useItemHotkey,
) where

import Dodge.SelectUse
import Dodge.Item.Grammar
import Dodge.Data.ComposedItem
import Dodge.Data.DoubleTree
import Control.Lens
import Control.Monad
import Data.Maybe
import Dodge.Cuse
import Dodge.Data.World
import Dodge.Euse
import Dodge.HeldUse
import Dodge.Hotkey
import Dodge.Inventory
import Dodge.Item.Location
import Dodge.Luse
import qualified IntMapHelp as IM

useRootItem :: Int -> World -> World
useRootItem crid w = fromMaybe w $ do
        cr <- w ^? cWorld . lWorld . creatures . ix crid
        itRef <- cr ^? crManipulation . manObject . imRootItem
        it <- invRootTrees (_crInv cr) ^? ix itRef
        return $
            itemUseEffect' cr it w
                & worldEventFlags . at InventoryChange ?~ ()

itemUseEffect' :: Creature -> LabelDoubleTree ItemLink ComposedItem -> World -> World
itemUseEffect' cr itmtree w = case itmtree ^. ldtValue . cItemFunction  of
    WeaponPlatformSF -> heldEffect (bimap _iatType _cItem itmtree) cr w
            & pointerToItem itm . itUse . heldHammer .~ HammerDown
    _ -> w
--    UseHotkey{} -> doequipmentchange
--    UseEquip{} -> doequipmentchange
--    (UseConsume eff) -> useC eff (_ldtValue itmtree) cr w
--    UseCraft{} -> w
--    UseAttach{} -> selectUse itmtree cr  w
--    UseAmmoMag{} -> w
--    UseScope{} -> w
--    UseBulletMod{} -> w
  where
    itm :: Item
    itm = itmtree ^. ldtValue . cItem
--    doequipmentchange = fromMaybe w $ do
--        guard (_crHammerPosition cr == HammerUp)
--        invid <- itm ^? itLocation . ilInvID
--        return $ toggleEquipmentAt invid cr w


itemUseEffect :: Creature -> LabelDoubleTree ComposeLinkType Item -> World -> World
itemUseEffect cr itmtree w = case itmtree ^. ldtValue . itUse of
    UseHeld{} -> heldEffect itmtree cr w
            & pointerToItem itm . itUse . heldHammer .~ HammerDown
    UseHotkey{} -> doequipmentchange
    UseEquip{} -> doequipmentchange
    (UseConsume eff) -> useC eff (_ldtValue itmtree) cr w
    UseCraft{} -> w
    UseAttach{} -> selectUse itmtree cr  w
    UseAmmoMag{} -> w
    UseScope{} -> w
    UseBulletMod{} -> w
  where
    itm = itmtree ^. ldtValue
    doequipmentchange = fromMaybe w $ do
        guard (_crHammerPosition cr == HammerUp)
        invid <- itm ^? itLocation . ilInvID
        return $ toggleEquipmentAt invid cr w

toggleEquipmentAt :: Int -> Creature -> World -> World
toggleEquipmentAt invid cr w = case getEquipmentAllocation w of
    DoNotMoveEquipment -> w
    PutOnEquipment{_allocNewPos = newp} ->
        w
            & crpoint . crEquipment . at newp ?~ invid
            & crpoint . crInvEquipped . at invid ?~ newp
            & onequip itm cr
            & crpoint %~ assignNewHotkey invid
    MoveEquipment{_allocNewPos = newp, _allocOldPos = oldp} ->
        w
            & crpoint . crEquipment . at newp ?~ invid
            & crpoint . crEquipment . at oldp .~ Nothing
            & crpoint . crInvEquipped . at invid ?~ newp
    SwapEquipment{_allocNewPos = newp, _allocOldPos = oldp, _allocSwapID = sid} ->
        w
            & crpoint . crEquipment . at newp ?~ invid
            & crpoint . crEquipment . at oldp ?~ sid
            & crpoint . crInvEquipped . at invid ?~ newp
            & crpoint . crInvEquipped . at sid ?~ oldp
    ReplaceEquipment{_allocNewPos = newp, _allocRemoveID = rid} ->
        w
            & crpoint . crEquipment . at newp ?~ invid
            & crpoint . crInvEquipped . at invid ?~ newp
            & crpoint . crInvEquipped . at rid .~ Nothing
            & onremove (itmat rid) cr
            & onequip itm cr
            & crpoint %~ removeHotkey rid
            & crpoint %~ assignNewHotkey invid
    RemoveEquipment{_allocOldPos = oldp} ->
        w
            & crpoint . crEquipment . at oldp .~ Nothing
            & crpoint . crInvEquipped . at invid .~ Nothing
            & onremove itm cr
            & crpoint %~ removeHotkey invid
  where
    crpoint = cWorld . lWorld . creatures . ix (_crID cr)
    itmat i = _crInv cr IM.! i
    itm = itmat itRef
    itRef = cr ^?! crManipulation . manObject . imSelectedItem -- unsafe!! TODO change?
    onequip itm' = useE ((_eeOnEquip . _uequipEffect . _itUse) itm') itm'
    onremove itm' = useE ((_eeOnRemove . _uequipEffect . _itUse) itm') itm'

-- need to make sure that the root item is not erroneously selected in the
-- following
useItemLeftClick :: Creature -> World -> World
useItemLeftClick cr w = fromMaybe w $ do
    guard . not $ _crInvLock cr
    invid <- cr ^? crManipulation . manObject . imSelectedItem
    ituse <- cr ^? crInv . ix invid . itUse
    case ituse of
        UseHeld{} -> return w
        UseConsume{} -> return $ useItemLeftClick' cr w
        UseEquip{} -> return $ useItemLeftClick' cr w
        UseHotkey{} -> return $ useItemLeftClick' cr w
        UseAmmoMag{} -> return w
        _ -> Nothing

useItemLeftClick' :: Creature -> World -> World
useItemLeftClick' cr' w = fromMaybe w $ do
    cr <- w ^? cWorld . lWorld . creatures . ix (_crID cr')
    itRef <- cr ^? crManipulation . manObject . imSelectedItem
    it <- invTrees (_crInv cr) ^? ix itRef
    return $
        itemUseEffect cr it w
            & worldEventFlags . at InventoryChange ?~ ()
--            & f
--  where
--    f = cWorld . lWorld . creatures . ix (_crID cr') . crHammerPosition .~ HammerDown

useItemHotkey :: Int -> Int -> World -> World
useItemHotkey crid invid w = fromMaybe w $ do
    cr <- w ^? cWorld . lWorld . creatures . ix crid
    itm <- cr ^? crInv . ix invid
    luse <- itm ^? itUse . leftUse
    return $
        w
            & cWorld . lWorld . creatures . ix crid . crInv . ix invid . itUse . leftHammer .~ HammerDown
            & useL luse itm cr

-- TODO determine itmShouldBeUsed with reference to config options