From 4904c57972307ca6cd967620c8f245639c4a126d Mon Sep 17 00:00:00 2001 From: justin Date: Tue, 21 Feb 2023 01:24:22 +0000 Subject: [PATCH] Reorganise/cleanup --- src/Dodge/Combine.hs | 7 +++- src/Dodge/Data/HUD.hs | 4 +- src/Dodge/Data/SelectionList.hs | 22 +++++------ src/Dodge/Default/World.hs | 22 +++++------ src/Dodge/DisplayInventory.hs | 46 ++++++++++++----------- src/Dodge/InputFocus.hs | 66 ++++++++++++--------------------- src/Dodge/Inventory.hs | 12 +++--- src/Dodge/Render/HUD.hs | 18 ++++----- src/Dodge/SelectionSections.hs | 12 +++--- src/Dodge/TestString.hs | 2 +- src/Dodge/Update.hs | 2 +- src/Dodge/Update/Input.hs | 44 +++++++++++----------- src/Dodge/Update/Scroll.hs | 2 +- 13 files changed, 119 insertions(+), 140 deletions(-) diff --git a/src/Dodge/Combine.hs b/src/Dodge/Combine.hs index eeed56d25..aee5854a9 100644 --- a/src/Dodge/Combine.hs +++ b/src/Dodge/Combine.hs @@ -140,7 +140,7 @@ toggleCombineInv uv = case uv ^? uvWorld . hud . hudElement . subInventory of enterCombineInv :: Configuration -> World -> World enterCombineInv cfig w = w & hud . hudElement . subInventory .~ CombineInventory cm' - FilterableSections {_fssFilters=IM.singleton (-1) Nothing,_fssSections = sss} + sss --(updateCombineSelections w cfig sss) where cm' = IM.fromAscList $ zip [0..] $ combineList' w @@ -148,7 +148,10 @@ enterCombineInv cfig w = w & hud . hudElement . subInventory .~ CombineInventory | otherwise = cm' sss = SelectionSections { _sssSections = IM.fromDistinctAscList [(-1,filtsection),(0,combsection)] - , _sssSelPos = selpos + , _sssExtra = SSSExtra + {_sssSelPos = selpos + , _sssFilters=IM.singleton (-1) Nothing + } } selpos | null cm' = Nothing | otherwise = Just (0,0) diff --git a/src/Dodge/Data/HUD.hs b/src/Dodge/Data/HUD.hs index e0aa73e3e..9db7932cd 100644 --- a/src/Dodge/Data/HUD.hs +++ b/src/Dodge/Data/HUD.hs @@ -16,7 +16,7 @@ import Data.IntMap.Strict (IntMap) data HUDElement = DisplayInventory { _subInventory :: SubInventory - , _diSections :: FilterableSections () + , _diSections :: SelectionSections () } | DisplayCarte @@ -25,7 +25,7 @@ data SubInventory | ExamineInventory {_subInvMSel :: Maybe Int} -- | CombineInventory {_subInvMap :: SelectionIntMap CombinableItem} | CombineInventory {_ciCombinations :: IntMap (SelectionItem CombinableItem) - , _ciSections :: FilterableSections CombinableItem + , _ciSections :: SelectionSections CombinableItem } | LockedInventory | DisplayTerminal {_termID :: Int} diff --git a/src/Dodge/Data/SelectionList.hs b/src/Dodge/Data/SelectionList.hs index f9157d1b1..a348e9256 100644 --- a/src/Dodge/Data/SelectionList.hs +++ b/src/Dodge/Data/SelectionList.hs @@ -30,23 +30,19 @@ data SelectionList a = SelectionList } --deriving (Eq, Ord, Show, Read) --Generic, Flat) --- this is projected to be VERY arbitrary: the fssFilters point to the lower of --- a pair of ints (i,i+1) such that the lower is the regex section, the higher --- is the items section. -data FilterableSections a = FilterableSections - { _fssFilters :: IntMap (Maybe String) - , _fssSections :: SelectionSections a - } data SelectionSections a = SelectionSections { _sssSections :: IntMap (SelectionSection a) - , _sssSelPos :: Maybe (Int,Int) + , _sssExtra :: SSSExtra } ---data SSSExtra :: SSSExtra --- { _sssSelPos :: Maybe (Int,Int) --- , _sssFilters :: IntMap (Maybe String --- } +-- note that filters are arbitrary: the sssFilters point to the lower of +-- a pair of ints (i,i+1) such that the lower is the regex section, the higher +-- is the items section. +data SSSExtra = SSSExtra + { _sssSelPos :: Maybe (Int,Int) + , _sssFilters :: IntMap (Maybe String) + } data SectionCursor = SectionCursor { _scurPos :: Int @@ -100,7 +96,7 @@ makeLenses ''SelectionList makeLenses ''SelectionItem makeLenses ''SelectionSection makeLenses ''SelectionSections -makeLenses ''FilterableSections +makeLenses ''SSSExtra makeLenses ''SectionCursor --deriveJSON defaultOptions ''SelectionItem --deriveJSON defaultOptions ''SelectionList diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index d52d6257c..95c9e2c17 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -143,11 +143,11 @@ defaultLWorld = , _lClock = 0 } -defaultDisplaySections :: SelectionSections a -defaultDisplaySections = SelectionSections - { _sssSections = mempty - , _sssSelPos = Just (0,0) - } +--defaultDisplaySections :: SelectionSections a +--defaultDisplaySections = SelectionSections +-- { _sssSections = mempty +-- , _sssSelPos = Just (0,0) +-- } defaultHUD :: HUD defaultHUD = @@ -162,7 +162,7 @@ defaultHUD = defaultDisplayInventory :: HUDElement defaultDisplayInventory = DisplayInventory {_subInventory = NoSubInventory - , _diSections = defaultFiltInv + , _diSections = defaultInvSections -- , _invRegex = Nothing -- , _closeRegex = Nothing } @@ -179,10 +179,10 @@ defaultDisplayInventory = DisplayInventory -- where -- f (V2 x y) = V3 x y 100 -defaultFiltInv :: FilterableSections () -defaultFiltInv = FilterableSections - {_fssFilters = IM.fromList [(-1,mempty),(2,mempty)] - ,_fssSections =defaultInvSections +defaultSSSExtra :: SSSExtra +defaultSSSExtra = SSSExtra + {_sssFilters = IM.fromList [(-1,mempty),(2,mempty)] + ,_sssSelPos = Nothing } defaultInvSections :: SelectionSections () @@ -195,7 +195,7 @@ defaultInvSections = SelectionSections & ssDescriptor .~ "NEARBY") , defaultCOSection ] - , _sssSelPos = Nothing + , _sssExtra = defaultSSSExtra } defaultSS :: SelectionSection a defaultSS = SelectionSection diff --git a/src/Dodge/DisplayInventory.hs b/src/Dodge/DisplayInventory.hs index f5ad63202..7ee3c7a0b 100644 --- a/src/Dodge/DisplayInventory.hs +++ b/src/Dodge/DisplayInventory.hs @@ -3,7 +3,7 @@ module Dodge.DisplayInventory ( updateDisplayInventory , defaultSS , defaultFiltSection - , defaultDisplaySections +-- , defaultDisplaySections , updateSection ) where @@ -26,8 +26,8 @@ import Dodge.Data.World updateDisplayInventory :: World -> Configuration -> SelectionSections () -> SelectionSections () updateDisplayInventory w cfig sss = case cr ^? crManipulation . manObject of - Just mo -> updateSectionsPositioning - (sss & sssSelPos ?~ manObjIndex mo) + Just mo -> sss & sssSections %~ updateSectionsPositioning + (sss ^. sssExtra . sssSelPos) availablelines (addorder mo) _ -> error "error when getting cr inv sel" @@ -38,8 +38,8 @@ updateDisplayInventory w cfig sss = case cr ^? crManipulation . manObject of SelNothing -> reverse [filtinv,filtclose,invx ,youx, closex] InNearby SortNearby -> reverse [filtinv,filtclose,closex, invx ,youx] InNearby SelCloseObject {} -> reverse [filtinv,filtclose,closex, invx ,youx] - (filtinv,invx) = filtpair (-1) (hud . hudElement . diSections . fssFilters . ix (-1) . _Just) invitems' "INV. " - (filtclose,closex) = filtpair 2 (hud . hudElement . diSections . fssFilters . ix 2 . _Just) coitems' "NEARBY " + (filtinv,invx) = filtpair (-1) (hud . hudElement . diSections . sssExtra . sssFilters . ix (-1) . _Just) invitems' "INV. " + (filtclose,closex) = filtpair 2 (hud . hudElement . diSections . sssExtra . sssFilters . ix 2 . _Just) coitems' "NEARBY " youx = (1, youitems) youitems = IM.singleton 0 $ SelectionItem [thetext] 1 True invDimColor 2 () thetext = displayFreeSlots nfreeslots @@ -72,31 +72,33 @@ displayFreeSlots x = case x of _ -> show x ++ " FREE SLOTS" updateSectionsPositioning - :: SelectionSections a - -> Int -> [(Int,IM.IntMap (SelectionItem a))] - -> SelectionSections a -updateSectionsPositioning sss _ [] = sss & sssSections .~ mempty -updateSectionsPositioning sss allavailablelines ((k,y) : xs) - = previoussections & sssSections %~ IM.insert k ss + :: Maybe (Int,Int) + -> Int + -> [(Int,IM.IntMap (SelectionItem a))] + -> IM.IntMap (SelectionSection a) + -> IM.IntMap (SelectionSection a) +updateSectionsPositioning _ _ [] _ = mempty +updateSectionsPositioning mselpos allavailablelines ((k,y) : xs) sss + = IM.insert k ss previoussections where mscel = do - (i,j) <- sss ^? sssSelPos . _Just + (i,j) <- mselpos guard $ i == k return j ss = updateSection y mscel linesleft x - x = sss ^?! sssSections . ix k + x = sss ^?! ix k availablelines = allavailablelines - _ssMinSize x - linesleft = allavailablelines - sum (fmap linestaken $ _sssSections previoussections) + linesleft = allavailablelines - sum (fmap linestaken $ previoussections) linestaken ss' = max (length $ _ssShownItems ss') (_ssMinSize ss') - previoussections = updateSectionsPositioning sss availablelines xs + previoussections = updateSectionsPositioning mselpos availablelines xs sss -manObjIndex :: ManipulatedObject -> (Int,Int) -manObjIndex mo = case mo of - InInventory SortInventory -> (-1, 0) - InInventory (SelItem i _) -> (0, i) - SelNothing -> (1,0) - InNearby SortNearby -> (2,0) - InNearby (SelCloseObject i) -> (3,i) +--manObjIndex :: ManipulatedObject -> (Int,Int) +--manObjIndex mo = case mo of +-- InInventory SortInventory -> (-1, 0) +-- InInventory (SelItem i _) -> (0, i) +-- SelNothing -> (1,0) +-- InNearby SortNearby -> (2,0) +-- InNearby (SelCloseObject i) -> (3,i) updateSection :: IM.IntMap (SelectionItem a) diff --git a/src/Dodge/InputFocus.hs b/src/Dodge/InputFocus.hs index 7b6ff5f8e..3617cf55f 100644 --- a/src/Dodge/InputFocus.hs +++ b/src/Dodge/InputFocus.hs @@ -11,7 +11,7 @@ module Dodge.InputFocus ( ) where import Control.Monad -import Data.IntMap.Strict (IntMap) +--import Data.IntMap.Strict (IntMap) import Data.Maybe import Dodge.Data.SelectionList import Dodge.Data.World @@ -25,57 +25,39 @@ inTermFocus w = fromMaybe False $ do return $ hasfocus && connectionstatus == TerminalReady regexScope :: - (Applicative f1, Applicative f2, Num c) => + (Applicative f) => World -> Maybe - ( ( IntMap (Maybe String) -> - f1 (IntMap (Maybe String)) - ) -> - HUDElement -> - f1 HUDElement - , (Maybe (Int, Int) -> f2 (Maybe (Int, Int))) -> - HUDElement -> - f2 HUDElement - , c - ) + ((SSSExtra -> f SSSExtra) -> HUDElement -> f HUDElement, Int) regexScope w = case w ^? hud . hudElement . subInventory of - Just NoSubInventory -> case he ^? diSections . fssSections . sssSelPos . _Just of + Just NoSubInventory -> case he ^? diSections . sssExtra . sssSelPos . _Just of Just (-1, _) -> di (-1) Just (0, _) -> di (-1) Just (2, _) -> di 2 Just (3, _) -> di 2 _ -> Nothing Just CombineInventory{} -> - Just (subInventory . ciSections . fssFilters, subInventory . ciSections . fssSections . sssSelPos, (-1)) + Just (subInventory . ciSections . sssExtra, (-1)) _ -> Nothing where - di x = Just (diSections . fssFilters, diSections . fssSections . sssSelPos, x) + di x = Just (diSections . sssExtra, x) he = w ^. hud . hudElement regexFocus :: - (Applicative f1, Applicative f2, Num c) => + (Applicative f) => World -> Maybe - ( ( IntMap (Maybe String) -> - f1 (IntMap (Maybe String)) - ) -> - HUDElement -> - f1 HUDElement - , (Maybe (Int, Int) -> f2 (Maybe (Int, Int))) -> - HUDElement -> - f2 HUDElement - , c - ) + ((SSSExtra -> f SSSExtra) -> HUDElement -> f HUDElement, Int) regexFocus w = case w ^? hud . hudElement . subInventory of - Just NoSubInventory -> case he ^? diSections . fssSections . sssSelPos . _Just of + Just NoSubInventory -> case he ^? diSections . sssExtra . sssSelPos . _Just of Just (-1, _) -> di (-1) Just (2, _) -> di 2 _ -> Nothing Just CombineInventory{} -> - Just (subInventory . ciSections . fssFilters, subInventory . ciSections . fssSections . sssSelPos, (-1)) + Just (subInventory . ciSections . sssExtra, (-1)) _ -> Nothing where - di x = Just (diSections . fssFilters, diSections . fssSections . sssSelPos, x) + di x = Just (diSections . sssExtra, x) he = w ^. hud . hudElement inInputFocus :: World -> Bool @@ -89,12 +71,12 @@ inputFocus :: World -> Maybe ((String -> f String) -> World -> f World) inputFocus w = case w ^? hud . hudElement . subInventory of - Just NoSubInventory -> case he ^? diSections . fssSections . sssSelPos . _Just of + Just NoSubInventory -> case he ^? diSections . sssExtra . sssSelPos . _Just of Just (-1, _) -> di (-1) Just (2, _) -> di 2 _ -> Nothing - Just CombineInventory{} -> case he ^? subInventory . ciSections . fssSections . sssSelPos . _Just of - Just (-1, _) -> Just $ hud . hudElement . subInventory . ciSections . fssFilters . ix (-1) . _Just + Just CombineInventory{} -> case he ^? subInventory . ciSections . sssExtra . sssSelPos . _Just of + Just (-1, _) -> Just $ hud . hudElement . subInventory . ciSections . sssExtra . sssFilters . ix (-1) . _Just _ -> Nothing Just DisplayTerminal{_termID = tmid} -> do hasfocus <- w ^? cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus @@ -103,25 +85,23 @@ inputFocus w = case w ^? hud . hudElement . subInventory of return $ cWorld . lWorld . terminals . ix tmid . tmInput . tiText _ -> Nothing where - di x = Just $ hud . hudElement . diSections . fssFilters . ix x . _Just + di x = Just $ hud . hudElement . diSections . sssExtra . sssFilters . ix x . _Just he = w ^. hud . hudElement +inTopRegex :: Int -> World -> Bool +inTopRegex x w = fromMaybe False $ do + i <- w ^? hud . hudElement . diSections . sssExtra . sssSelPos . _Just . _1 + return $ i == x + inInvRegex :: World -> Bool -inInvRegex w = fromMaybe False $ do - sss <- w ^? hud . hudElement . diSections . fssSections - i <- sss ^? sssSelPos . _Just . _1 - return $ i == (-1) +inInvRegex = inTopRegex (-1) inCloseRegex :: World -> Bool -inCloseRegex w = fromMaybe False $ do - sss <- w ^? hud . hudElement . diSections . fssSections - i <- sss ^? sssSelPos . _Just . _1 - return $ i == 2 +inCloseRegex = inTopRegex 2 inSubInvRegex :: World -> Bool inSubInvRegex w = fromMaybe False $ do - sss <- w ^? hud . hudElement . subInventory . ciSections . fssSections - i <- sss ^? sssSelPos . _Just . _1 + i <- w ^? hud . hudElement . subInventory . ciSections . sssExtra . sssSelPos . _Just . _1 return $ i == (-1) --inputFocus :: World -> Bool diff --git a/src/Dodge/Inventory.hs b/src/Dodge/Inventory.hs index c499b8d4f..f0bcd6a7b 100644 --- a/src/Dodge/Inventory.hs +++ b/src/Dodge/Inventory.hs @@ -106,7 +106,7 @@ rmSelectedInvItem cid w = case w ^? cWorld . lWorld . creatures . ix cid . crMan Nothing -> w selNumPos :: ManipulatedObject -> World -> Maybe Int -selNumPos mo w = w ^? hud . hudElement . diSections . fssSections >>= +selNumPos mo w = w ^? hud . hudElement . diSections >>= case mo of InInventory SortInventory -> selSecSelPos (-1) 0 InInventory (SelItem i _) -> selSecSelPos 0 i @@ -164,7 +164,7 @@ updateCloseObjects w = = case w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject. inNearby . ispCloseObject of Just i | i >= length newcloseobjects -> scrollAugInvSel 1 - | isNothing (w ^? hud . hudElement . diSections . fssSections . sssSections . ix 3 . ssItems . ix i) + | 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 @@ -346,7 +346,7 @@ scrollAugInvSel :: Int -> World -> World scrollAugInvSel yi w | yi == 0 = w | otherwise = - w & hud . hudElement . diSections . fssSections %~ scrollSelectionSections yi + w & hud . hudElement . diSections %~ scrollSelectionSections yi & setInvPosFromSS setInvPosFromSS :: World -> World @@ -354,8 +354,8 @@ setInvPosFromSS w = w & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject .~ thesel where thesel = fromMaybe SelNothing $ do - sss <- w ^? hud . hudElement . diSections . fssSections - (i,j) <- sss ^? sssSelPos . _Just + sss <- w ^? hud . hudElement . diSections + (i,j) <- sss ^? sssExtra . sssSelPos . _Just case i of (-1) -> Just $ InInventory SortInventory 0 -> Just $ InInventory (SelItem j NoInvSelAction) @@ -368,5 +368,5 @@ setInvPosFromSS w = w selectedCloseObject :: World -> Maybe (Either FloorItem Button) selectedCloseObject w = do i <- you w ^? crManipulation . manObject . inNearby . ispCloseObject - <|> fmap fst (IM.lookupMin =<< w ^? hud . hudElement . diSections . fssSections . sssSections . ix 3 . ssItems) + <|> fmap fst (IM.lookupMin =<< w ^? hud . hudElement . diSections . sssSections . ix 3 . ssItems) w ^? hud . closeObjects . ix i diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index 2f75943b6..0b207e939 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -38,7 +38,7 @@ drawHUD cfig w = case w ^. hud . hudElement of DisplayCarte -> drawCarte cfig w DisplayInventory {_diSections = sections, _subInventory = subinv} -> drawHP cfig w - <> inventoryDisplay (sections ^. fssSections) w cfig + <> inventoryDisplay sections w cfig <> drawSubInventory subinv cfig w drawHP :: Configuration -> World -> Picture @@ -80,7 +80,7 @@ drawSelectionSections sss ldps cfig = listPicturesAtScaleOff <> thecursor' where thecursor' = fromMaybe mempty $ do - (i,j) <- sss ^? sssSelPos . _Just + (i,j) <- sss ^? sssExtra . sssSelPos . _Just return $ selSecDrawCursor 15 [North,South,West] cfig ldps sss i j pics = foldMap _ssShownItems (_sssSections sss) @@ -93,7 +93,7 @@ drawSubInventory subinv cfig w = case subinv of NoSubInventory -> drawNoSubInventory cfig w ExamineInventory mtweaki -> drawExamineInventory cfig mtweaki w DisplayTerminal tid -> displayTerminal tid cfig (w ^. cWorld . lWorld) - CombineInventory {_ciSections = FilterableSections {_fssSections = sss}} + CombineInventory {_ciSections = sss} -> titledSub' cfig "COMBINE" sss <> combineInventoryExtra sss cfig w @@ -156,11 +156,11 @@ drawNoSubInventory cfig w = where equipcursor = fromMaybe mempty $ do invid <- cr ^. crLeftInvSel . lisMPos - sss <- w ^? hud . hudElement . diSections . fssSections + sss <- w ^? hud . hudElement . diSections pos <- selSecSelPos 0 invid sss return $ listTextPictureAt 144 0 cfig pos . color cyan . text . eqPosText $_crInvEquipped cr IM.! invid f col invid epos = fromMaybe mempty $ do - sss <- w ^? hud . hudElement . diSections . fssSections + sss <- w ^? hud . hudElement . diSections pos <- selSecSelPos 0 invid sss return $ listTextPictureAt 144 0 cfig pos . color col $ text $ eqPosText epos equipcursors = IM.foldMapWithKey (f yellow) (_crInvEquipped cr) @@ -179,7 +179,7 @@ examineInventoryExtra mtweaki mitm cfig = fromMaybe mempty $ do combineInventoryExtra :: SelectionSections CombinableItem -> Configuration -> World -> Picture combineInventoryExtra sss cfig w = fromMaybe mempty $ do - (i,j) <- sss ^? sssSelPos . _Just + (i,j) <- sss ^? sssExtra . sssSelPos . _Just si <- sss ^? sssSections . ix i . ssItems . ix j cpos <- selSecSelPos i j sss let col = _siColor si @@ -197,7 +197,7 @@ combineInventoryExtra sss cfig w = fromMaybe mempty $ do ] where invcursor i = fromMaybe mempty $ do - sss' <- w ^? hud . hudElement . diSections . fssSections + sss' <- w ^? hud . hudElement . diSections return $ selSecDrawCursor 17 [North,South,East] cfig (invDisplayParams w) sss' 0 i -- fromMaybe mempty $ do -- i <- mi @@ -324,7 +324,7 @@ combineCounts cfig w = winScale cfig . foldMap f . group where f (i : is) = fromMaybe mempty $ do _ <- yourInv w ^? ix i . itUse . useAmount - sss <- w ^? hud . hudElement . diSections . fssSections + sss <- w ^? hud . hudElement . diSections p <- selNumTextEndPos cfig (invDisplayParams w) sss 0 i col <- selSecSelCol 0 i sss return $ color col $ uncurryV translate p . scale 0.1 0.1 . text $ ('-' : show (length is + 1)) @@ -335,7 +335,7 @@ lnkMidPosInvSelsCol cfig w i col = winScale cfig . foldMap f where f j = fromMaybe mempty $ do - sss <- w ^? hud . hudElement . diSections . fssSections + sss <- w ^? hud . hudElement . diSections h <- selNumEndMidHeight cfig (invDisplayParams w) sss 0 j invcol <- selSecSelCol 0 j sss return $ zConnectCol rp (V2 18 0 + h) col white white invcol diff --git a/src/Dodge/SelectionSections.hs b/src/Dodge/SelectionSections.hs index 457e4a2a2..24112526f 100644 --- a/src/Dodge/SelectionSections.hs +++ b/src/Dodge/SelectionSections.hs @@ -23,10 +23,10 @@ scrollSelectionSections yi sss setFirstPosSelectionSections :: SelectionSections a -> SelectionSections a setFirstPosSelectionSections sss = fromMaybe sss $ do (i, j, _) <- ssLookupMin sss - return $ sss & sssSelPos ?~ (i, j) + return $ sss & sssExtra . sssSelPos ?~ (i, j) scrollUpSelectionSections :: SelectionSections a -> SelectionSections a -scrollUpSelectionSections sss = sss & sssSelPos .~ +scrollUpSelectionSections sss = sss & sssExtra . sssSelPos .~ fmap f (ssScrollUp (sss & sssSections %~ fmap (ssItems %~ IM.filter _siIsSelectable))) where f (i,j,_) = (i,j) @@ -35,18 +35,18 @@ ssScrollUp :: SelectionSections a -> Maybe (Int,Int,SelectionItem a) ssScrollUp sss = l <|> ssLookupMin sss where l = do - (i,j) <- sss ^? sssSelPos . _Just + (i,j) <- sss ^? sssExtra . sssSelPos . _Just ssLookupUp i j sss ssScrollDown :: SelectionSections a -> Maybe (Int,Int,SelectionItem a) ssScrollDown sss = l <|> ssLookupMin sss where l = do - (i,j) <- sss ^? sssSelPos . _Just + (i,j) <- sss ^? sssExtra . sssSelPos . _Just ssLookupDown i j sss scrollDownSelectionSections :: SelectionSections a -> SelectionSections a -scrollDownSelectionSections sss = sss & sssSelPos .~ +scrollDownSelectionSections sss = sss & sssExtra . sssSelPos .~ fmap f (ssScrollDown (sss & sssSections %~ fmap (ssItems %~ IM.filter _siIsSelectable))) where f (i,j,_) = (i,j) @@ -61,7 +61,7 @@ ssSetCursor f sss = fromMaybe sss $ do (i, j, _) <- f sss return $ sss - & sssSelPos ?~ (i, j) + & sssExtra . sssSelPos ?~ (i, j) -- & sssSections . ix i . ssCursor ?~ SectionCursor j j (_siHeight si) (_siColor si) diff --git a/src/Dodge/TestString.hs b/src/Dodge/TestString.hs index 13223863e..3eccb7530 100644 --- a/src/Dodge/TestString.hs +++ b/src/Dodge/TestString.hs @@ -10,7 +10,7 @@ import Dodge.Data.Universe import qualified IntMapHelp as IM testStringInit :: Universe -> [String] testStringInit u = - [show $ fmap IM.keys $ u ^? uvWorld . hud . hudElement . diSections . fssSections . sssSections] + [show $ fmap IM.keys $ u ^? uvWorld . hud . hudElement . diSections . sssSections] --[ 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) diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 384a5736f..155d50078 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -82,7 +82,7 @@ updateUniverse u = cfig = u ^. uvConfig updateInventoryDisplay :: Universe -> Universe -updateInventoryDisplay u = u & uvWorld . hud . hudElement . diSections . fssSections +updateInventoryDisplay u = u & uvWorld . hud . hudElement . diSections %~ updateDisplayInventory (_uvWorld u) (_uvConfig u) maybeOpenTerminal :: Universe -> Universe diff --git a/src/Dodge/Update/Input.hs b/src/Dodge/Update/Input.hs index 0f0b22da1..49421099e 100644 --- a/src/Dodge/Update/Input.hs +++ b/src/Dodge/Update/Input.hs @@ -56,7 +56,7 @@ updateUseInputInGame h u = case h of | inTermFocus (_uvWorld u) -> updateKeysInTerminal tmid u | lbinitialpress -> u & uvWorld . cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus %~ const True - CombineInventory {_ciSections = FilterableSections {_fssSections = sss}} + CombineInventory {_ciSections = sss} | inSubInvRegex (u ^. uvWorld) -> u & uvWorld . hud . hudElement . subInventory . ciSections %~ doRegexInput u (-1) | lbinitialpress -> maybeExitCombine $ over uvWorld (tryCombine sss) u -- _ -> case regexFocus w of @@ -73,7 +73,7 @@ updateUseInputInGame h u = case h of tryCombine :: SelectionSections CombinableItem -> World -> World tryCombine sss w = fromMaybe w $ do - (i,j) <- sss ^? sssSelPos . _Just + (i,j) <- sss ^? sssExtra . sssSelPos . _Just CombinableItem is it _ <- sss ^? sssSections . ix i . ssItems . ix j . siPayload return $ createAndSelectItem it $ foldr (rmInvItem 0) w (sort is) @@ -106,22 +106,20 @@ backspaceInputted u = case u ^. uvWorld . input . pressedKeys . at ScancodeBacks Just LongPress -> True _ -> False -doRegexInput :: Universe -> Int -> FilterableSections a -> FilterableSections a -doRegexInput u i fss +doRegexInput :: Universe -> Int -> SelectionSections a -> SelectionSections a +doRegexInput u i sss | backspacetonothing || escapekey = endregex i 0 | endkeys || endmouse = endregex (i + 1) (j -1) - | otherwise = fss & doTextInputOver' u (fssFilters . ix i . _Just) + | otherwise = sss & doTextInputOver' u (sssExtra . sssFilters . ix i . _Just) where endregex a b = - fss - & fssFilters . ix i .~ Nothing - & fssSections - %~ ( ssSetCursor (ssLookupDown a b) - . (sssSections . ix i . ssItems .~ mempty) - ) + sss + & sssExtra . sssFilters . ix i .~ Nothing + & sssSections . ix i . ssItems .~ mempty + & ssSetCursor (ssLookupDown a b) -- & uvWorld %~ setInvPosFromSS j = fromMaybe 0 $ do - itms <- fss ^? fssSections . sssSections . ix (i + 1) . ssItems + itms <- sss ^? sssSections . ix (i + 1) . ssItems fst <$> IM.lookupMin itms escapekey = ScancodeEscape `M.lookup` pkeys == Just InitialPress endkeys = @@ -130,7 +128,7 @@ doRegexInput u i fss [ScancodeReturn, ScancodeSlash] endmouse = Just True == (u ^? uvWorld . input . mouseButtons . ix ButtonLeft) backspacetonothing = - fss ^? fssFilters . ix i . _Just == Just "" + sss ^? sssExtra . sssFilters . ix i . _Just == Just "" && ScancodeBackspace `M.lookup` pkeys == Just InitialPress pkeys = u ^. uvWorld . input . pressedKeys @@ -197,16 +195,16 @@ updateBackspaceRegex w = case di ^? subInventory of _ -> w where secfocus a b = fromMaybe False $ do - i <- di ^? diSections . fssSections . sssSelPos . _Just . _1 + i <- di ^? diSections . sssExtra . sssSelPos . _Just . _1 return $ i == a || i == b - trybackspace x fss = fromMaybe fss $ do + trybackspace x sss = fromMaybe sss $ do -- i <- fss ^? fssSections . sssSelPos . _Just . _1 -- guard (i == x || i == x+1) - str <- fss ^? fssFilters . ix x . _Just + str <- sss ^? sssExtra . sssFilters . ix x . _Just return $ case str of - (_ : _) -> fss & fssFilters . ix x . _Just %~ init - & fssSections . sssSelPos ?~ (x,0) - [] -> fss & fssFilters . ix x .~ Nothing + (_ : _) -> sss & sssExtra . sssFilters . ix x . _Just %~ init + & sssExtra . sssSelPos ?~ (x,0) + [] -> sss & sssExtra . sssFilters . ix x .~ Nothing di = w ^. hud . hudElement updateEnterRegex :: World -> World @@ -225,10 +223,10 @@ updateEnterRegex w = case w ^? hud . hudElement . subInventory of where di = w ^. hud . hudElement secfocus a b = fromMaybe False $ do - i <- di ^? diSections . fssSections . sssSelPos . _Just . _1 + i <- di ^? diSections . sssExtra . sssSelPos . _Just . _1 return $ i == a || i == b - enterregex x fss = fss & fssFilters . ix x %~ f - & fssSections . sssSelPos ?~ (x,0) + enterregex x sss = sss & sssExtra . sssFilters . ix x %~ f + & sssExtra . sssSelPos ?~ (x,0) f Nothing = Just "" f x = x @@ -258,7 +256,7 @@ spaceAction w = case w ^?! hud . hudElement of toggleMap :: Universe -> Universe toggleMap u = case u ^?! uvWorld . hud . hudElement of DisplayCarte -> u & uvWorld . hud . hudElement - .~ DisplayInventory{_subInventory = NoSubInventory, _diSections = defaultFiltInv} + .~ DisplayInventory{_subInventory = NoSubInventory, _diSections = defaultInvSections} _ -> u & uvWorld . hud . hudElement .~ DisplayCarte toggleTweakInv :: World -> World diff --git a/src/Dodge/Update/Scroll.hs b/src/Dodge/Update/Scroll.hs index 24da00fe9..885e13d96 100644 --- a/src/Dodge/Update/Scroll.hs +++ b/src/Dodge/Update/Scroll.hs @@ -49,7 +49,7 @@ updateWheelEvent yi w = case w ^. hud . hudElement of invKeyDown = ScancodeCapsLock `M.member` _pressedKeys (_input w) moveCombineSel :: Int -> World -> World -moveCombineSel yi = hud . hudElement . subInventory . ciSections . fssSections +moveCombineSel yi = hud . hudElement . subInventory . ciSections %~ scrollSelectionSections yi moveSubSel :: Int -> Int -> World -> World