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

Simplify updating selection sections

Browse Source
This commit is contained in:
justin
2023-02-18 15:46:03 +00:00
parent 6eca3bab38
commit 41851ba24d
5 changed files with 230 additions and 87 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Combine.hs
+1 -1
View File
@@ -116,7 +116,7 @@ toggleCombineInv uv = case uv ^? uvWorld . hud . hudElement . subInventory of
updateCombineSelections :: World -> Configuration -> SelectionSections CombinableItem
-> SelectionSections CombinableItem
updateCombineSelections w cfig sss = sss & sssSections .~ updateSections availablelines ij [filt,combs]
updateCombineSelections w cfig sss = sss & sssSections .~ updateSections availablelines ij [combs,filt]
where
availablelines = getAvailableListLines secondColumnParams cfig
filt = (-1, (filtsec,filtitems))
src/Dodge/Default/World.hs
+47 -1
View File
@@ -1,5 +1,6 @@
module Dodge.Default.World where
import Control.Lens
import Dodge.Data.SelectionList
import Data.Graph.Inductive.Graph hiding ((&))
import qualified Data.Map as M
@@ -151,7 +152,7 @@ defaultDisplaySections = SelectionSections
defaultHUD :: HUD
defaultHUD =
HUD
{ _hudElement = DisplayInventory {_subInventory =NoSubInventory, _diSections = defaultDisplaySections}
{ _hudElement = DisplayInventory {_subInventory =NoSubInventory, _diSections = defaultInvSections}
, _carteCenter = V2 0 0
, _carteZoom = 0.5
, _carteRot = 0
@@ -170,3 +171,48 @@ defaultHUD =
-- }
-- where
-- f (V2 x y) = V3 x y 100
defaultInvSections :: SelectionSections ()
defaultInvSections = SelectionSections
{ _sssSections = IM.fromDistinctAscList $ zip [-1..]
[ defaultFiltSection
, defaultInvSection
, defaultYouSection
, defaultFiltSection
, defaultCOSection
]
, _sssSelPos = Nothing
}
defaultSS :: SelectionSection a
defaultSS = SelectionSection
{ _ssItems = mempty
, _ssCursor = Nothing
, _ssMinSize = 10
, _ssOffset = 0
, _ssShownItems = []
, _ssIndent = 0
, _ssDescriptor = ""
}
defaultCOSection :: SelectionSection ()
defaultCOSection = defaultSS
& ssIndent .~ 2
& ssDescriptor .~ "CLOSE OBJECTS"
defaultFiltSection :: SelectionSection a
defaultFiltSection = defaultSS
& ssIndent .~ 0
& ssDescriptor .~ "INV"
& ssMinSize .~ 0
defaultInvSection :: SelectionSection ()
defaultInvSection = defaultSS
& ssDescriptor .~ "INVENTORY ITEMS"
defaultYouSection :: SelectionSection ()
defaultYouSection = defaultSS
-- & ssRegex .~ UnavailableRegex
& ssIndent .~ 2
& ssMinSize .~ 1
& ssDescriptor .~ "YOUR STATUS"
src/Dodge/DisplayInventory.hs
+76 -84
View File
@@ -26,34 +26,29 @@ 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,filtclose,invx ,youx, closex]
, _sssSelPos = Just (-1)
}
Just (InInventory (SelItem i _)) -> sss
{ _sssSections = updateSections availablelines (0,i) [filtinv,filtclose,invx ,youx, closex]
, _sssSelPos = Just 0
}
Just SelNothing -> sss
{ _sssSections = updateSections availablelines (1,0) [filtinv,filtclose,invx ,youx, closex]
, _sssSelPos = Just 1
}
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
}
-- Just mo -> sss
-- { _sssSections = updateSections availablelines (manObjIndex mo) $ addorder mo
-- , _sssSelPos = Just (fst $ manObjIndex mo)
-- }
Just mo -> updateSectionsPositioning sss
{ _sssSelPos = Just (fst $ manObjIndex mo)
} availablelines (manObjIndex mo) $ addorder mo
_ -> error "error when getting cr inv sel"
where
filtinv = (-1,(filtinvsec,filtinvitems))
addorder mo = case mo of
InInventory SortInventory -> reverse [filtinv,filtclose,invx ,youx, closex]
InInventory SelItem{} -> reverse [filtinv,filtclose,invx ,youx, closex]
SelNothing -> reverse [filtinv,filtclose,invx ,youx, closex]
InNearby SortNearby -> reverse [filtinv,filtclose,closex, invx ,youx]
InNearby SelCloseObject {} -> reverse [filtinv,filtclose,closex, invx ,youx]
-- filtinv = (-1,(filtinvsec,filtinvitems))
filtinv = (-1,filtinvitems)
filtinvsec = fromMaybe defaultFiltSection $ sss ^? sssSections . ix (-1)
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))
--filtclose = (2,(filtclosesec,filtcloseitems))
filtclose = (2,filtcloseitems)
filtclosesec = fromMaybe (defaultFiltSection & ssIndent .~ 2)
$ sss ^? sssSections . ix 2
filtcloseitems = case cr ^? crManipulation . closeRegex . _Just of
@@ -63,13 +58,16 @@ updateDisplayInventory w cfig sss = case cr ^? crManipulation . manObject of
numfiltitems' = length invitems' - length invitems
numfiltclose = " " ++ show numfiltclose' ++ " FILTERED"
numfiltclose' = length coitems' - length coitems
invx = (0,(invsec, invitems))
youx = (1,(yousec, youitems))
closex = (3,(cosec, coitems))
invx = (0, invitems)
--invx = (0,(invsec, invitems))
youx = (1, youitems)
--youx = (1,(yousec, youitems))
--closex = (3,(cosec, coitems))
closex = (3, 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
cosec = fromMaybe defaultCOSection $ sss ^? sssSections . ix 3
invsec = fromMaybe defaultInvSection $ sss ^? sssSections . ix 0
coitems' = IM.fromDistinctAscList . zip [0..]
$ map closeObjectToSelectionItem (w ^. hud . closeObjects)
@@ -90,42 +88,41 @@ displayFreeSlots x = case x of
1 -> "1 FREE SLOT"
_ -> show x ++ " FREE SLOTS"
updateSectionsPositioning
:: SelectionSections a
-> Int -> (Int, Int) -> [(Int,IM.IntMap (SelectionItem a))]
-> SelectionSections a
updateSectionsPositioning sss _ _ [] = sss & sssSections .~ mempty
updateSectionsPositioning sss allavailablelines (i,j) ((k,y) : xs)
= previoussections & sssSections %~ IM.insert k ss
where
ss | i == k = updateSection (Just j) y linesleft x
| otherwise = updateSection Nothing y linesleft x
x = sss ^?! sssSections . ix k
availablelines = allavailablelines - _ssMinSize x
linesleft = allavailablelines - sum (fmap (length . _ssShownItems) $ _sssSections previoussections)
previoussections = updateSectionsPositioning sss availablelines (i,j) xs
updateSections :: Int -> (Int, Int) -> [(Int,(SelectionSection a,IM.IntMap (SelectionItem a)))]
-> IM.IntMap (SelectionSection a)
updateSections _ _ [] = mempty
updateSections allavailablelines (i,j) ((k,(x,y)):xs) = IM.insert k ss
$ updateSections (allavailablelines - length (_ssShownItems ss)) (i,j) xs
updateSections allavailablelines (i,j) ((k,(x,y)):xs) = IM.insert k ss previoussections
where
ss | i == k = updateSection (Just j) y availablelines x
| otherwise = updateSection Nothing y availablelines x
availablelines = allavailablelines - sum (map (_ssMinSize . fst . snd) xs)
defaultSS :: SelectionSection a
defaultSS = SelectionSection
{ _ssItems = mempty
, _ssCursor = Nothing
, _ssMinSize = 5
, _ssOffset = 0
, _ssShownItems = []
, _ssIndent = 0
, _ssDescriptor = ""
}
ss | i == k = updateSection (Just j) y linesleft x
| otherwise = updateSection Nothing y linesleft x
availablelines = allavailablelines - _ssMinSize x
linesleft = allavailablelines - sum (fmap (length . _ssShownItems) $ previoussections)
previoussections = updateSections availablelines (i,j) xs
defaultCOSection :: SelectionSection ()
defaultCOSection = defaultSS
& ssIndent .~ 2
& ssDescriptor .~ "CLOSE OBJECTS"
defaultFiltSection :: SelectionSection a
defaultFiltSection = defaultSS
& ssIndent .~ 0
& ssDescriptor .~ "INV"
& ssMinSize .~ 0
defaultInvSection :: SelectionSection ()
defaultInvSection = defaultSS
& ssDescriptor .~ "INVENTORY ITEMS"
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
:: Maybe Int
@@ -133,60 +130,54 @@ updateSection
-> Int
-> SelectionSection a
-> SelectionSection a
updateSection mspos sis' availablelines ss = ss
updateSection mcsel sis availablelines ss = ss
{ _ssItems = sis
, _ssCursor = scurs
, _ssOffset = offset
, _ssShownItems = shownitems
}
where
sis = sis'
oldoffset = ss ^. ssOffset
scurs = do
csel <- mspos
csel <- mcsel
si <- sis ^? ix csel
let cpos = sum (fmap (length . _siPictures) . fst . IM.split csel $ sis)
csize = length $ _siPictures si
ccolor = _siColor si
return $ SectionCursor csel (cpos - offset) csize ccolor
mcpos = do
csel <- mspos
return . sum $ fmap (length . _siPictures) . fst . IM.split csel $ sis
xselsize = fromMaybe 1 selsize
offset = maybe 0 offset' mcpos
offset' jselpos
| jselpos == 0 || not mustrestrict = 0
| jselpos - 1 < oldoffset = jselpos - 1
| islastitm = jselpos - availablelines + xselsize
| jselpos + 1 + xselsize - availablelines > oldoffset = jselpos - availablelines + 1 + xselsize
| length allstrings - oldoffset < availablelines = length allstrings - availablelines
| otherwise = oldoffset
offset = fromMaybe oldoffset $ do
csel <- mcsel
maxcsel <- fst <$> IM.lookupMax sis
si <- sis ^? ix csel
let xselsize = length $ _siPictures si
return $ case sum $ fmap (length . _siPictures) . fst . IM.split csel $ sis of
pos | pos == 0 || length allstrings <= availablelines
-> 0
pos | pos - 1 < oldoffset
-> pos - 1
pos | maxcsel == csel
-> pos - availablelines + xselsize
pos | pos + 1 + xselsize - availablelines > oldoffset
-> pos - availablelines + 1 + xselsize
_ | length allstrings - oldoffset < availablelines
-> length allstrings - availablelines
_ -> oldoffset
tweakfirst (x:xs)
| offset > 0 = hup : map h xs
| offset > 0 = xtra "<<<" : map h xs
| otherwise = map h (x:xs)
tweakfirst [] = []
shownitems
| length shownstrings > availablelines
= tweakfirst (take (availablelines - 1) shownstrings)
++ [hdown]
++ [xtra ">>>"]
| otherwise = tweakfirst shownstrings
allstrings :: [(Color,String)]
allstrings = foldMap g sis
mustrestrict = length allstrings > availablelines
shownstrings = drop offset allstrings
h (col,str) = color col . text $ theindent ++ str
theindent = replicate (_ssIndent ss) ' '
hdown = color white . text $ theindent ++ ">>> MORE " ++ _ssDescriptor ss
hup = color white . text $ theindent ++ "<<< MORE " ++ _ssDescriptor ss
xtra str = color white . text $ theindent ++ str ++ " MORE " ++ _ssDescriptor ss
g si = map (_siColor si ,) $ _siPictures si
islastitm = fromMaybe False $ do
i <- mspos
k <- fst <$> IM.lookupMax sis
return $ k == i
selsize = do
i <- mspos
si <- sis ^? ix i
return . length $ _siPictures si
yousec :: SelectionSection ()
yousec = defaultSS
@@ -195,3 +186,4 @@ yousec = defaultSS
& ssIndent .~ 2
& ssMinSize .~ 1
& ssDescriptor .~ "YOUR STATUS"
src/Dodge/SelectionSections.hs
+104
View File
@@ -0,0 +1,104 @@
module Dodge.SelectionSections where
import Data.Maybe
import Control.Lens
import qualified Data.IntMap.Strict as IM
import Dodge.Data.SelectionList
scrollSelectionSections :: Int -> SelectionSections a -> SelectionSections a
scrollSelectionSections yi sss
| yi == 0 = sss
| yi > 0 = foldr ($) sss $ replicate yi scrollUpSelectionSections
| otherwise = foldr ($) sss $ replicate (negate yi) scrollDownSelectionSections
firstPosSelectionSections :: SelectionSections a -> SelectionSections a
firstPosSelectionSections sss = fromMaybe sss $ do
(i,j,si) <- ssLookupMin sss
return $ sss
& sssSelPos ?~ i
& sssSections . ix i . ssCursor ?~ SectionCursor j j (_siHeight si) (_siColor si)
scrollUpSelectionSections :: SelectionSections a -> SelectionSections a
scrollUpSelectionSections sss = fromMaybe (firstPosSelectionSections sss) $ do
i <- sss ^? sssSelPos . _Just
j <- sss ^? sssSections . ix i . ssCursor . _Just . scurSel
(i',j',si) <- ssLookupUp i j sss
return $ sss & sssSelPos ?~ i'
& sssSections . ix i' . ssCursor ?~ SectionCursor j' j' (_siHeight si) (_siColor si)
scrollDownSelectionSections :: SelectionSections a -> SelectionSections a
scrollDownSelectionSections sss = fromMaybe (firstPosSelectionSections sss) $ do
i <- sss ^? sssSelPos . _Just
j <- sss ^? sssSections . ix i . ssCursor . _Just . scurSel
(i',j',si) <- ssLookupDown i j sss
return $ sss & sssSelPos ?~ i'
& sssSections . ix i' . ssCursor ?~ SectionCursor j' j' (_siHeight si) (_siColor si)
ssSetCursor :: (SelectionSections a -> Maybe (Int,Int,SelectionItem a))
-> SelectionSections a -> SelectionSections a
ssSetCursor f sss = fromMaybe sss $ do
(i,j,si) <- f sss
return $ sss
& sssSelPos ?~ i
& sssSections . ix i . ssCursor ?~ SectionCursor j j (_siHeight si) (_siColor si)
ssLookupMax :: SelectionSections a -> Maybe (Int,Int,SelectionItem a)
ssLookupMax sss = do
(i,_) <- IM.lookupMax (sss ^. sssSections)
ssLookupLE' i sss
ssLookupUp :: Int -> Int -> SelectionSections a -> Maybe (Int,Int,SelectionItem a)
ssLookupUp i j sss = case ssLookupLT i j sss of
Nothing -> ssLookupMax sss
x -> x
ssLookupDown :: Int -> Int -> SelectionSections a -> Maybe (Int,Int,SelectionItem a)
ssLookupDown i j sss = case ssLookupGT i j sss of
Nothing -> ssLookupMin sss
x -> x
ssLookupLT :: Int -> Int -> SelectionSections a -> Maybe (Int,Int,SelectionItem a)
ssLookupLT i j sss = fromMaybe (ssLookupLT' i sss) $ do
ss <- sss ^? sssSections . ix i
(j',si) <- IM.lookupLT j (ss ^. ssItems)
return $ Just (i,j',si)
ssLookupLT' :: Int -> SelectionSections a -> Maybe (Int,Int,SelectionItem a)
ssLookupLT' i sss = do
(i',ss) <- IM.lookupLT i (sss ^. sssSections)
case IM.lookupMax (ss ^. ssItems) of
Just (j',si) -> return (i',j',si)
Nothing -> ssLookupLT' i' sss
ssLookupLE' :: Int -> SelectionSections a -> Maybe (Int,Int,SelectionItem a)
ssLookupLE' i sss = do
(i',ss) <- IM.lookupLE i (sss ^. sssSections)
case IM.lookupMax (ss ^. ssItems) of
Just (j',si) -> return (i',j',si)
Nothing -> ssLookupLT' i' sss
ssLookupMin :: SelectionSections a -> Maybe (Int,Int,SelectionItem a)
ssLookupMin sss = do
(i,_) <- IM.lookupMin (sss ^. sssSections)
ssLookupGE' i sss
ssLookupGT :: Int -> Int -> SelectionSections a -> Maybe (Int,Int,SelectionItem a)
ssLookupGT i j sss = fromMaybe (ssLookupGT' i sss) $ do
ss <- sss ^? sssSections . ix i
(j',si) <- IM.lookupGT j (ss ^. ssItems)
return $ Just (i,j',si)
ssLookupGT' :: Int -> SelectionSections a -> Maybe (Int,Int,SelectionItem a)
ssLookupGT' i sss = do
(i',ss) <- IM.lookupGT i (sss ^. sssSections)
case IM.lookupMin (ss ^. ssItems) of
Just (j',si) -> return (i',j',si)
Nothing -> ssLookupGT' i' sss
ssLookupGE' :: Int -> SelectionSections a -> Maybe (Int,Int,SelectionItem a)
ssLookupGE' i sss = do
(i',ss) <- IM.lookupGE i (sss ^. sssSections)
case IM.lookupMin (ss ^. ssItems) of
Just (j',si) -> return (i',j',si)
Nothing -> ssLookupGT' i' sss
src/Dodge/Update/Input.hs
+2 -1
View File
@@ -6,6 +6,7 @@ module Dodge.Update.Input (
doRegexInput,
) where
import Dodge.Default.World
import Data.Char
import qualified Data.IntMap.Strict as IM
import qualified Data.Map.Strict as M
@@ -256,7 +257,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 = defaultDisplaySections}
.~ DisplayInventory{_subInventory = NoSubInventory, _diSections = defaultInvSections}
_ -> u & uvWorld . hud . hudElement .~ DisplayCarte
toggleTweakInv :: World -> World