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

Start unifying regex parts of selection sections

Browse Source
This commit is contained in:
justin
2023-02-20 18:20:48 +00:00
parent c3fb94c7b5
commit 7b9b1d1799
12 changed files with 90 additions and 136 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Combine.hs
+1 -2
View File
@@ -140,8 +140,7 @@ toggleCombineInv uv = case uv ^? uvWorld . hud . hudElement . subInventory of
enterCombineInv :: Configuration -> World -> World enterCombineInv :: Configuration -> World -> World
enterCombineInv cfig w = w & hud . hudElement . subInventory .~ CombineInventory enterCombineInv cfig w = w & hud . hudElement . subInventory .~ CombineInventory
cm' cm'
Nothing FilterableSections {_fssFilters=IM.singleton (-1) Nothing,_fssSections = sss}
sss
--(updateCombineSelections w cfig sss) --(updateCombineSelections w cfig sss)
where where
cm' = IM.fromAscList $ zip [0..] $ combineList' w cm' = IM.fromAscList $ zip [0..] $ combineList' w
src/Dodge/Data/HUD.hs
+2 -6
View File
@@ -16,20 +16,16 @@ import Data.IntMap.Strict (IntMap)
data HUDElement data HUDElement
= DisplayInventory = DisplayInventory
{ _subInventory :: SubInventory { _subInventory :: SubInventory
, _diSections :: SelectionSections () , _diSections :: FilterableSections ()
, _invRegex :: Maybe String
, _closeRegex :: Maybe String
} }
| DisplayCarte | DisplayCarte
-- deriving (Eq, Ord, Show, Read) --Generic, Flat)
data SubInventory data SubInventory
= NoSubInventory = NoSubInventory
| ExamineInventory {_subInvMSel :: Maybe Int} | ExamineInventory {_subInvMSel :: Maybe Int}
-- | CombineInventory {_subInvMap :: SelectionIntMap CombinableItem} -- | CombineInventory {_subInvMap :: SelectionIntMap CombinableItem}
| CombineInventory {_ciCombinations :: IntMap (SelectionItem CombinableItem) | CombineInventory {_ciCombinations :: IntMap (SelectionItem CombinableItem)
, _ciRegex :: Maybe String , _ciSections :: FilterableSections CombinableItem
, _ciSections :: SelectionSections CombinableItem
} }
| LockedInventory | LockedInventory
| DisplayTerminal {_termID :: Int} | DisplayTerminal {_termID :: Int}
src/Dodge/Data/SelectionList.hs
-1
View File
@@ -44,7 +44,6 @@ data SelectionSections a = SelectionSections
} }
data SectionCursor = SectionCursor data SectionCursor = SectionCursor
--{ _scurSel :: Int
{ _scurPos :: Int { _scurPos :: Int
, _scurSize :: Int , _scurSize :: Int
, _scurColor :: Color , _scurColor :: Color
src/Dodge/Default/World.hs
+11 -5
View File
@@ -162,9 +162,9 @@ defaultHUD =
defaultDisplayInventory :: HUDElement defaultDisplayInventory :: HUDElement
defaultDisplayInventory = DisplayInventory defaultDisplayInventory = DisplayInventory
{_subInventory = NoSubInventory {_subInventory = NoSubInventory
, _diSections = defaultInvSections , _diSections = defaultFiltInv
, _invRegex = Nothing -- , _invRegex = Nothing
, _closeRegex = Nothing -- , _closeRegex = Nothing
} }
--youLight :: TempLightSource --youLight :: TempLightSource
--youLight = TLS --youLight = TLS
@@ -179,13 +179,20 @@ defaultDisplayInventory = DisplayInventory
-- where -- where
-- f (V2 x y) = V3 x y 100 -- f (V2 x y) = V3 x y 100
defaultFiltInv :: FilterableSections ()
defaultFiltInv = FilterableSections
{_fssFilters = IM.fromList [(-1,mempty),(2,mempty)]
,_fssSections =defaultInvSections
}
defaultInvSections :: SelectionSections () defaultInvSections :: SelectionSections ()
defaultInvSections = SelectionSections defaultInvSections = SelectionSections
{ _sssSections = IM.fromDistinctAscList $ zip [-1..] { _sssSections = IM.fromDistinctAscList $ zip [-1..]
[ defaultFiltSection [ defaultFiltSection
, defaultInvSection , defaultInvSection
, defaultYouSection , defaultYouSection
, defaultFiltSection , (defaultFiltSection & ssIndent .~ 2
& ssDescriptor .~ "NEARBY")
, defaultCOSection , defaultCOSection
] ]
, _sssSelPos = Nothing , _sssSelPos = Nothing
@@ -201,7 +208,6 @@ defaultSS = SelectionSection
, _ssDescriptor = "" , _ssDescriptor = ""
} }
defaultCOSection :: SelectionSection () defaultCOSection :: SelectionSection ()
defaultCOSection = defaultSS defaultCOSection = defaultSS
& ssIndent .~ 2 & ssIndent .~ 2
src/Dodge/DisplayInventory.hs
+2 -2
View File
@@ -38,8 +38,8 @@ updateDisplayInventory w cfig sss = case cr ^? crManipulation . manObject of
SelNothing -> reverse [filtinv,filtclose,invx ,youx, closex] SelNothing -> reverse [filtinv,filtclose,invx ,youx, closex]
InNearby SortNearby -> reverse [filtinv,filtclose,closex, invx ,youx] InNearby SortNearby -> reverse [filtinv,filtclose,closex, invx ,youx]
InNearby SelCloseObject {} -> reverse [filtinv,filtclose,closex, invx ,youx] InNearby SelCloseObject {} -> reverse [filtinv,filtclose,closex, invx ,youx]
(filtinv,invx) = filtpair (-1) (hud . hudElement . invRegex . _Just) invitems' "INV. " (filtinv,invx) = filtpair (-1) (hud . hudElement . diSections . fssFilters . ix (-1) . _Just) invitems' "INV. "
(filtclose,closex) = filtpair 2 (hud . hudElement . closeRegex . _Just) coitems' "NEARBY " (filtclose,closex) = filtpair 2 (hud . hudElement . diSections . fssFilters . ix 2 . _Just) coitems' "NEARBY "
youx = (1, youitems) youx = (1, youitems)
youitems = IM.singleton 0 $ SelectionItem [thetext] 1 True invDimColor 2 () youitems = IM.singleton 0 $ SelectionItem [thetext] 1 True invDimColor 2 ()
thetext = displayFreeSlots nfreeslots thetext = displayFreeSlots nfreeslots
src/Dodge/InputFocus.hs
+3 -3
View File
@@ -20,19 +20,19 @@ inTermFocus w = fromMaybe False $ do
inInvRegex :: World -> Bool inInvRegex :: World -> Bool
inInvRegex w = fromMaybe False $ do inInvRegex w = fromMaybe False $ do
sss <- w ^? hud . hudElement . diSections sss <- w ^? hud . hudElement . diSections . fssSections
i <- sss ^? sssSelPos . _Just . _1 i <- sss ^? sssSelPos . _Just . _1
return $ i == (-1) return $ i == (-1)
inCloseRegex :: World -> Bool inCloseRegex :: World -> Bool
inCloseRegex w = fromMaybe False $ do inCloseRegex w = fromMaybe False $ do
sss <- w ^? hud . hudElement . diSections sss <- w ^? hud . hudElement . diSections . fssSections
i <- sss ^? sssSelPos . _Just . _1 i <- sss ^? sssSelPos . _Just . _1
return $ i == 2 return $ i == 2
inSubInvRegex :: World -> Bool inSubInvRegex :: World -> Bool
inSubInvRegex w = fromMaybe False $ do inSubInvRegex w = fromMaybe False $ do
sss <- w ^? hud . hudElement . subInventory . ciSections sss <- w ^? hud . hudElement . subInventory . ciSections . fssSections
i <- sss ^? sssSelPos . _Just . _1 i <- sss ^? sssSelPos . _Just . _1
return $ i == (-1) return $ i == (-1)
src/Dodge/Inventory.hs
+5 -6
View File
@@ -106,7 +106,7 @@ rmSelectedInvItem cid w = case w ^? cWorld . lWorld . creatures . ix cid . crMan
Nothing -> w Nothing -> w
selNumPos :: ManipulatedObject -> World -> Maybe Int selNumPos :: ManipulatedObject -> World -> Maybe Int
selNumPos mo w = w ^? hud . hudElement . diSections >>= selNumPos mo w = w ^? hud . hudElement . diSections . fssSections >>=
case mo of case mo of
InInventory SortInventory -> selSecSelPos (-1) 0 InInventory SortInventory -> selSecSelPos (-1) 0
InInventory (SelItem i _) -> selSecSelPos 0 i InInventory (SelItem i _) -> selSecSelPos 0 i
@@ -164,7 +164,7 @@ updateCloseObjects w =
= case w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject. inNearby . ispCloseObject of = case w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject. inNearby . ispCloseObject of
Just i Just i
| i >= length newcloseobjects -> scrollAugInvSel 1 | i >= length newcloseobjects -> scrollAugInvSel 1
| isNothing (w ^? hud . hudElement . diSections . sssSections . ix 3 . ssItems . ix i) | isNothing (w ^? hud . hudElement . diSections . fssSections . sssSections . ix 3 . ssItems . ix i)
-> scrollAugInvSel (-1) -> scrollAugInvSel (-1)
_ -> id _ -> id
filt = filter $ \obj -> dist ypos (closeObjPos obj) < 40 && hasButtonLOS ypos (closeObjPos obj) w filt = filter $ \obj -> dist ypos (closeObjPos obj) < 40 && hasButtonLOS ypos (closeObjPos obj) w
@@ -346,7 +346,7 @@ scrollAugInvSel :: Int -> World -> World
scrollAugInvSel yi w scrollAugInvSel yi w
| yi == 0 = w | yi == 0 = w
| otherwise = | otherwise =
w & hud . hudElement . diSections %~ scrollSelectionSections yi w & hud . hudElement . diSections . fssSections %~ scrollSelectionSections yi
& setInvPosFromSS & setInvPosFromSS
setInvPosFromSS :: World -> World setInvPosFromSS :: World -> World
@@ -354,9 +354,8 @@ setInvPosFromSS w = w
& cWorld . lWorld . creatures . ix 0 . crManipulation . manObject .~ thesel & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject .~ thesel
where where
thesel = fromMaybe SelNothing $ do thesel = fromMaybe SelNothing $ do
sss <- w ^? hud . hudElement . diSections sss <- w ^? hud . hudElement . diSections . fssSections
(i,j) <- sss ^? sssSelPos . _Just (i,j) <- sss ^? sssSelPos . _Just
-- j <- sss ^? sssSections . ix i . ssCursor . _Just . scurSel
case i of case i of
(-1) -> Just $ InInventory SortInventory (-1) -> Just $ InInventory SortInventory
0 -> Just $ InInventory (SelItem j NoInvSelAction) 0 -> Just $ InInventory (SelItem j NoInvSelAction)
@@ -369,5 +368,5 @@ setInvPosFromSS w = w
selectedCloseObject :: World -> Maybe (Either FloorItem Button) selectedCloseObject :: World -> Maybe (Either FloorItem Button)
selectedCloseObject w = do selectedCloseObject w = do
i <- you w ^? crManipulation . manObject . inNearby . ispCloseObject i <- you w ^? crManipulation . manObject . inNearby . ispCloseObject
<|> fmap fst (IM.lookupMin =<< w ^? hud . hudElement . diSections . sssSections . ix 3 . ssItems) <|> fmap fst (IM.lookupMin =<< w ^? hud . hudElement . diSections . fssSections . sssSections . ix 3 . ssItems)
w ^? hud . closeObjects . ix i w ^? hud . closeObjects . ix i
src/Dodge/Render/HUD.hs
+8 -7
View File
@@ -38,7 +38,7 @@ drawHUD cfig w = case w ^. hud . hudElement of
DisplayCarte -> drawCarte cfig w DisplayCarte -> drawCarte cfig w
DisplayInventory {_diSections = sections, _subInventory = subinv} -> DisplayInventory {_diSections = sections, _subInventory = subinv} ->
drawHP cfig w drawHP cfig w
<> inventoryDisplay sections w cfig <> inventoryDisplay (sections ^. fssSections) w cfig
<> drawSubInventory subinv cfig w <> drawSubInventory subinv cfig w
drawHP :: Configuration -> World -> Picture drawHP :: Configuration -> World -> Picture
@@ -93,7 +93,8 @@ drawSubInventory subinv cfig w = case subinv of
NoSubInventory -> drawNoSubInventory cfig w NoSubInventory -> drawNoSubInventory cfig w
ExamineInventory mtweaki -> drawExamineInventory cfig mtweaki w ExamineInventory mtweaki -> drawExamineInventory cfig mtweaki w
DisplayTerminal tid -> displayTerminal tid cfig (w ^. cWorld . lWorld) DisplayTerminal tid -> displayTerminal tid cfig (w ^. cWorld . lWorld)
CombineInventory _ _ sss -> titledSub' cfig "COMBINE" sss CombineInventory {_ciSections = FilterableSections {_fssSections = sss}}
-> titledSub' cfig "COMBINE" sss
<> combineInventoryExtra sss cfig w <> combineInventoryExtra sss cfig w
titledSub :: Configuration -> String -> SelectionList a -> Picture titledSub :: Configuration -> String -> SelectionList a -> Picture
@@ -155,11 +156,11 @@ drawNoSubInventory cfig w =
where where
equipcursor = fromMaybe mempty $ do equipcursor = fromMaybe mempty $ do
invid <- cr ^. crLeftInvSel . lisMPos invid <- cr ^. crLeftInvSel . lisMPos
sss <- w ^? hud . hudElement . diSections sss <- w ^? hud . hudElement . diSections . fssSections
pos <- selSecSelPos 0 invid sss pos <- selSecSelPos 0 invid sss
return $ listTextPictureAt 144 0 cfig pos . color cyan . text . eqPosText $_crInvEquipped cr IM.! invid return $ listTextPictureAt 144 0 cfig pos . color cyan . text . eqPosText $_crInvEquipped cr IM.! invid
f col invid epos = fromMaybe mempty $ do f col invid epos = fromMaybe mempty $ do
sss <- w ^? hud . hudElement . diSections sss <- w ^? hud . hudElement . diSections . fssSections
pos <- selSecSelPos 0 invid sss pos <- selSecSelPos 0 invid sss
return $ listTextPictureAt 144 0 cfig pos . color col $ text $ eqPosText epos return $ listTextPictureAt 144 0 cfig pos . color col $ text $ eqPosText epos
equipcursors = IM.foldMapWithKey (f yellow) (_crInvEquipped cr) equipcursors = IM.foldMapWithKey (f yellow) (_crInvEquipped cr)
@@ -196,7 +197,7 @@ combineInventoryExtra sss cfig w = fromMaybe mempty $ do
] ]
where where
invcursor i = fromMaybe mempty $ do invcursor i = fromMaybe mempty $ do
sss' <- w ^? hud . hudElement . diSections sss' <- w ^? hud . hudElement . diSections . fssSections
return $ selSecDrawCursor 17 [North,South,East] cfig (invDisplayParams w) sss' 0 i return $ selSecDrawCursor 17 [North,South,East] cfig (invDisplayParams w) sss' 0 i
-- fromMaybe mempty $ do -- fromMaybe mempty $ do
-- i <- mi -- i <- mi
@@ -323,7 +324,7 @@ combineCounts cfig w = winScale cfig . foldMap f . group
where where
f (i : is) = fromMaybe mempty $ do f (i : is) = fromMaybe mempty $ do
_ <- yourInv w ^? ix i . itUse . useAmount _ <- yourInv w ^? ix i . itUse . useAmount
sss <- w ^? hud . hudElement . diSections sss <- w ^? hud . hudElement . diSections . fssSections
p <- selNumTextEndPos cfig (invDisplayParams w) sss 0 i p <- selNumTextEndPos cfig (invDisplayParams w) sss 0 i
col <- selSecSelCol 0 i sss col <- selSecSelCol 0 i sss
return $ color col $ uncurryV translate p . scale 0.1 0.1 . text $ ('-' : show (length is + 1)) return $ color col $ uncurryV translate p . scale 0.1 0.1 . text $ ('-' : show (length is + 1))
@@ -334,7 +335,7 @@ lnkMidPosInvSelsCol cfig w i col = winScale cfig
. foldMap f . foldMap f
where where
f j = fromMaybe mempty $ do f j = fromMaybe mempty $ do
sss <- w ^? hud . hudElement . diSections sss <- w ^? hud . hudElement . diSections . fssSections
h <- selNumEndMidHeight cfig (invDisplayParams w) sss 0 j h <- selNumEndMidHeight cfig (invDisplayParams w) sss 0 j
invcol <- selSecSelCol 0 j sss invcol <- selSecSelCol 0 j sss
return $ zConnectCol rp (V2 18 0 + h) col white white invcol return $ zConnectCol rp (V2 18 0 + h) col white white invcol
src/Dodge/TestString.hs
+1 -1
View File
@@ -10,7 +10,7 @@ import Dodge.Data.Universe
import qualified IntMapHelp as IM import qualified IntMapHelp as IM
testStringInit :: Universe -> [String] testStringInit :: Universe -> [String]
testStringInit u = testStringInit u =
[show $ fmap IM.keys $ u ^? uvWorld . hud . hudElement . diSections . sssSections] [show $ fmap IM.keys $ u ^? uvWorld . hud . hudElement . diSections . fssSections . sssSections]
--[ show $ u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crManipulation --[ show $ u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crManipulation
++ lines (unpack $ AEP.encodePretty' (AEP.Config (AEP.Spaces 2) compare AEP.Generic False) $ u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crManipulation) ++ lines (unpack $ AEP.encodePretty' (AEP.Config (AEP.Spaces 2) compare AEP.Generic False) $ u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crManipulation)
src/Dodge/Update.hs
+1 -1
View File
@@ -82,7 +82,7 @@ updateUniverse u =
cfig = u ^. uvConfig cfig = u ^. uvConfig
updateInventoryDisplay :: Universe -> Universe updateInventoryDisplay :: Universe -> Universe
updateInventoryDisplay u = u & uvWorld . hud . hudElement . diSections updateInventoryDisplay u = u & uvWorld . hud . hudElement . diSections . fssSections
%~ updateDisplayInventory (_uvWorld u) (_uvConfig u) %~ updateDisplayInventory (_uvWorld u) (_uvConfig u)
maybeOpenTerminal :: Universe -> Universe maybeOpenTerminal :: Universe -> Universe
src/Dodge/Update/Input.hs
+55 -101
View File
@@ -2,6 +2,7 @@ module Dodge.Update.Input (
updateUseInput, updateUseInput,
) where ) where
--import Control.Monad
import Data.List (sort) import Data.List (sort)
import Dodge.Inventory.Add import Dodge.Inventory.Add
import Dodge.Data.Combine import Dodge.Data.Combine
@@ -16,7 +17,7 @@ import Data.Char
import qualified Data.IntMap.Strict as IM import qualified Data.IntMap.Strict as IM
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
import Data.Maybe import Data.Maybe
import Data.Monoid (First) --import Data.Monoid (First)
import Dodge.Base.You import Dodge.Base.You
import Dodge.Button.Event import Dodge.Button.Event
import Dodge.Combine import Dodge.Combine
@@ -48,18 +49,18 @@ updateUseInputOnScreen sl = case sl of
updateUseInputInGame :: HUDElement -> Universe -> Universe updateUseInputInGame :: HUDElement -> Universe -> Universe
updateUseInputInGame h u = case h of updateUseInputInGame h u = case h of
DisplayCarte -> over uvWorld updatePressedButtonsCarte u DisplayCarte -> over uvWorld updatePressedButtonsCarte u
DisplayInventory si _ _ _ -> case si of DisplayInventory {_subInventory = si} -> case si of
DisplayTerminal tmid DisplayTerminal tmid
| lbinitialpress && inTermFocus w -> | lbinitialpress && inTermFocus w ->
over uvWorld (doTerminalEffectLB (w ^?! cWorld . lWorld . terminals . ix tmid)) u over uvWorld (doTerminalEffectLB (w ^?! cWorld . lWorld . terminals . ix tmid)) u
| inTermFocus (_uvWorld u) -> updateKeysInTerminal tmid u | inTermFocus (_uvWorld u) -> updateKeysInTerminal tmid u
| lbinitialpress -> | lbinitialpress ->
u & uvWorld . cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus %~ const True u & uvWorld . cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus %~ const True
CombineInventory _ _ sss CombineInventory {_ciSections = FilterableSections {_fssSections = sss}}
| inSubInvRegex (u ^. uvWorld) -> doSubInvRegexInput u | inSubInvRegex (u ^. uvWorld) -> u & uvWorld . hud . hudElement . subInventory . ciSections %~ doRegexInput u (-1)
| lbinitialpress -> maybeExitCombine $ over uvWorld (tryCombine sss) u | lbinitialpress -> maybeExitCombine $ over uvWorld (tryCombine sss) u
_ | inInvRegex (u ^. uvWorld) -> doRegexInput (-1) invRegex invRegex u _ | inInvRegex (u ^. uvWorld) -> u & uvWorld . hud . hudElement . diSections %~ doRegexInput u (-1)
_ | inCloseRegex (u ^. uvWorld) -> doRegexInput 2 closeRegex closeRegex u _ | inCloseRegex (u ^. uvWorld) -> u & uvWorld . hud . hudElement . diSections %~ doRegexInput u 2
_ -> M.foldlWithKey' updateKeyInGame u pkeys _ -> M.foldlWithKey' updateKeyInGame u pkeys
where where
w = u ^. uvWorld w = u ^. uvWorld
@@ -80,11 +81,21 @@ maybeExitCombine u
| otherwise = u & uvWorld . hud . hudElement . subInventory .~ NoSubInventory | otherwise = u & uvWorld . hud . hudElement . subInventory .~ NoSubInventory
doTextInputOver :: ASetter' Universe String -> Universe -> Universe doTextInputOver :: ASetter' Universe String -> Universe -> Universe
doTextInputOver p u = doTextInputOver p u = doTextInputOver' u p u
u & p %~ (++ map toUpper thetext) -- u & p %~ (++ map toUpper thetext)
-- & checkBackspace
-- where
-- thetext = u ^. uvWorld . input . textInput
-- checkBackspace
-- | backspaceInputted u = p %~ doBackspace
-- | otherwise = id
doTextInputOver' :: Universe -> ASetter' a String -> a -> a
doTextInputOver' u p x =
x & p %~ (++ map toUpper str)
& checkBackspace & checkBackspace
where where
thetext = u ^. uvWorld . input . textInput str = u ^. uvWorld . input . textInput
checkBackspace checkBackspace
| backspaceInputted u = p %~ doBackspace | backspaceInputted u = p %~ doBackspace
| otherwise = id | otherwise = id
@@ -99,68 +110,22 @@ backspaceInputted u = case u ^. uvWorld . input . pressedKeys . at ScancodeBacks
Just LongPress -> True Just LongPress -> True
_ -> False _ -> False
doSubInvRegexInput :: Universe -> Universe doRegexInput :: Universe -> Int -> FilterableSections a -> FilterableSections a
doSubInvRegexInput u doRegexInput u i fss
| backspacetonothing = | backspacetonothing || escapekey = endregex i 0
u & uvWorld . hud . hudElement . subInventory . ciRegex .~ Nothing | endkeys || endmouse = endregex (i + 1) (j -1)
-- & uvWorld . hud . hudElement . subInventory . subInvMap %~ initialSelPos | otherwise = fss & doTextInputOver' u (fssFilters . ix i . _Just)
-- & uvWorld . hud . hudElement . subInventory . subInvMap %~ setShownIntMap
| endkeys || endmouse = u
-- u & uvWorld . hud . hudElement . subInventory . subInvMap %~ initialSelPos
| otherwise =
u & doTextInputOver (uvWorld . hud . hudElement . subInventory . ciRegex . _Just)
-- & uvWorld . hud . hudElement . subInventory . subInvMap %~ setShownIntMap
where where
endkeys = endregex a b =
any fss
((== Just InitialPress) . (`M.lookup` pkeys)) & fssFilters . ix i .~ Nothing
[ScancodeReturn, ScancodeEscape, ScancodeSlash] & fssSections
endmouse = Just True == (u ^? uvWorld . input . mouseButtons . ix ButtonLeft)
backspacetonothing =
u ^? uvWorld . hud . hudElement . subInventory . ciRegex . _Just == Just ""
&& ScancodeBackspace `M.lookup` pkeys == Just InitialPress
pkeys = u ^. uvWorld . input . pressedKeys
--doRegexInput ::
-- Int ->
-- ( (Maybe String -> Identity (Maybe String)) ->
-- Manipulation ->
-- Identity Manipulation
-- ) ->
-- ( ( Maybe String ->
-- Const (First String) (Maybe String)
-- ) ->
-- Manipulation ->
-- Const (First String) Manipulation
-- ) ->
-- Universe ->
-- Universe
doRegexInput :: Int
-> ((Maybe String -> Identity (Maybe String))
-> HUDElement -> Identity HUDElement)
-> ((Maybe String
-> Const (Data.Monoid.First String) (Maybe String))
-> HUDElement -> Const (Data.Monoid.First String) HUDElement)
-> Universe
-> Universe
doRegexInput i crregex crregex' u
| backspacetonothing || escapekey = closeregex i 0
| endkeys || endmouse = closeregex (i + 1) (j -1)
| otherwise =
u
& doTextInputOver
(uvWorld . hud . hudElement . crregex . _Just)
where
closeregex a b =
u
& uvWorld . hud . hudElement . crregex .~ Nothing
& uvWorld . hud . hudElement . diSections
%~ ( ssSetCursor (ssLookupDown a b) %~ ( ssSetCursor (ssLookupDown a b)
. overSection (ssItems . at i .~ Nothing) . (sssSections . ix i . ssItems .~ mempty)
) )
& uvWorld %~ setInvPosFromSS -- & uvWorld %~ setInvPosFromSS
j = fromMaybe 0 $ do j = fromMaybe 0 $ do
itms <- u ^? uvWorld . hud . hudElement . diSections . sssSections . ix (i + 1) . ssItems itms <- fss ^? fssSections . sssSections . ix (i + 1) . ssItems
fst <$> IM.lookupMin itms fst <$> IM.lookupMin itms
escapekey = ScancodeEscape `M.lookup` pkeys == Just InitialPress escapekey = ScancodeEscape `M.lookup` pkeys == Just InitialPress
endkeys = endkeys =
@@ -169,7 +134,7 @@ doRegexInput i crregex crregex' u
[ScancodeReturn, ScancodeSlash] [ScancodeReturn, ScancodeSlash]
endmouse = Just True == (u ^? uvWorld . input . mouseButtons . ix ButtonLeft) endmouse = Just True == (u ^? uvWorld . input . mouseButtons . ix ButtonLeft)
backspacetonothing = backspacetonothing =
u ^? uvWorld . hud . hudElement . crregex' . _Just == Just "" fss ^? fssFilters . ix i . _Just == Just ""
&& ScancodeBackspace `M.lookup` pkeys == Just InitialPress && ScancodeBackspace `M.lookup` pkeys == Just InitialPress
pkeys = u ^. uvWorld . input . pressedKeys pkeys = u ^. uvWorld . input . pressedKeys
@@ -228,34 +193,24 @@ updateLongPressInGame uv sc = case sc of
ScancodeSpace -> over uvWorld spaceAction uv ScancodeSpace -> over uvWorld spaceAction uv
_ -> uv _ -> uv
-- doesn't seem to set cursor positioning
updateBackspaceRegex :: World -> World updateBackspaceRegex :: World -> World
updateBackspaceRegex w = case di ^? subInventory of updateBackspaceRegex w = case di ^? subInventory of
Just NoSubInventory | secfocus (-1) 0 -> w & trybackspace Just NoSubInventory | secfocus (-1) 0 -> w & hud . hudElement . diSections %~ trybackspace (-1)
Just NoSubInventory | secfocus 2 3 -> w & trybackspaceclose Just NoSubInventory | secfocus 2 3 -> w & hud . hudElement . diSections %~ trybackspace 2
Just CombineInventory{} -> w & hud . hudElement . subInventory %~ trybackspacecomb Just CombineInventory{} -> w & hud . hudElement . subInventory . ciSections %~ trybackspace (-1)
_ -> w _ -> w
where where
secfocus a b = fromMaybe False $ do secfocus a b = fromMaybe False $ do
i <- di ^? diSections . sssSelPos . _Just . _1 i <- di ^? diSections . fssSections . sssSelPos . _Just . _1
return $ i == a || i == b return $ i == a || i == b
trybackspacecomb ci = case ci ^? ciRegex . _Just of trybackspace x fss = fromMaybe fss $ do
Just (_ : _) -> -- i <- fss ^? fssSections . sssSelPos . _Just . _1
ci & ciRegex . _Just %~ init -- guard (i == x || i == x+1)
Just [] -> ci & ciRegex .~ Nothing str <- fss ^? fssFilters . ix x . _Just
Nothing -> ci return $ case str of
trybackspace w' = case w' ^? hud . hudElement . invRegex . _Just of (_ : _) -> fss & fssFilters . ix x . _Just %~ init
Just (_ : _) -> & fssSections . sssSelPos ?~ (x,0)
w' & hud . hudElement . invRegex . _Just %~ init [] -> fss & fssFilters . ix x .~ Nothing
& cWorld . lWorld . creatures . ix 0 . crManipulation . manObject .~ InInventory SortInventory
Just [] -> w' & hud . hudElement . invRegex .~ Nothing
Nothing -> w'
trybackspaceclose w' = case w' ^? hud . hudElement . closeRegex . _Just of
Just (_ : _) ->
w' & hud . hudElement . closeRegex . _Just %~ init
& cWorld . lWorld . creatures . ix 0 . crManipulation . manObject .~ InNearby SortNearby
Just [] -> w' & hud . hudElement . closeRegex .~ Nothing
Nothing -> w'
di = w ^. hud . hudElement di = w ^. hud . hudElement
updateEnterRegex :: World -> World updateEnterRegex :: World -> World
@@ -264,26 +219,26 @@ updateEnterRegex w = case w ^? hud . hudElement . subInventory of
| secfocus (-1) 0 -> | secfocus (-1) 0 ->
w & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject w & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject
.~ InInventory SortInventory .~ InInventory SortInventory
& hud . hudElement . invRegex %~ enterregex & hud . hudElement . diSections . fssFilters . ix (-1) %~ enterregex
Just NoSubInventory Just NoSubInventory
| secfocus 2 3 -> | secfocus 2 3 ->
w & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject .~ InNearby SortNearby w & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject .~ InNearby SortNearby
& hud . hudElement . closeRegex %~ enterregex & hud . hudElement . diSections . fssFilters . ix 2 %~ enterregex
Just CombineInventory{} -> w & hud . hudElement . subInventory Just CombineInventory{} -> w & hud . hudElement . subInventory . ciSections . fssFilters . ix (-1)
%~ ( ciRegex %~ enterregex ) %~ enterregex
_ -> w _ -> w
where where
di = w ^. hud . hudElement di = w ^. hud . hudElement
secfocus a b = fromMaybe False $ do secfocus a b = fromMaybe False $ do
i <- di ^? diSections . sssSelPos . _Just . _1 i <- di ^? diSections . fssSections . sssSelPos . _Just . _1
return $ i == a || i == b return $ i == a || i == b
enterregex Nothing = Just "" enterregex Nothing = Just ""
enterregex x = x enterregex x = x
overSection :: (SelectionSection a -> SelectionSection a) -> SelectionSections a -> SelectionSections a --overSection :: (SelectionSection a -> SelectionSection a) -> SelectionSections a -> SelectionSections a
overSection f sss = fromMaybe sss $ do --overSection f sss = fromMaybe sss $ do
i <- sss ^? sssSelPos . _Just . _1 -- i <- sss ^? sssSelPos . _Just . _1
return $ sss & sssSections . ix i %~ f -- return $ sss & sssSections . ix i %~ f
pauseGame :: Universe -> Universe pauseGame :: Universe -> Universe
pauseGame u = u & uvScreenLayers .~ [pauseMenu u] pauseGame u = u & uvScreenLayers .~ [pauseMenu u]
@@ -306,8 +261,7 @@ spaceAction w = case w ^?! hud . hudElement of
toggleMap :: Universe -> Universe toggleMap :: Universe -> Universe
toggleMap u = case u ^?! uvWorld . hud . hudElement of toggleMap u = case u ^?! uvWorld . hud . hudElement of
DisplayCarte -> u & uvWorld . hud . hudElement DisplayCarte -> u & uvWorld . hud . hudElement
.~ DisplayInventory{_subInventory = NoSubInventory, _diSections = defaultInvSections .~ DisplayInventory{_subInventory = NoSubInventory, _diSections = defaultFiltInv}
, _invRegex = Nothing, _closeRegex = Nothing}
_ -> u & uvWorld . hud . hudElement .~ DisplayCarte _ -> u & uvWorld . hud . hudElement .~ DisplayCarte
toggleTweakInv :: World -> World toggleTweakInv :: World -> World
src/Dodge/Update/Scroll.hs
+1 -1
View File
@@ -49,7 +49,7 @@ updateWheelEvent yi w = case w ^. hud . hudElement of
invKeyDown = ScancodeCapsLock `M.member` _pressedKeys (_input w) invKeyDown = ScancodeCapsLock `M.member` _pressedKeys (_input w)
moveCombineSel :: Int -> World -> World moveCombineSel :: Int -> World -> World
moveCombineSel yi = hud . hudElement . subInventory . ciSections moveCombineSel yi = hud . hudElement . subInventory . ciSections . fssSections
%~ scrollSelectionSections yi %~ scrollSelectionSections yi
moveSubSel :: Int -> Int -> World -> World moveSubSel :: Int -> Int -> World -> World