Tweak cursor storage on sss

This commit is contained in:
2023-02-19 09:53:09 +00:00
parent 41851ba24d
commit 8ec1dc0830
10 changed files with 163 additions and 151 deletions
+26 -26
View File
@@ -114,29 +114,29 @@ toggleCombineInv uv = case uv ^? uvWorld . hud . hudElement . subInventory of
Just CombineInventory{} -> uv & uvWorld . hud . hudElement . subInventory .~ NoSubInventory Just CombineInventory{} -> uv & uvWorld . hud . hudElement . subInventory .~ NoSubInventory
_ -> uv & uvWorld %~ enterCombineInv (uv ^. uvConfig) _ -> uv & uvWorld %~ enterCombineInv (uv ^. uvConfig)
updateCombineSelections :: World -> Configuration -> SelectionSections CombinableItem --updateCombineSelections :: World -> Configuration -> SelectionSections CombinableItem
-> SelectionSections CombinableItem -- -> SelectionSections CombinableItem
updateCombineSelections w cfig sss = sss & sssSections .~ updateSections availablelines ij [combs,filt] --updateCombineSelections w cfig sss = sss & sssSections .~ updateSections availablelines ij [combs,filt]
where -- where
availablelines = getAvailableListLines secondColumnParams cfig -- availablelines = getAvailableListLines secondColumnParams cfig
filt = (-1, (filtsec,filtitems)) -- filt = (-1, (filtsec,filtitems))
filtsec = fromMaybe defaultFiltSection $ sss ^? sssSections . ix (-1) -- filtsec = fromMaybe defaultFiltSection $ sss ^? sssSections . ix (-1)
filtitems = case w ^? hud . hudElement . subInventory . ciRegex . _Just of -- filtitems = case w ^? hud . hudElement . subInventory . ciRegex . _Just of
Just str -> IM.singleton 0 (SelectionRegex ["COMB. FILTER: " ++ str,numfiltitems] 2 True white 0) -- Just str -> IM.singleton 0 (SelectionRegex ["COMB. FILTER: " ++ str,numfiltitems] 2 True white 0)
Nothing -> mempty -- Nothing -> mempty
numfiltitems = " " ++ show numfiltitems' ++ " FILTERED" -- numfiltitems = " " ++ show numfiltitems' ++ " FILTERED"
numfiltitems' = length combitems' - length combitems -- numfiltitems' = length combitems' - length combitems
combs :: (Int , (SelectionSection CombinableItem , IM.IntMap (SelectionItem CombinableItem))) -- combs :: (Int , (SelectionSection CombinableItem , IM.IntMap (SelectionItem CombinableItem)))
combs = (0, (combsec,combitems)) -- combs = (0, (combsec,combitems))
combsec = fromMaybe (defaultSS & ssDescriptor .~ "COMBINATIONS") $ sss ^? sssSections . ix 0 -- combsec = fromMaybe (defaultSS & ssDescriptor .~ "COMBINATIONS") $ sss ^? sssSections . ix 0
combitems' = fromMaybe mempty $ w ^? hud . hudElement . subInventory . ciCombinations -- combitems' = fromMaybe mempty $ w ^? hud . hudElement . subInventory . ciCombinations
combitems = case w ^? hud . hudElement . subInventory . ciRegex . _Just of -- combitems = case w ^? hud . hudElement . subInventory . ciRegex . _Just of
Just str -> IM.filter (regexList str . _siPictures) combitems' -- Just str -> IM.filter (regexList str . _siPictures) combitems'
Nothing -> combitems' -- Nothing -> combitems'
ij = fromMaybe (0,0) $ do -- ij = fromMaybe (0,0) $ do
i <- sss ^? sssSelPos . _Just -- i <- sss ^? sssSelPos . _Just
j <- sss ^? sssSections . ix i . ssCursor . _Just . scurSel -- j <- sss ^? sssSections . ix i . ssCursor . _Just . scurSel
return (i,j) -- return (i,j)
enterCombineInv :: Configuration -> World -> World enterCombineInv :: Configuration -> World -> World
enterCombineInv cfig w = w & hud . hudElement . subInventory .~ CombineInventory enterCombineInv cfig w = w & hud . hudElement . subInventory .~ CombineInventory
@@ -148,15 +148,15 @@ enterCombineInv cfig w = w & hud . hudElement . subInventory .~ CombineInventory
cm = IM.fromAscList $ zip [0..] $ combineList w cm = IM.fromAscList $ zip [0..] $ combineList w
sss = SelectionSections sss = SelectionSections
{ _sssSections = IM.singleton 0 combsection { _sssSections = IM.singleton 0 combsection
, _sssSelPos = Just 0 , _sssSelPos = Just (0,0)
} }
availablelines = getAvailableListLines secondColumnParams cfig availablelines = getAvailableListLines secondColumnParams cfig
combsection = updateSection (Just 0) cm availablelines combinationssection' combsection = updateSection cm (Just 0) availablelines combinationssection'
combinationssection' = SelectionSection combinationssection' = SelectionSection
{ _ssItems = cm { _ssItems = cm
, _ssCursor = do , _ssCursor = do
(i,si) <- IM.lookupMin cm (i,si) <- IM.lookupMin cm
return $ SectionCursor i 0 (length (_siPictures si)) (_siColor si) return $ SectionCursor 0 (length (_siPictures si)) (_siColor si)
, _ssMinSize = 5 , _ssMinSize = 5
, _ssOffset = 0 , _ssOffset = 0
, _ssShownItems = mempty , _ssShownItems = mempty
+3 -3
View File
@@ -32,12 +32,12 @@ data SelectionList a = SelectionList
data SelectionSections a = SelectionSections data SelectionSections a = SelectionSections
{ _sssSections :: IntMap (SelectionSection a) { _sssSections :: IntMap (SelectionSection a)
, _sssSelPos :: Maybe Int , _sssSelPos :: Maybe (Int,Int)
} }
data SectionCursor = SectionCursor data SectionCursor = SectionCursor
{ _scurSel :: Int --{ _scurSel :: Int
, _scurPos :: Int { _scurPos :: Int
, _scurSize :: Int , _scurSize :: Int
, _scurColor :: Color , _scurColor :: Color
} }
+1 -1
View File
@@ -146,7 +146,7 @@ defaultLWorld =
defaultDisplaySections :: SelectionSections a defaultDisplaySections :: SelectionSections a
defaultDisplaySections = SelectionSections defaultDisplaySections = SelectionSections
{ _sssSections = mempty { _sssSections = mempty
, _sssSelPos = Just 0 , _sssSelPos = Just (0,0)
} }
defaultHUD :: HUD defaultHUD :: HUD
+47 -49
View File
@@ -4,10 +4,11 @@ module Dodge.DisplayInventory
, defaultSS , defaultSS
, defaultFiltSection , defaultFiltSection
, defaultDisplaySections , defaultDisplaySections
, updateSections -- , updateSections
, updateSection , updateSection
) where ) where
import Control.Monad
import Regex import Regex
import Data.Maybe import Data.Maybe
import Picture.Base import Picture.Base
@@ -26,13 +27,10 @@ import Dodge.Data.World
updateDisplayInventory :: World -> Configuration -> SelectionSections () -> SelectionSections () updateDisplayInventory :: World -> Configuration -> SelectionSections () -> SelectionSections ()
updateDisplayInventory w cfig sss = case cr ^? crManipulation . manObject of updateDisplayInventory w cfig sss = case cr ^? crManipulation . manObject of
-- Just mo -> sss Just mo -> updateSectionsPositioning
-- { _sssSections = updateSections availablelines (manObjIndex mo) $ addorder mo (sss & sssSelPos ?~ manObjIndex mo)
-- , _sssSelPos = Just (fst $ manObjIndex mo) availablelines
-- } (addorder mo)
Just mo -> updateSectionsPositioning sss
{ _sssSelPos = Just (fst $ manObjIndex mo)
} availablelines (manObjIndex mo) $ addorder mo
_ -> error "error when getting cr inv sel" _ -> error "error when getting cr inv sel"
where where
addorder mo = case mo of addorder mo = case mo of
@@ -41,16 +39,11 @@ 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 = (-1,(filtinvsec,filtinvitems))
filtinv = (-1,filtinvitems) filtinv = (-1,filtinvitems)
filtinvsec = fromMaybe defaultFiltSection $ sss ^? sssSections . ix (-1)
filtinvitems = case cr ^? crManipulation . invRegex . _Just of filtinvitems = case cr ^? crManipulation . invRegex . _Just of
Just str -> IM.singleton 0 (SelectionRegex ["INV. FILTER: " ++ str,numfiltitems] 2 True white 0) Just str -> IM.singleton 0 (SelectionRegex ["INV. FILTER: " ++ str,numfiltitems] 2 True white 0)
Nothing -> mempty Nothing -> mempty
--filtclose = (2,(filtclosesec,filtcloseitems))
filtclose = (2,filtcloseitems) filtclose = (2,filtcloseitems)
filtclosesec = fromMaybe (defaultFiltSection & ssIndent .~ 2)
$ sss ^? sssSections . ix 2
filtcloseitems = case cr ^? crManipulation . closeRegex . _Just of filtcloseitems = case cr ^? crManipulation . closeRegex . _Just of
Just str -> IM.singleton 0 (SelectionRegex ["NEARBY FILTER: " ++ str,numfiltclose] 2 True white 0) Just str -> IM.singleton 0 (SelectionRegex ["NEARBY FILTER: " ++ str,numfiltclose] 2 True white 0)
Nothing -> mempty Nothing -> mempty
@@ -59,16 +52,11 @@ updateDisplayInventory w cfig sss = case cr ^? crManipulation . manObject of
numfiltclose = " " ++ show numfiltclose' ++ " FILTERED" numfiltclose = " " ++ show numfiltclose' ++ " FILTERED"
numfiltclose' = length coitems' - length coitems numfiltclose' = length coitems' - length coitems
invx = (0, invitems) invx = (0, invitems)
--invx = (0,(invsec, invitems))
youx = (1, youitems) youx = (1, youitems)
--youx = (1,(yousec, youitems))
--closex = (3,(cosec, coitems))
closex = (3, coitems) closex = (3, coitems)
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
availablelines = getAvailableListLines (invDisplayParams w) cfig availablelines = getAvailableListLines (invDisplayParams w) cfig
cosec = fromMaybe defaultCOSection $ sss ^? sssSections . ix 3
invsec = fromMaybe defaultInvSection $ sss ^? sssSections . ix 0
coitems' = IM.fromDistinctAscList . zip [0..] coitems' = IM.fromDistinctAscList . zip [0..]
$ map closeObjectToSelectionItem (w ^. hud . closeObjects) $ map closeObjectToSelectionItem (w ^. hud . closeObjects)
coitems = case cr ^? crManipulation . closeRegex . _Just of coitems = case cr ^? crManipulation . closeRegex . _Just of
@@ -91,29 +79,48 @@ displayFreeSlots x = case x of
updateSectionsPositioning updateSectionsPositioning
:: SelectionSections a :: SelectionSections a
-> Int -> (Int, Int) -> [(Int,IM.IntMap (SelectionItem a))] -> Int -> [(Int,IM.IntMap (SelectionItem a))]
-> SelectionSections a -> SelectionSections a
updateSectionsPositioning sss _ _ [] = sss & sssSections .~ mempty updateSectionsPositioning sss _ [] = sss & sssSections .~ mempty
updateSectionsPositioning sss allavailablelines (i,j) ((k,y) : xs) updateSectionsPositioning sss allavailablelines ((k,y) : xs)
= previoussections & sssSections %~ IM.insert k ss = previoussections & sssSections %~ IM.insert k ss
where where
ss | i == k = updateSection (Just j) y linesleft x mscel = do
| otherwise = updateSection Nothing y linesleft x (i,j) <- sss ^? sssSelPos . _Just
guard $ i == k
return j
ss = updateSection y mscel linesleft x
x = sss ^?! sssSections . ix k x = sss ^?! sssSections . ix k
availablelines = allavailablelines - _ssMinSize x availablelines = allavailablelines - _ssMinSize x
linesleft = allavailablelines - sum (fmap (length . _ssShownItems) $ _sssSections previoussections) linesleft = allavailablelines - sum (fmap linestaken $ _sssSections previoussections)
previoussections = updateSectionsPositioning sss availablelines (i,j) xs linestaken ss' = max (length $ _ssShownItems ss') (_ssMinSize ss')
previoussections = updateSectionsPositioning sss availablelines xs
updateSections :: Int -> (Int, Int) -> [(Int,(SelectionSection a,IM.IntMap (SelectionItem a)))] --updateSectionsPositioning
-> IM.IntMap (SelectionSection a) -- :: SelectionSections a
updateSections _ _ [] = mempty -- -> Int -> (Int, Int) -> [(Int,IM.IntMap (SelectionItem a))]
updateSections allavailablelines (i,j) ((k,(x,y)):xs) = IM.insert k ss previoussections -- -> SelectionSections a
where --updateSectionsPositioning sss _ _ [] = sss & sssSections .~ mempty
ss | i == k = updateSection (Just j) y linesleft x --updateSectionsPositioning sss allavailablelines (i,j) ((k,y) : xs)
| otherwise = updateSection Nothing y linesleft x -- = previoussections & sssSections %~ IM.insert k ss
availablelines = allavailablelines - _ssMinSize x -- where
linesleft = allavailablelines - sum (fmap (length . _ssShownItems) $ previoussections) -- ss | i == k = updateSection (Just j) y linesleft x
previoussections = updateSections availablelines (i,j) xs -- | 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 previoussections
-- where
-- ss | i == k = updateSection y linesleft x
-- | otherwise = updateSection y linesleft x
-- availablelines = allavailablelines - _ssMinSize x
-- linesleft = allavailablelines - sum (fmap (length . _ssShownItems) $ previoussections)
-- previoussections = updateSections availablelines (i,j) xs
manObjIndex :: ManipulatedObject -> (Int,Int) manObjIndex :: ManipulatedObject -> (Int,Int)
@@ -125,12 +132,12 @@ manObjIndex mo = case mo of
InNearby (SelCloseObject i) -> (3,i) InNearby (SelCloseObject i) -> (3,i)
updateSection updateSection
:: Maybe Int :: IM.IntMap (SelectionItem a)
-> IM.IntMap (SelectionItem a) -> Maybe Int
-> Int -> Int
-> SelectionSection a -> SelectionSection a
-> SelectionSection a -> SelectionSection a
updateSection mcsel sis availablelines ss = ss updateSection sis mcsel availablelines ss = ss
{ _ssItems = sis { _ssItems = sis
, _ssCursor = scurs , _ssCursor = scurs
, _ssOffset = offset , _ssOffset = offset
@@ -140,11 +147,11 @@ updateSection mcsel sis availablelines ss = ss
oldoffset = ss ^. ssOffset oldoffset = ss ^. ssOffset
scurs = do scurs = do
csel <- mcsel csel <- mcsel
si <- sis ^? ix csel (_,si) <- IM.lookupGE csel sis -- this is not right
let cpos = sum (fmap (length . _siPictures) . fst . IM.split csel $ sis) let cpos = sum (fmap (length . _siPictures) . fst . IM.split csel $ sis)
csize = length $ _siPictures si csize = length $ _siPictures si
ccolor = _siColor si ccolor = _siColor si
return $ SectionCursor csel (cpos - offset) csize ccolor return $ SectionCursor (cpos - offset) csize ccolor
offset = fromMaybe oldoffset $ do offset = fromMaybe oldoffset $ do
csel <- mcsel csel <- mcsel
maxcsel <- fst <$> IM.lookupMax sis maxcsel <- fst <$> IM.lookupMax sis
@@ -178,12 +185,3 @@ updateSection mcsel sis availablelines ss = ss
theindent = replicate (_ssIndent ss) ' ' theindent = replicate (_ssIndent ss) ' '
xtra str = color white . text $ theindent ++ str ++ " MORE " ++ _ssDescriptor ss xtra str = color white . text $ theindent ++ str ++ " MORE " ++ _ssDescriptor ss
g si = map (_siColor si ,) $ _siPictures si g si = map (_siColor si ,) $ _siPictures si
yousec :: SelectionSection ()
yousec = defaultSS
& ssCursor ?~ SectionCursor 0 0 1 invDimColor
-- & ssRegex .~ UnavailableRegex
& ssIndent .~ 2
& ssMinSize .~ 1
& ssDescriptor .~ "YOUR STATUS"
+3 -3
View File
@@ -21,19 +21,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
i <- sss ^? sssSelPos . _Just 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
i <- sss ^? sssSelPos . _Just 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
i <- sss ^? sssSelPos . _Just i <- sss ^? sssSelPos . _Just . _1
return $ i == (-1) return $ i == (-1)
inputFocus :: World -> Bool inputFocus :: World -> Bool
+10 -13
View File
@@ -2,9 +2,6 @@
module Dodge.Inventory ( module Dodge.Inventory (
selSecSelPos, selSecSelPos,
ssLookupDown,
ssLookupGT,
ssSetCursor,
firstPosSelectionSections, firstPosSelectionSections,
checkInvSlotsYou, checkInvSlotsYou,
rmSelectedInvItem, rmSelectedInvItem,
@@ -18,7 +15,7 @@ module Dodge.Inventory (
updateTerminal, updateTerminal,
closeObjScrollDir, closeObjScrollDir,
changeSwapInvSel, changeSwapInvSel,
changeAugInvSel, scrollAugInvSel,
crNumFreeSlots, crNumFreeSlots,
crInvSize, crInvSize,
selectedCloseObject, selectedCloseObject,
@@ -67,15 +64,15 @@ rmInvItem cid invid w = case w ^? getcid . crInv . ix invid . itUse . useAmount
& doanyitemeffect & doanyitemeffect
& pointcid . crInvEquipped %~ IM.delete invid & pointcid . crInvEquipped %~ IM.delete invid
& pointcid . crInvEquipped %~ IM.mapKeys g & pointcid . crInvEquipped %~ IM.mapKeys g
& updatemanipulation & updateselection
where where
getcid = cWorld . lWorld . creatures . ix cid getcid = cWorld . lWorld . creatures . ix cid
pointcid = cWorld . lWorld . creatures . ix cid pointcid = cWorld . lWorld . creatures . ix cid
updatemanipulation updateselection
| cid == 0 && cr ^? crManipulation . manObject . inInventory . ispItem == Just invid | cid == 0 && cr ^? crManipulation . manObject . inInventory . ispItem == Just invid
= (pointcid . crManipulation . manObject . inInventory . ispItem %~ g) . changeAugInvSel (-1) = scrollAugInvSel (-1) . scrollAugInvSel 1
| otherwise | otherwise
= pointcid . crManipulation . manObject . inInventory . ispItem %~ g = pointcid . crManipulation . manObject . inInventory . ispItem %~ g
@@ -181,9 +178,9 @@ updateCloseObjects w =
updatecursorposifnecessary updatecursorposifnecessary
= 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 -> changeAugInvSel 1 | i >= length newcloseobjects -> scrollAugInvSel 1
| isNothing (w ^? hud . hudElement . diSections . sssSections . ix 3 . ssItems . ix i) | isNothing (w ^? hud . hudElement . diSections . sssSections . ix 3 . ssItems . ix i)
-> changeAugInvSel (-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
ypos = _crPos $ you w ypos = _crPos $ you w
@@ -360,8 +357,8 @@ changeSwapInvSel k w = case you w ^? crManipulation . manObject of
n = length $ _crInv cr n = length $ _crInv cr
numCO = length $ w ^. hud . closeObjects numCO = length $ w ^. hud . closeObjects
changeAugInvSel :: Int -> World -> World scrollAugInvSel :: Int -> World -> World
changeAugInvSel yi w scrollAugInvSel yi w
| yi == 0 = w | yi == 0 = w
| otherwise = | otherwise =
w & hud . hudElement . diSections %~ scrollSelectionSections yi w & hud . hudElement . diSections %~ scrollSelectionSections yi
@@ -373,8 +370,8 @@ setInvPosFromSS w = w
where where
thesel = fromMaybe SelNothing $ do thesel = fromMaybe SelNothing $ do
sss <- w ^? hud . hudElement . diSections sss <- w ^? hud . hudElement . diSections
i <- sss ^? sssSelPos . _Just (i,j) <- sss ^? sssSelPos . _Just
j <- sss ^? sssSections . ix i . ssCursor . _Just . scurSel -- 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)
+1 -2
View File
@@ -81,8 +81,7 @@ drawSelectionSections sss ldps cfig = listPicturesAtScaleOff
<> thecursor' <> thecursor'
where where
thecursor' = fromMaybe mempty $ do thecursor' = fromMaybe mempty $ do
i <- sss ^? sssSelPos . _Just (i,j) <- sss ^? sssSelPos . _Just
j <- sss ^? sssSections . ix i . ssCursor . _Just . scurSel
return $ selSecDrawCursor 15 [North,South,West] cfig ldps sss i j return $ selSecDrawCursor 15 [North,South,West] cfig ldps sss i j
pics = foldMap _ssShownItems (_sssSections sss) pics = foldMap _ssShownItems (_sssSections sss)
+35 -18
View File
@@ -1,8 +1,14 @@
module Dodge.SelectionSections where module Dodge.SelectionSections (
scrollSelectionSections,
ssLookupDown,
ssLookupGT,
ssSetCursor,
firstPosSelectionSections,
) where
import Data.Maybe
import Control.Lens import Control.Lens
import qualified Data.IntMap.Strict as IM import qualified Data.IntMap.Strict as IM
import Data.Maybe
import Dodge.Data.SelectionList import Dodge.Data.SelectionList
scrollSelectionSections :: Int -> SelectionSections a -> SelectionSections a scrollSelectionSections :: Int -> SelectionSections a -> SelectionSections a
@@ -11,37 +17,48 @@ scrollSelectionSections yi sss
| yi > 0 = foldr ($) sss $ replicate yi scrollUpSelectionSections | yi > 0 = foldr ($) sss $ replicate yi scrollUpSelectionSections
| otherwise = foldr ($) sss $ replicate (negate yi) scrollDownSelectionSections | otherwise = foldr ($) sss $ replicate (negate yi) scrollDownSelectionSections
-- when is this used? it needs to correctly set the cursor
firstPosSelectionSections :: SelectionSections a -> SelectionSections a firstPosSelectionSections :: SelectionSections a -> SelectionSections a
firstPosSelectionSections sss = fromMaybe sss $ do firstPosSelectionSections sss = fromMaybe sss $ do
(i, j, si) <- ssLookupMin sss (i, j, si) <- ssLookupMin sss
return $ sss return $
& sssSelPos ?~ i sss
& sssSections . ix i . ssCursor ?~ SectionCursor j j (_siHeight si) (_siColor si) & sssSelPos ?~ (i, j)
-- & sssSetCursor
-- & sssSections . ix i . ssCursor ?~ SectionCursor j j (_siHeight si) (_siColor si)
--sssSetCursor :: SelectionSections a -> SelectionSections a
--sssSetCursor sss = sss
scrollUpSelectionSections :: SelectionSections a -> SelectionSections a scrollUpSelectionSections :: SelectionSections a -> SelectionSections a
scrollUpSelectionSections sss = fromMaybe (firstPosSelectionSections sss) $ do scrollUpSelectionSections sss = fromMaybe (firstPosSelectionSections sss) $ do
i <- sss ^? sssSelPos . _Just (i, j) <- sss ^? sssSelPos . _Just
j <- sss ^? sssSections . ix i . ssCursor . _Just . scurSel
(i', j', si) <- ssLookupUp i j sss (i', j', si) <- ssLookupUp i j sss
return $ sss & sssSelPos ?~ i' return $ sss & sssSelPos ?~ (i', j')
& sssSections . ix i' . ssCursor ?~ SectionCursor j' j' (_siHeight si) (_siColor si)
-- & sssSections . ix i' . ssCursor ?~ SectionCursor j' j' (_siHeight si) (_siColor si)
scrollDownSelectionSections :: SelectionSections a -> SelectionSections a scrollDownSelectionSections :: SelectionSections a -> SelectionSections a
scrollDownSelectionSections sss = fromMaybe (firstPosSelectionSections sss) $ do scrollDownSelectionSections sss = fromMaybe (firstPosSelectionSections sss) $ do
i <- sss ^? sssSelPos . _Just (i, j) <- sss ^? sssSelPos . _Just
j <- sss ^? sssSections . ix i . ssCursor . _Just . scurSel -- j <- sss ^? sssSections . ix i . ssCursor . _Just . scurSel
(i', j', si) <- ssLookupDown i j sss (i', j', si) <- ssLookupDown i j sss
return $ sss & sssSelPos ?~ i' return $ sss & sssSelPos ?~ (i', j')
& sssSections . ix i' . ssCursor ?~ SectionCursor j' j' (_siHeight si) (_siColor si)
ssSetCursor :: (SelectionSections a -> Maybe (Int,Int,SelectionItem a)) -- & sssSections . ix i' . ssCursor ?~ SectionCursor j' j' (_siHeight si) (_siColor si)
-> SelectionSections a -> SelectionSections a
ssSetCursor ::
(SelectionSections a -> Maybe (Int, Int, SelectionItem a)) ->
SelectionSections a ->
SelectionSections a
ssSetCursor f sss = fromMaybe sss $ do ssSetCursor f sss = fromMaybe sss $ do
(i, j, si) <- f sss (i, j, si) <- f sss
return $ sss return $
& sssSelPos ?~ i sss
& sssSections . ix i . ssCursor ?~ SectionCursor j j (_siHeight si) (_siColor si) & sssSelPos ?~ (i, j)
-- & sssSections . ix i . ssCursor ?~ SectionCursor j j (_siHeight si) (_siColor si)
ssLookupMax :: SelectionSections a -> Maybe (Int, Int, SelectionItem a) ssLookupMax :: SelectionSections a -> Maybe (Int, Int, SelectionItem a)
ssLookupMax sss = do ssLookupMax sss = do
+6 -5
View File
@@ -6,6 +6,7 @@ module Dodge.Update.Input (
doRegexInput, doRegexInput,
) where ) where
import Dodge.SelectionSections
import Dodge.Default.World import Dodge.Default.World
import Data.Char import Data.Char
import qualified Data.IntMap.Strict as IM import qualified Data.IntMap.Strict as IM
@@ -18,7 +19,7 @@ import Dodge.Combine
import Dodge.Creature.Action import Dodge.Creature.Action
import Dodge.Data.Universe import Dodge.Data.Universe
import Dodge.Debug.Terminal import Dodge.Debug.Terminal
import Dodge.DisplayInventory --import Dodge.DisplayInventory
import Dodge.Event.Test import Dodge.Event.Test
import Dodge.Inventory import Dodge.Inventory
import Dodge.Menu import Dodge.Menu
@@ -28,7 +29,7 @@ import Dodge.Terminal.LeftButton
import Dodge.WorldPos import Dodge.WorldPos
import LensHelp import LensHelp
import SDL import SDL
import SelectionIntMap --import SelectionIntMap
doTextInputOver :: ASetter' Universe String -> Universe -> Universe doTextInputOver :: ASetter' Universe String -> Universe -> Universe
doTextInputOver p u = doTextInputOver p u =
@@ -184,7 +185,7 @@ updateBackspaceRegex w = case di ^? subInventory of
_ -> w _ -> w
where where
secfocus a b = fromMaybe False $ do secfocus a b = fromMaybe False $ do
i <- di ^? diSections . sssSelPos . _Just i <- di ^? diSections . sssSelPos . _Just . _1
return $ i == a || i == b return $ i == a || i == b
trybackspace cm = case cm ^? invRegex . _Just of trybackspace cm = case cm ^? invRegex . _Just of
Just (_ : _) -> Just (_ : _) ->
@@ -226,14 +227,14 @@ updateEnterRegex w = case w ^? hud . hudElement . subInventory of
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 i <- di ^? diSections . 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 i <- sss ^? sssSelPos . _Just . _1
return $ sss & sssSections . ix i %~ f return $ sss & sssSections . ix i %~ f
pauseGame :: Universe -> Universe pauseGame :: Universe -> Universe
+2 -2
View File
@@ -33,10 +33,10 @@ updateWheelEvent yi w = case w ^. hud . hudElement of
(Just f, _) -> doHeldScroll f y (you w) w (Just f, _) -> doHeldScroll f y (you w) w
| lbDown -> w & cWorld . camPos . camZoom +~ y | lbDown -> w & cWorld . camPos . camZoom +~ y
| invKeyDown -> changeSwapInvSel yi w | invKeyDown -> changeSwapInvSel yi w
| otherwise -> stopSoundFrom (CrReloadSound 0) $ changeAugInvSel yi w | otherwise -> stopSoundFrom (CrReloadSound 0) $ scrollAugInvSel yi w
DisplayInventory {_subInventory = ExamineInventory mi} DisplayInventory {_subInventory = ExamineInventory mi}
| invKeyDown && rbDown -> w & moveTweakSel yi | invKeyDown && rbDown -> w & moveTweakSel yi
| invKeyDown -> stopSoundFrom (CrReloadSound 0) $ changeAugInvSel yi w | invKeyDown -> stopSoundFrom (CrReloadSound 0) $ scrollAugInvSel yi w
| rbDown -> w & changeTweakParam mi yi | rbDown -> w & changeTweakParam mi yi
| otherwise -> w & moveTweakSel yi | otherwise -> w & moveTweakSel yi
DisplayInventory {_subInventory = CombineInventory {}} -> w & moveCombineSel yi DisplayInventory {_subInventory = CombineInventory {}} -> w & moveCombineSel yi