238 lines
8.6 KiB
Haskell
238 lines
8.6 KiB
Haskell
--{-# LANGUAGE TupleSections #-}
|
|
module Dodge.Inventory (
|
|
checkInvSlotsYou,
|
|
rmSelectedInvItem,
|
|
rmInvItem,
|
|
updateCloseObjects,
|
|
--closeObjScrollDir,
|
|
changeSwapSel,
|
|
scrollAugInvSel,
|
|
crNumFreeSlots,
|
|
crInvSize,
|
|
selectedCloseObject,
|
|
setInvPosFromSS,
|
|
module Dodge.Inventory.RBList
|
|
) where
|
|
|
|
import Dodge.Inventory.RBList
|
|
import Control.Applicative
|
|
import Data.Maybe
|
|
import Dodge.Base
|
|
import Dodge.Data.SelectionList
|
|
import Dodge.Data.World
|
|
import Dodge.DisplayInventory
|
|
import Dodge.Euse
|
|
import Dodge.Inventory.CheckSlots
|
|
import Dodge.Inventory.CloseObject
|
|
import Dodge.ItEffect
|
|
import Dodge.Reloading
|
|
import Dodge.SelectionSections
|
|
import Geometry
|
|
import qualified IntMapHelp as IM
|
|
import LensHelp
|
|
import ListHelp
|
|
--import Padding
|
|
|
|
-- TODO check what happens to selection index when dropping non-selected items
|
|
|
|
-- | after this the item at the inventory position will no longer exist
|
|
rmInvItem ::
|
|
-- | Creature id
|
|
Int ->
|
|
-- | Inventory position
|
|
Int ->
|
|
World ->
|
|
World
|
|
rmInvItem cid invid w = case w ^? getcid . crInv . ix invid . itUse . useAmount of
|
|
Just x
|
|
| x > 1 ->
|
|
w & pointcid . crInv . ix invid . itUse . useAmount -~ 1
|
|
& worldEventFlags . at InventoryChange ?~ ()
|
|
_ ->
|
|
w
|
|
& pointcid %~ crCancelReloading
|
|
& doanyitemeffect
|
|
& dounequipfunction --the ordering of these is
|
|
& pointcid . crInv %~ f -- important
|
|
|
|
& removeAnySlotEquipment
|
|
& pointcid . crEquipment . each %~ g
|
|
& pointcid . crInvEquipped %~ IM.delete invid
|
|
& pointcid . crInvEquipped %~ IM.mapKeys g
|
|
|
|
& removeanyactivation
|
|
& pointcid . crHotkeys . each %~ g
|
|
& pointcid . crInvHotkeys %~ IM.delete invid
|
|
& pointcid . crInvHotkeys %~ IM.mapKeys g
|
|
|
|
& updateselection
|
|
& worldEventFlags . at InventoryChange ?~ ()
|
|
where
|
|
getcid = cWorld . lWorld . creatures . ix cid
|
|
pointcid = cWorld . lWorld . creatures . ix cid
|
|
|
|
updateselection
|
|
| cid == 0 && cr ^? crManipulation . manObject . inInventory . ispItem == Just invid =
|
|
scrollAugInvSel (-1) . scrollAugInvSel 1 . updateInventorySectionItems
|
|
| otherwise =
|
|
pointcid . crManipulation . manObject . inInventory . ispItem %~ g
|
|
|
|
cr = w ^?! cWorld . lWorld . creatures . ix cid
|
|
itm = _crInv cr IM.! invid
|
|
dounequipfunction = fromMaybe id $ do
|
|
rmf <- itm ^? itUse . equipEffect . eeOnRemove
|
|
return $ useE rmf itm cr
|
|
doanyitemeffect = fromMaybe id $ do
|
|
rmf <- itm ^? itEffect . ieOnDrop
|
|
return $ doInvEffect rmf itm cr
|
|
removeAnySlotEquipment = fromMaybe id $ do
|
|
epos <- w ^? cWorld . lWorld . creatures . ix cid . crInvEquipped . ix invid
|
|
return $ pointcid . crEquipment . at epos .~ Nothing
|
|
removeanyactivation = fromMaybe id $ do
|
|
epos <- w ^? cWorld . lWorld . creatures . ix cid . crInvHotkeys . ix invid
|
|
return $ pointcid . crHotkeys . at epos .~ Nothing
|
|
maxk = fmap fst $ IM.lookupMax $ cr ^. crInv
|
|
f inv =
|
|
let (xs, ys) = IM.split invid inv
|
|
in xs `IM.union` IM.mapKeysMonotonic (subtract 1) ys
|
|
-- the following might not work if a non-player creature drops their last item
|
|
g x
|
|
| x > invid || Just x == maxk = max 0 $ x - 1
|
|
| otherwise = x
|
|
|
|
rmSelectedInvItem :: Int -> World -> World
|
|
rmSelectedInvItem cid w = case w ^? cWorld . lWorld . creatures . ix cid . crManipulation . manObject . inInventory . ispItem of
|
|
Just i -> rmInvItem cid i w
|
|
Nothing -> w
|
|
|
|
-- this looks ugly...
|
|
updateCloseObjects :: World -> World
|
|
updateCloseObjects w =
|
|
w
|
|
& hud . closeObjects .~ newcloseobjects
|
|
& updatecursorposifnecessary
|
|
where
|
|
newcloseobjects = unionBy closeObjEq oldCloseFiltered currentClose
|
|
updatecursorposifnecessary =
|
|
case w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . inNearby . ispCloseObject of
|
|
Just i
|
|
| i >= length newcloseobjects -> scrollAugInvSel 1
|
|
| isNothing (w ^? hud . hudElement . diSections . sssSections . ix 3 . ssItems . ix i) ->
|
|
scrollAugInvSel (-1)
|
|
_ -> id
|
|
filt = filter $ \obj -> dist ypos (closeObjPos obj) < 40 && hasButtonLOS ypos (closeObjPos obj) w
|
|
ypos = _crPos $ you w
|
|
activeButtons =
|
|
map Right
|
|
. filter ((/=) BtNoLabel . _btState)
|
|
. IM.elems
|
|
$ w ^. cWorld . lWorld . buttons
|
|
currentClose = filt $ map Left (IM.elems $ w ^. cWorld . lWorld . floorItems) ++ activeButtons
|
|
oldClose = filt $ mapMaybe updatebyid $ w ^. hud . closeObjects
|
|
oldCloseFiltered = intersectBy closeObjEq oldClose currentClose
|
|
updatebyid (Left flid) = fmap Left $ w ^? cWorld . lWorld . floorItems . ix (_flItID flid)
|
|
updatebyid (Right btid) = fmap Right $ w ^? cWorld . lWorld . buttons . ix (_btID btid)
|
|
|
|
|
|
--closeObjScrollDir :: Float -> World -> World
|
|
--closeObjScrollDir x
|
|
-- | x > 0 = over (hud . closeObjects) rotU
|
|
-- | x < 0 = over (hud . closeObjects) rotD
|
|
-- | otherwise = id
|
|
|
|
changeSwapSel :: Int -> World -> World
|
|
changeSwapSel yi w
|
|
| yi == 0 = w
|
|
| yi > 0 = foldr ($) w $ replicate yi (changeSwapWith $ f IM.cycleLT)
|
|
| otherwise = foldr ($) w $ replicate (negate yi) (changeSwapWith $ f IM.cycleGT)
|
|
where
|
|
f g i m = fst <$> g i m
|
|
|
|
changeSwapClose ::
|
|
(Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) ->
|
|
Int ->
|
|
World ->
|
|
World
|
|
changeSwapClose f i w = fromMaybe w $ do
|
|
ss <- w ^? hud . hudElement . diSections . sssSections . ix 3 . ssItems
|
|
k <- f i ss
|
|
return $
|
|
w
|
|
& cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . inNearby . ispCloseObject
|
|
.~ k
|
|
& hud . closeObjects %~ swapIndices i k
|
|
& hud . hudElement . diSections . sssExtra . sssSelPos . _Just . _2 .~ k
|
|
& worldEventFlags . at InventoryChange ?~ ()
|
|
|
|
changeSwapInv ::
|
|
(Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) ->
|
|
Int ->
|
|
World ->
|
|
World
|
|
changeSwapInv f i w = fromMaybe w $ do
|
|
ss <- w ^? hud . hudElement . diSections . sssSections . ix 0 . ssItems
|
|
k <- f i ss
|
|
return $
|
|
w & cWorld . lWorld . creatures . ix 0 %~ updatecreature k
|
|
& hud . hudElement . diSections . sssExtra . sssSelPos . _Just . _2 .~ k
|
|
& worldEventFlags . at InventoryChange ?~ ()
|
|
where
|
|
-- updateLeftInvSel k li
|
|
-- | i == li = k
|
|
-- | k == li = i
|
|
-- | otherwise = li
|
|
updatecreature k =
|
|
(crInv %~ IM.safeSwapKeys i k)
|
|
-- . (crLeftInvSel . lisMPos . _Just %~ updateLeftInvSel k)
|
|
. (crManipulation . manObject . inInventory . ispItem .~ k)
|
|
. (crInvEquipped %~ IM.safeSwapKeys i k)
|
|
. swapSite i k
|
|
. swapSite k i
|
|
. (crInvHotkeys %~ IM.safeSwapKeys i k)
|
|
. swapSite' i k
|
|
. swapSite' k i
|
|
cr = you w
|
|
swapSite a b = case cr ^? crInvEquipped . ix a of
|
|
Just epos -> crEquipment . ix epos .~ b
|
|
Nothing -> id
|
|
swapSite' a b = case cr ^? crInvHotkeys . ix a of
|
|
Just epos -> crHotkeys . ix epos .~ b
|
|
Nothing -> id
|
|
|
|
changeSwapWith :: (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) -> World -> World
|
|
changeSwapWith f w = case w ^? hud . hudElement . diSections . sssExtra . sssSelPos . _Just of
|
|
Just (0, i) -> w & changeSwapInv f i
|
|
Just (3, i) -> w & changeSwapClose f i
|
|
_ -> w
|
|
|
|
scrollAugInvSel :: Int -> World -> World
|
|
scrollAugInvSel yi w
|
|
| yi == 0 = w
|
|
| otherwise =
|
|
w & hud . hudElement . diSections %~ scrollSelectionSections yi
|
|
& worldEventFlags . at InventoryChange ?~ ()
|
|
& setInvPosFromSS
|
|
|
|
setInvPosFromSS :: World -> World
|
|
setInvPosFromSS w =
|
|
w
|
|
& cWorld . lWorld . creatures . ix 0 . crManipulation . manObject .~ thesel
|
|
where
|
|
thesel = fromMaybe SelNothing $ do
|
|
sss <- w ^? hud . hudElement . diSections
|
|
(i, j) <- sss ^? sssExtra . sssSelPos . _Just
|
|
case i of
|
|
(-1) -> Just $ InInventory SortInventory
|
|
0 -> Just $ InInventory (SelItem j NoInvSelAction)
|
|
1 -> Just SelNothing
|
|
2 -> Just $ InNearby SortNearby
|
|
3 -> Just $ InNearby $ SelCloseObject j
|
|
_ -> error "selection out of bounds"
|
|
|
|
selectedCloseObject :: World -> Maybe (Either FloorItem Button)
|
|
selectedCloseObject w = do
|
|
i <-
|
|
you w ^? crManipulation . manObject . inNearby . ispCloseObject
|
|
<|> fmap fst (IM.lookupMin =<< w ^? hud . hudElement . diSections . sssSections . ix 3 . ssItems)
|
|
w ^? hud . closeObjects . ix i
|