justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Refactor close objects hud display

Browse Source
This commit is contained in:
justin
2024-11-24 16:12:35 +00:00
parent e6c2b659fd
commit 81fcfea1be
11 changed files with 205 additions and 220 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Inventory.hs
+62 -65
View File
@@ -9,39 +9,38 @@ module Dodge.Inventory (
scrollAugInvSel,
crNumFreeSlots,
crInvSize,
selectedCloseObject,
selectedCloseItem,
setInvPosFromSS,
module Dodge.Inventory.RBList,
swapInvItems,
scrollAugNextInSection,
isFilteringInv,
-- isFilteringInv,
swapItemWith,
) where
import qualified Data.IntSet as IS
import Control.Monad
import Dodge.Item.Grammar
import Dodge.Data.DoubleTree
import Sound.Data
import Dodge.SoundLogic
import Control.Applicative
import Control.Monad
import Data.Function
import qualified Data.IntSet as IS
import Data.Maybe
import Dodge.Base
import Dodge.Data.DoubleTree
import Dodge.Data.SelectionList
import Dodge.Data.World
--import Dodge.DisplayInventory
import Dodge.Euse
import Dodge.Inventory.CheckSlots
import Dodge.Inventory.CloseObject
import Dodge.Inventory.Location
import Dodge.Inventory.RBList
import Dodge.ItEffect
import Dodge.Item.Grammar
import Dodge.SelectionSections
import Dodge.SoundLogic
import Geometry
import qualified IntMapHelp as IM
import LensHelp
import ListHelp
import NewInt
import Sound.Data
--import Padding
@@ -90,12 +89,13 @@ rmInvItem cid invid w =
-- & updateCreatureItemLocations cid
pointcid = cWorld . lWorld . creatures . ix cid
updateselectionextra | cid == 0 = hud . hudElement . diSelectionExtra .~ mempty
updateselectionextra
| cid == 0 = hud . hudElement . diSelectionExtra .~ mempty
| otherwise = id
updateselection
| cid == 0 && cr ^? crManipulation . manObject . imSelectedItem == Just invid =
scrollAugInvSel (-1) . scrollAugInvSel 1 -- . updateInventorySectionItems
-- id -- . updateInventorySectionItems
-- id -- . updateInventorySectionItems
| otherwise =
pointcid . crManipulation . manObject . imSelectedItem %~ g
@@ -126,36 +126,34 @@ rmInvItem cid invid w =
updateCloseObjects :: World -> World
updateCloseObjects w =
w
& hud . closeObjects .~ newcloseobjects
& updatecursorposifnecessary
& hud . closeItems %~ f
& hud . closeInterfaces %~ g
where
newcloseobjects = unionBy closeObjEq oldCloseFiltered currentClose
updatecursorposifnecessary =
case w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . ispCloseObject of
Just i
| i >= length newcloseobjects -> scrollAugInvSel 1
| isNothing (w ^? hud . hudElement . diSections . ix 3 . ssItems . ix i) ->
scrollAugInvSel (-1)
_ -> id
filt = filter $ \obj -> dist ypos (closeObjPos obj) < 40 && hasButtonLOS ypos (closeObjPos obj) w
-- the following should update any changed properties of flits/bts
g oldbts = intersectBy bteq cbts oldbts `btunion` cbts
f olditems = intersectBy feq citems olditems `itunion` citems
itunion = unionBy feq
btunion = unionBy bteq
feq = (==) `on` _flItID
bteq = (==) `on` _btID
cbts = filter (isclose . _btPos) activeButtons
citems =
filter (isclose . _flItPos)
. IM.elems
$ w ^. cWorld . lWorld . floorItems . unNIntMap
isclose pos = dist ypos pos < 40 && hasButtonLOS ypos pos w
ypos = _crPos $ you w
activeButtons =
map Right
. filter ((/=) BtNoLabel . _btState)
filter ((/=) BtNoLabel . _btState)
. IM.elems
$ w ^. cWorld . lWorld . buttons
currentClose =
filt $
map Left (IM.elems $ w ^. cWorld . lWorld . floorItems . unNIntMap)
++ activeButtons
oldClose = filt $ mapMaybe updatebyid $ w ^. hud . closeObjects
oldCloseFiltered = intersectBy closeObjEq oldClose currentClose
updatebyid (Left flid) =
fmap Left $
w
^? cWorld . lWorld . floorItems . unNIntMap
. ix (_unNInt $ _flItID flid)
updatebyid (Right btid) = fmap Right $ w ^? cWorld . lWorld . buttons . ix (_btID btid)
-- updatecursorposifnecessary =
-- case w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . ispCloseObject of
-- Just i
-- | i >= length newcloseobjects -> scrollAugInvSel 1
-- | isNothing (w ^? hud . hudElement . diSections . ix 3 . ssItems . ix i) ->
-- scrollAugInvSel (-1)
-- _ -> id
changeSwapSel :: Int -> World -> World
changeSwapSel yi w
@@ -178,7 +176,7 @@ changeSwapClose f i w = fromMaybe w $ do
& swapAnyExtraSelection i k
& cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . ispCloseObject
.~ k
& hud . closeObjects %~ swapIndices i k
& hud . closeItems %~ swapIndices i k
& hud . hudElement . diSelection . _Just . _2 .~ k
& worldEventFlags . at InventoryChange ?~ ()
@@ -196,7 +194,7 @@ swapInvItems f i w = fromMaybe w $ do
Just (0, j) | j == i -> hud . hudElement . diSelection . _Just . _2 .~ k
_ -> id
return $
w
w
& swapAnyExtraSelection i k
& checkConnection InventorySound disconnectItemS i k
& cWorld . lWorld . creatures . ix 0 %~ updatecreature k
@@ -207,15 +205,16 @@ swapInvItems f i w = fromMaybe w $ do
& cWorld . lWorld %~ crUpdateItemLocations 0 -- the double application is inefficient, but necessary without further changes
-- a rethink is maybe in order
& checkConnection InventoryConnectSound connectItemS i k
-- & checkconnect k InventoryConnectSound connectItemS
where
-- cpos = fromMaybe 0 $ w ^? cWorld . lWorld . creatures . ix 0 . crPos
-- checkconnect k stype s w'
-- | p (i+1) || p (i-1)
-- || p (k+1) || p (k-1) = soundStart stype cpos s Nothing w'
-- | otherwise = w'
-- where
-- p j = maybe False not $ w' ^? cWorld . lWorld . creatures . ix 0 . crInv . ix j . itLocation . ilIsRoot
-- & checkconnect k InventoryConnectSound connectItemS
-- cpos = fromMaybe 0 $ w ^? cWorld . lWorld . creatures . ix 0 . crPos
-- checkconnect k stype s w'
-- | p (i+1) || p (i-1)
-- || p (k+1) || p (k-1) = soundStart stype cpos s Nothing w'
-- | otherwise = w'
-- where
-- p j = maybe False not $ w' ^? cWorld . lWorld . creatures . ix 0 . crInv . ix j . itLocation . ilIsRoot
updatecreature k =
(crInv %~ IM.safeSwapKeys i k)
. (crManipulation . manObject . imSelectedItem .~ k)
@@ -238,8 +237,9 @@ swapAnyExtraSelection i k w = fromMaybe w $ do
is <- w ^? hud . hudElement . diSelectionExtra
let f = if i `IS.member` is then IS.insert k else id
g = if k `IS.member` is then IS.insert i else id
return $ w & hud . hudElement . diSelectionExtra
%~ (f . g . IS.delete i . IS.delete k)
return $
w & hud . hudElement . diSelectionExtra
%~ (f . g . IS.delete i . IS.delete k)
checkConnection :: SoundOrigin -> SoundID -> Int -> Int -> World -> World
checkConnection so s i j w = fromMaybe w $ do
@@ -253,16 +253,17 @@ checkConnection so s i j w = fromMaybe w $ do
isConnected :: LocationLDT b a -> Bool
isConnected x = case x ^. locLdtContext of
TopLDT -> not (null $ x ^. locLDT . ldtRight)
|| not (null $ x ^. locLDT . ldtLeft)
TopLDT ->
not (null $ x ^. locLDT . ldtRight)
|| not (null $ x ^. locLDT . ldtLeft)
_ -> True
swapItemWith ::
swapItemWith ::
(Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) ->
(Int,Int) ->
(Int, Int) ->
World ->
World
swapItemWith f (j,i) w = case j of
swapItemWith f (j, i) w = case j of
0 -> w & swapInvItems f i
3 -> w & changeSwapClose f i
_ -> w
@@ -296,22 +297,18 @@ scrollAugInvSel yi w
scrollAugNextInSection :: World -> World
scrollAugNextInSection w =
w & hud . hudElement %~ doscroll
& worldEventFlags . at InventoryChange ?~ ()
& setInvPosFromSS
& cWorld . lWorld %~ crUpdateItemLocations 0
w & hud . hudElement %~ doscroll
& worldEventFlags . at InventoryChange ?~ ()
& setInvPosFromSS
& cWorld . lWorld %~ crUpdateItemLocations 0
where
doscroll he = fromMaybe he $ do
sss <- he ^? diSections
return $ he & diSelection %~ nextInSectionSS sss
selectedCloseObject :: World -> Maybe (Either FloorItem Button)
selectedCloseObject w = do
selectedCloseItem :: World -> Maybe FloorItem
selectedCloseItem w = do
i <-
you w ^? crManipulation . manObject . ispCloseObject
<|> fmap fst (IM.lookupMin =<< w ^? hud . hudElement . diSections . ix 3 . ssItems)
w ^? hud . closeObjects . ix i
isFilteringInv :: IM.IntMap (SelectionSection a) -> Bool
isFilteringInv = not . null . (^. ix (-1) . ssItems)
w ^? hud . closeItems . ix i