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

Remove intmap over filters

Browse Source
This commit is contained in:
justin
2024-10-25 22:42:23 +01:00
parent d93c548d3c
commit 46ee29f646
7 changed files with 65 additions and 39 deletions
Download Patch File Download Diff File Expand all files Collapse all files
ghcidOutput
+7 -1
View File
@@ -1 +1,7 @@
All good (595 modules, at 22:15:48)
/home/justin/Haskell/loop/src/Dodge/DisplayInventory.hs:(134,16)-(136,62): warning: [GHC-62161] [-Wincomplete-patterns]
Pattern match(es) are non-exhaustive
In a case alternative:
Patterns of type ‘a’ not matched: p where p is not one of {(-1), 2}
|
134 | mstr = case i of
| ^^^^^^^^^...
src/Dodge/Data/HUD.hs
+4 -7
View File
@@ -16,9 +16,10 @@ import Geometry.Data
data HUDElement
= DisplayInventory
{ _subInventory :: SubInventory
, _diSections :: IntMap (SelectionSection ())
, _diSections :: IMSS ()
, _diSelection :: Maybe (Int, Int)
, _diFilters :: IntMap (Maybe String)
, _diInvFilter :: Maybe String
, _diCloseFilter :: Maybe String
, _diSelectionExtra :: Int
}
| DisplayCarte
@@ -38,13 +39,11 @@ data SubInventory
| CombineInventory
{ _ciSections :: IntMap (SelectionSection CombinableItem)
, _ciSelection :: Maybe (Int, Int)
, _ciFilters :: IntMap (Maybe String)
, _ciFilter :: Maybe String
}
| LockedInventory
| DisplayTerminal {_termID :: Int}
-- deriving (Eq, Ord, Show, Read) --Generic, Flat)
data HUD = HUD
{ _hudElement :: HUDElement
, _carteCenter :: Point2
@@ -53,8 +52,6 @@ data HUD = HUD
, _closeObjects :: [Either FloorItem Button]
}
-- deriving (Eq, Ord, Show, Read) --Generic, Flat)
makeLenses ''HUD
makeLenses ''HUDElement
makeLenses ''SubInventory
src/Dodge/Data/SelectionList.hs
+2
View File
@@ -53,6 +53,8 @@ data SelectionSection a = SelectionSection
, _ssDescriptor :: String
}
type IMSS a = IntMap (SelectionSection a)
data SelectionWidth
= FixedSelectionWidth Int
| VariableSelectionWidth (Int -> Int)
src/Dodge/Default/World.hs
+3 -1
View File
@@ -168,7 +168,9 @@ defaultDisplayInventory =
, _diSections = defaultInvSections
, _diSelection = Just (1,0)
, _diSelectionExtra = 0
, _diFilters = IM.fromList [(-1, mempty), (2, mempty)]
-- , _diFilters = IM.fromList [(-1, mempty), (2, mempty)]
, _diInvFilter = mempty
, _diCloseFilter = mempty
}
--defaultSSSExtra :: SSSExtra
src/Dodge/DisplayInventory.hs
+5 -3
View File
@@ -65,7 +65,7 @@ updateCombineSections w cfig =
IM.singleton
0
(SelectionInfo ["COMBINATIONS FILTER: " ++ str, numfiltitems] 2 True white 0)
mstr = w ^? hud . hudElement . subInventory . ciFilters . ix (-1) . _Just
mstr = w ^? hud . hudElement . subInventory . ciFilter . _Just
numfiltitems = " " ++ show (length allcombs - length filtcombs) ++ " FILTERED"
regexCombs :: IM.IntMap (SelectionItem ()) -> SelectionItem CombinableItem -> String -> Bool
@@ -131,7 +131,9 @@ updateDisplaySections w cfig sss =
, (i + 1, itms')
)
where
mstr = w ^? hud . hudElement . diFilters . ix i . _Just
mstr = case i of
(-1) -> w ^? hud . hudElement . diInvFilter . _Just
2 -> w ^? hud . hudElement . diCloseFilter . _Just
filtsis = fromMaybe mempty $ do
str <- mstr
return $
@@ -255,7 +257,7 @@ enterCombineInv cfig w =
.~ CombineInventory
sss
selpos
(IM.singleton (-1) Nothing)
Nothing
where
cm' = IM.fromDistinctAscList . zip [0 ..] $ combineList w
cm
src/Dodge/InputFocus.hs
+3 -4
View File
@@ -68,11 +68,11 @@ inputFocus ::
Maybe ((String -> f String) -> World -> f World)
inputFocus w = case w ^? hud . hudElement . subInventory of
Just NoSubInventory{} -> case he ^? diSelection . _Just of
Just (-1, _) -> di (-1)
Just (2, _) -> di 2
Just (-1, _) -> Just $ hud . hudElement . diInvFilter . _Just
Just (2, _) -> Just $ hud . hudElement . diCloseFilter . _Just
_ -> Nothing
Just CombineInventory{} -> case he ^? subInventory . ciSelection . _Just of
Just (-1, _) -> Just $ hud . hudElement . subInventory . ciFilters . ix (-1) . _Just
Just (-1, _) -> Just $ hud . hudElement . subInventory . ciFilter . _Just
_ -> Nothing
Just DisplayTerminal{_termID = tmid} -> do
hasfocus <- w ^? cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus
@@ -81,7 +81,6 @@ inputFocus w = case w ^? hud . hudElement . subInventory of
return $ cWorld . lWorld . terminals . ix tmid . tmInput . tiText
_ -> Nothing
where
di x = Just $ hud . hudElement . diFilters . ix x . _Just
he = w ^. hud . hudElement
inTopRegex :: Int -> World -> Bool
src/Dodge/Update/Input/InGame.hs
+41 -23
View File
@@ -58,7 +58,7 @@ updateUseInputInGame u = case u ^. uvWorld . hud . hudElement of
_
| inCloseRegex (u ^. uvWorld) ->
--u & uvWorld . hud . hudElement . diSections %~ doRegexInput (u ^. uvWorld . input) 2
u & uvWorld . hud . hudElement %~ dodisplayregexinput 2
u & uvWorld . hud . hudElement %~ dodisplayregexinput' 2
& uvWorld . worldEventFlags . at InventoryChange ?~ ()
& uvWorld %~ setInvPosFromSS
_ -> M.foldlWithKey' updateKeyInGame u pkeys
@@ -69,21 +69,30 @@ updateUseInputInGame u = case u ^. uvWorld . hud . hudElement of
docombineregexinput ci = fromMaybe ci $ do
sss <- ci ^? ciSections
msel <- ci ^? ciSelection
filts <- ci ^? ciFilters
filts <- ci ^? ciFilter
let (sss', msel', filts') = doRegexInput (u ^. uvWorld . input) (-1) sss msel filts
return $
ci & ciSections .~ sss'
& ciSelection .~ msel'
& ciFilters .~ filts'
& ciFilter .~ filts'
dodisplayregexinput x di = fromMaybe di $ do
sss <- di ^? diSections
msel <- di ^? diSelection
filts <- di ^? diFilters
filts <- di ^? diInvFilter
let (sss', msel', filts') = doRegexInput (u ^. uvWorld . input) x sss msel filts
return $
di & diSections .~ sss'
& diSelection .~ msel'
& diFilters .~ filts'
& diInvFilter .~ filts'
dodisplayregexinput' x di = fromMaybe di $ do
sss <- di ^? diSections
msel <- di ^? diSelection
filts <- di ^? diCloseFilter
let (sss', msel', filts') = doRegexInput (u ^. uvWorld . input) x sss msel filts
return $
di & diSections .~ sss'
& diSelection .~ msel'
& diCloseFilter .~ filts'
updatePressedButtonsCarte :: World -> World
updatePressedButtonsCarte w = updatePressedButtonsCarte' (_mouseButtons (_input w)) w
@@ -158,21 +167,21 @@ doRegexInput ::
Int ->
IM.IntMap (SelectionSection a) ->
Maybe (Int, Int) ->
IM.IntMap (Maybe String) ->
(IM.IntMap (SelectionSection a), Maybe (Int, Int), IM.IntMap (Maybe String))
Maybe String ->
(IM.IntMap (SelectionSection a), Maybe (Int, Int), Maybe String)
doRegexInput inp i sss msel filts
| backspacetonothing || escapekey = endregex i 0
| endkeys || endmouse = endregex (i + 1) (j -1)
| otherwise =
( sss
, msel
, filts & doTextInputOver inp (ix i . _Just)
, filts & doTextInputOver inp _Just
)
where
endregex a b =
( sss & ix i . ssItems .~ mempty
, msel & ssSetCursor (ssLookupDown a b) sss
, filts & ix i .~ Nothing
, Nothing
)
j = fromMaybe 0 $ do
itms <- sss ^? ix (i + 1) . ssItems
@@ -184,7 +193,7 @@ doRegexInput inp i sss msel filts
[ScancodeReturn, ScancodeSlash]
endmouse = (Just 0 ==) $ inp ^? mouseButtons . ix ButtonLeft
backspacetonothing =
filts ^? ix i . _Just == Just ""
filts == Just ""
&& ScancodeBackspace `M.lookup` pkeys == Just InitialPress
pkeys = inp ^. pressedKeys
@@ -196,7 +205,7 @@ updateBackspaceRegex w = case di ^? subInventory of
& worldEventFlags . at InventoryChange ?~ ()
Just NoSubInventory{}
| secfocus 2 3 ->
w & hud . hudElement %~ trybackspace 2
w & hud . hudElement %~ trybackspace'' 2
& worldEventFlags . at InventoryChange ?~ ()
Just CombineInventory{} ->
w & hud . hudElement . subInventory %~ trybackspace' (-1)
@@ -207,19 +216,26 @@ updateBackspaceRegex w = case di ^? subInventory of
i <- di ^? diSelection . _Just . _1
return $ i == a || i == b
trybackspace x he = fromMaybe he $ do
str <- he ^? diFilters . ix x . _Just
str <- he ^? diInvFilter . _Just
return $ case str of
(_ : _) ->
he & diFilters . ix x . _Just %~ init
he & diInvFilter . _Just %~ init
& diSelection ?~ (x, 0)
[] -> he & diFilters . ix x .~ Nothing
trybackspace' x ci = fromMaybe ci $ do
str <- ci ^? ciFilters . ix x . _Just
[] -> he & diInvFilter .~ Nothing
trybackspace'' x he = fromMaybe he $ do
str <- he ^? diCloseFilter . _Just
return $ case str of
(_ : _) ->
ci & ciFilters . ix x . _Just %~ init
he & diCloseFilter . _Just %~ init
& diSelection ?~ (x, 0)
[] -> he & diCloseFilter .~ Nothing
trybackspace' x ci = fromMaybe ci $ do
str <- ci ^? ciFilter . _Just
return $ case str of
(_ : _) ->
ci & ciFilter . _Just %~ init
& ciSelection ?~ (x, 0)
[] -> ci & ciFilters . ix x .~ Nothing
[] -> ci & ciFilter .~ Nothing
di = w ^. hud . hudElement
updateEnterRegex :: World -> World
@@ -227,13 +243,13 @@ updateEnterRegex w = case w ^? hud . hudElement . subInventory of
Just NoSubInventory{}
| secfocus (-1) 0 ->
w & hud . hudElement . diSelection ?~ (-1, 0)
& hud . hudElement . diFilters %~ enterregex (-1)
& hud . hudElement . diInvFilter %~ enterregex
Just NoSubInventory{}
| secfocus 2 3 ->
w & hud . hudElement . diSelection ?~ (2, 0)
& hud . hudElement . diFilters %~ enterregex 2
& hud . hudElement . diCloseFilter %~ enterregex
Just CombineInventory{} ->
w & hud . hudElement . subInventory . ciFilters %~ enterregex (-1)
w & hud . hudElement . subInventory . ciFilter %~ enterregex
& hud . hudElement . subInventory . ciSelection ?~ (-1, 0)
_ -> w
where
@@ -241,7 +257,7 @@ updateEnterRegex w = case w ^? hud . hudElement . subInventory of
secfocus a b = fromMaybe False $ do
i <- di ^? diSelection . _Just . _1
return $ i == a || i == b
enterregex x = ix x %~ (<|> Just "")
enterregex = (<|> Just "")
pauseGame :: Universe -> Universe
pauseGame u = u & uvScreenLayers .~ [pauseMenu u]
@@ -279,7 +295,9 @@ toggleMap u = case u ^. uvWorld . hud . hudElement of
, _diSections = defaultInvSections
, _diSelection = Nothing
, _diSelectionExtra = 0
, _diFilters = IM.fromList [(-1, mempty), (2, mempty)]
-- , _diFilters = IM.fromList [(-1, mempty), (2, mempty)]
, _diInvFilter = mempty
, _diCloseFilter = mempty
}
_ -> u & uvWorld . hud . hudElement .~ DisplayCarte