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

Implement filter on nearby objects

Browse Source
This commit is contained in:
justin
2023-02-17 11:19:07 +00:00
parent 93dfc2a67c
commit c0ef36426a
8 changed files with 103 additions and 18 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data/Item/Use/Consumption/LoadAction.hs
+9
View File
@@ -21,6 +21,7 @@ data Manipulation -- should be ManipulatedObject?
-- = InvSel {_isel :: SelPos}
= Manipulator {_manObject :: ManipulatedObject
, _invRegex :: Maybe String
, _closeRegex :: Maybe String
}
| Brute
deriving (Eq, Ord, Show, Read) --Generic, Flat)
@@ -28,6 +29,12 @@ data Manipulation -- should be ManipulatedObject?
data ManipulatedObject
= InInventory {_inInventory :: InventoryManipulation}
| SelNothing
-- | SelCloseObject {_ispCloseObject :: Int}
| InNearby {_inNearby :: NearbyManipulation}
deriving (Eq, Ord, Show, Read) --Generic, Flat)
data NearbyManipulation
= SortNearby
| SelCloseObject {_ispCloseObject :: Int}
deriving (Eq, Ord, Show, Read) --Generic, Flat)
@@ -50,11 +57,13 @@ makeLenses ''LoadAction
makeLenses ''ManipulatedObject
makeLenses ''Manipulation
makeLenses ''InventoryManipulation
makeLenses ''NearbyManipulation
makeLenses ''LeftInvSel
makeLenses ''InvSelAction
deriveJSON defaultOptions ''LoadAction
deriveJSON defaultOptions ''InvSelAction
deriveJSON defaultOptions ''InventoryManipulation
deriveJSON defaultOptions ''NearbyManipulation
deriveJSON defaultOptions ''ManipulatedObject
deriveJSON defaultOptions ''Manipulation
deriveJSON defaultOptions ''LeftInvSel
src/Dodge/Default/Creature.hs
+1 -1
View File
@@ -26,7 +26,7 @@ defaultCreature =
, _crHP = 100
, _crMaxHP = 150
, _crInv = IM.empty
, _crManipulation = Manipulator SelNothing Nothing
, _crManipulation = Manipulator SelNothing Nothing Nothing
, _crInvCapacity = 25
, _crInvLock = False
, _crInvEquipped = mempty
src/Dodge/DisplayInventory.hs
+21 -7
View File
@@ -23,21 +23,25 @@ import Dodge.Data.World
updateDisplayInventory :: World -> Configuration -> SelectionSections () -> SelectionSections ()
updateDisplayInventory w cfig sss = case cr ^? crManipulation . manObject of
Just (InInventory SortInventory) -> sss
{ _sssSections = updateSections availablelines ((-1),0) [filtinv,invx ,youx, closex]
{ _sssSections = updateSections availablelines ((-1),0) [filtinv,filtclose,invx ,youx, closex]
, _sssSelPos = Just (-1)
}
Just (InInventory (SelItem i _)) -> sss
{ _sssSections = updateSections availablelines (0,i) [filtinv,invx ,youx, closex]
{ _sssSections = updateSections availablelines (0,i) [filtinv,filtclose,invx ,youx, closex]
, _sssSelPos = Just 0
}
Just SelNothing -> sss
{ _sssSections = updateSections availablelines (1,0) [filtinv,invx ,youx, closex]
{ _sssSections = updateSections availablelines (1,0) [filtinv,filtclose,invx ,youx, closex]
, _sssSelPos = Just 1
}
Just (SelCloseObject i) -> sss
{ _sssSections = updateSections availablelines (2,i) [filtinv,closex, invx ,youx]
Just (InNearby SortNearby) -> sss
{ _sssSections = updateSections availablelines (2,0) [filtinv,filtclose,closex, invx ,youx]
, _sssSelPos = Just 2
}
Just (InNearby (SelCloseObject i)) -> sss
{ _sssSections = updateSections availablelines (3,i) [filtinv,filtclose,closex, invx ,youx]
, _sssSelPos = Just 3
}
_ -> error "error when getting cr inv sel"
where
filtinv = (-1,(filtinvsec,filtinvitems))
@@ -45,18 +49,28 @@ updateDisplayInventory w cfig sss = case cr ^? crManipulation . manObject of
filtinvitems = case cr ^? crManipulation . invRegex . _Just of
Just str -> IM.singleton 0 (SelectionRegex ["INV. FILTER: " ++ str,numfiltitems] 2 True white 0)
Nothing -> mempty
filtclose = (2,(filtclosesec,filtcloseitems))
filtclosesec = fromMaybe defaultFiltSection $ sss ^? sssSections . ix 2
filtcloseitems = case cr ^? crManipulation . closeRegex . _Just of
Just str -> IM.singleton 0 (SelectionRegex ["NEARBY FILTER: " ++ str,numfiltclose] 2 True white 0)
Nothing -> mempty
numfiltitems = " " ++ show numfiltitems' ++ " FILTERED"
numfiltitems' = length invitems' - length invitems
numfiltclose = " " ++ show numfiltclose' ++ " FILTERED"
numfiltclose' = length coitems' - length coitems
invx = (0,(invsec, invitems))
youx = (1,(yousec, youitems))
closex = (2,(cosec, coitems))
closex = (3,(cosec, coitems))
youitems = IM.singleton 0 $ SelectionItem [thetext] 1 True invDimColor 2 ()
thetext = displayFreeSlots nfreeslots
availablelines = getAvailableListLines (invDisplayParams w) cfig
cosec = fromMaybe defaultCOSection $ sss ^? sssSections . ix 2
invsec = fromMaybe defaultInvSection $ sss ^? sssSections . ix 0
coitems = IM.fromDistinctAscList . zip [0..]
coitems' = IM.fromDistinctAscList . zip [0..]
$ map (closeObjectToSelectionItem nfreeslots) (w ^. hud . closeObjects)
coitems = case cr ^? crManipulation . closeRegex . _Just of
Just str -> IM.filter (regexList str . _siPictures) coitems'
Nothing -> coitems'
invitems' = IM.mapWithKey (invSelectionItem' cr) inv
invitems = case cr ^? crManipulation . invRegex . _Just of
Just str -> IM.filter (regexList str . _siPictures) invitems'
src/Dodge/InputFocus.hs
+8 -1
View File
@@ -1,6 +1,7 @@
module Dodge.InputFocus
( inTermFocus
, inInvRegex
, inCloseRegex
, inSubInvRegex
, inputFocus
) where
@@ -23,6 +24,12 @@ inInvRegex w = fromMaybe False $ do
i <- sss ^? sssSelPos . _Just
return $ i == (-1)
inCloseRegex :: World -> Bool
inCloseRegex w = fromMaybe False $ do
sss <- w ^? hud . hudElement . diSections
i <- sss ^? sssSelPos . _Just
return $ i == 2
inSubInvRegex :: World -> Bool
inSubInvRegex w = fromMaybe False $ do
sm <- w ^? hud . hudElement . subInventory . subInvMap
@@ -33,4 +40,4 @@ inSubInvRegex w = fromMaybe False $ do
_ -> return False
inputFocus :: World -> Bool
inputFocus w = inTermFocus w || inSubInvRegex w || inInvRegex w
inputFocus w = inTermFocus w || inSubInvRegex w || inInvRegex w || inCloseRegex w
src/Dodge/Inventory.hs
+6 -5
View File
@@ -175,7 +175,7 @@ updateCloseObjects w =
where
newcloseobjects = unionBy closeObjEq oldCloseFiltered currentClose
updatecursorposifnecessary
= case w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject. ispCloseObject of
= case w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject. inNearby . ispCloseObject of
Just i | i >= length newcloseobjects -> changeAugInvSel 1
_ -> id
filt = filter $ \obj -> dist ypos (closeObjPos obj) < 40 && hasButtonLOS ypos (closeObjPos obj) w
@@ -328,8 +328,8 @@ closeObjScrollDir x
changeSwapInvSel :: Int -> World -> World
changeSwapInvSel k w = case you w ^? crManipulation . manObject of
Just (InInventory (SelItem i _)) -> w & cWorld . lWorld . creatures . ix 0 %~ updatecreature i
Just (SelCloseObject i) -> w
& cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . ispCloseObject
Just (InNearby (SelCloseObject i)) -> w
& cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . inNearby . ispCloseObject
.~ ((i - k) `mod` numCO)
& hud . closeObjects %~ swapIndices i ((i - k) `mod` numCO)
_ -> w
@@ -372,7 +372,8 @@ setInvPosFromSS w = w
(-1) -> Just $ InInventory SortInventory
0 -> Just $ InInventory (SelItem j NoInvSelAction)
1 -> Just SelNothing
2 -> Just $ SelCloseObject j
2 -> Just $ InNearby SortNearby
3 -> Just $ InNearby $ SelCloseObject j
_ -> error "selection out of bounds"
-- this should be in a separate module
@@ -497,7 +498,7 @@ bestCloseObjectIndex w = findIndex f $ w ^. hud . closeObjects
ycr = you w
selectedCloseObject :: World -> Maybe (Int, Either FloorItem Button)
selectedCloseObject w = case you w ^? crManipulation . manObject . ispCloseObject of
selectedCloseObject w = case you w ^? crManipulation . manObject . inNearby . ispCloseObject of
Just i -> selectNthCloseObject w i
Nothing -> selectNthCloseObject w =<< bestCloseObjectIndex w
src/Dodge/Render/HUD.hs
+3 -2
View File
@@ -90,7 +90,8 @@ inventoryDisplay sss w cfig = listPicturesAtScaleOff
InInventory SortInventory -> negate 1
InInventory {} -> 0
SelNothing{} -> 1
SelCloseObject{} -> 2
InNearby SortNearby -> 2
InNearby{} -> 3
xint <- sss ^? sssSections . ix secnum . ssIndent
spos <- _sssSelPos sss
let y = sum . fmap (length . _ssShownItems) . fst . IM.split spos $ _sssSections sss
@@ -155,7 +156,7 @@ floorItemPickupInfo n itm
yourAugmentedItem :: (Item -> a) -> a -> (Either FloorItem Button -> a) -> World -> a
yourAugmentedItem f x g w = case you w ^? crManipulation . manObject of
Just (InInventory (SelItem i _)) -> f $ yourInv w ^?! ix i
Just (SelCloseObject i) -> g $ w ^?! hud . closeObjects . ix i
Just (InNearby (SelCloseObject i)) -> g $ w ^?! hud . closeObjects . ix i
_ -> x
drawNoSubInventory :: Configuration -> World -> Picture
src/Dodge/Update.hs
+1
View File
@@ -147,6 +147,7 @@ updateUseInput u = case u ^? uvScreenLayers . _head of
Just (CombineInventory sm)
| inregex sm -> doSubInvRegexInput u
_ | inInvRegex (u ^. uvWorld) -> doInvRegexInput u
_ | inCloseRegex (u ^. uvWorld) -> doCloseRegexInput u
_ -> M.foldlWithKey' updateKeyInGame u pkeys
where
inregex sm = fromMaybe False $ do
src/Dodge/Update/Input.hs
+54 -2
View File
@@ -4,6 +4,7 @@ module Dodge.Update.Input (
doInputScreenInput,
doSubInvRegexInput,
doInvRegexInput,
doCloseRegexInput,
) where
import Dodge.Inventory
@@ -74,6 +75,34 @@ doSubInvRegexInput u
&& ScancodeBackspace `M.lookup` pkeys == Just InitialPress
pkeys = u ^. uvWorld . input . pressedKeys
doCloseRegexInput :: Universe -> Universe
doCloseRegexInput u
| backspacetonothing
= u
& uvWorld . cWorld . lWorld . creatures . ix 0 . crManipulation . closeRegex .~ Nothing
& uvWorld . hud . hudElement . diSections %~
( ssSetCursor (ssLookupGT 0 2)
. (overSection (ssItems . at 2 .~ Nothing))
)
& uvWorld %~ setInvPosFromSS
-- & uvWorld . hud . hudElement . diSections %~ setShownIntMap
| endkeys || endmouse = u
-- = u & uvWorld . hud . hudElement . diSections %~ initialSelPos
-- | otherwise = u & uvWorld . hud . hudElement . diSections %~
-- --overSection (doTextInputOver' u (ssRegex . regexString))
-- overSection (id)
| otherwise = u & doTextInputOver
(uvWorld . cWorld . lWorld . creatures . ix 0 . crManipulation . closeRegex . _Just)
-- & uvWorld . hud . hudElement . subInventory . subInvMap %~ setShownIntMap
where
endkeys = any
( (== Just InitialPress) . (`M.lookup` pkeys))
[ScancodeReturn,ScancodeEscape,ScancodeSlash]
endmouse = Just True == (u ^? uvWorld . input . mouseButtons . ix ButtonLeft)
backspacetonothing = u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crManipulation . closeRegex . _Just == Just ""
&& ScancodeBackspace `M.lookup` pkeys == Just InitialPress
pkeys = u ^. uvWorld . input . pressedKeys
doInvRegexInput :: Universe -> Universe
doInvRegexInput u
| backspacetonothing
@@ -158,7 +187,8 @@ updateLongPressInGame uv sc = case sc of
updateBackspaceRegex :: World -> World
updateBackspaceRegex w = case di ^? subInventory of
Just NoSubInventory -> w & cWorld . lWorld . creatures . ix 0 . crManipulation %~ trybackspace
Just NoSubInventory | invfocus -> w & cWorld . lWorld . creatures . ix 0 . crManipulation %~ trybackspace
Just NoSubInventory | closefocus -> w & cWorld . lWorld . creatures . ix 0 . crManipulation %~ trybackspaceclose
Just CombineInventory {} -> w & hud . hudElement . subInventory . subInvMap %~
( ( smRegex %~ enternonzeroregex )
. ( smSelPos ?~ 0 )
@@ -166,21 +196,36 @@ updateBackspaceRegex w = case di ^? subInventory of
)
_ -> w
where
invfocus = fromMaybe False $ do
i <- di ^? diSections . sssSelPos . _Just
return $ i == (-1) || i == 0
closefocus = fromMaybe False $ do
i <- di ^? diSections . sssSelPos . _Just
return $ i == 2 || i == 3
trybackspace cm = case cm ^? invRegex . _Just of
Just (_:_) -> cm & invRegex . _Just %~ init
& manObject .~ InInventory SortInventory
Just [] -> cm & invRegex .~ Nothing
Nothing -> cm
trybackspaceclose cm = case cm ^? closeRegex . _Just of
Just (_:_) -> cm & closeRegex . _Just %~ init
& manObject .~ InNearby SortNearby
Just [] -> cm & closeRegex .~ Nothing
Nothing -> cm
di = w ^. hud . hudElement
enternonzeroregex (Just (x:xs)) = Just (init (x:xs))
enternonzeroregex smr = smr
updateEnterRegex :: World -> World
updateEnterRegex w = case w ^? hud . hudElement . subInventory of
Just NoSubInventory -> w & cWorld . lWorld . creatures . ix 0 . crManipulation %~
Just NoSubInventory | invfocus -> w & cWorld . lWorld . creatures . ix 0 . crManipulation %~
( ( invRegex %~ startregex )
. ( manObject .~ InInventory SortInventory)
)
Just NoSubInventory | closefocus -> w & cWorld . lWorld . creatures . ix 0 . crManipulation %~
( ( closeRegex %~ startregex )
. ( manObject .~ InNearby SortNearby)
)
Just CombineInventory {} -> w & hud . hudElement . subInventory . subInvMap %~
( setShownIntMap
. (smSelPos ?~ 0 )
@@ -188,6 +233,13 @@ updateEnterRegex w = case w ^? hud . hudElement . subInventory of
)
_ -> w
where
di = w ^. hud . hudElement
invfocus = fromMaybe False $ do
i <- di ^? diSections . sssSelPos . _Just
return $ i == (-1) || i == 0
closefocus = fromMaybe False $ do
i <- di ^? diSections . sssSelPos . _Just
return $ i == 2 || i == 3
startregex Nothing = Just ""
startregex x = x
enterregex Nothing = Just ""