Tweak cursor storage on sss
This commit is contained in:
@@ -4,10 +4,11 @@ module Dodge.DisplayInventory
|
||||
, defaultSS
|
||||
, defaultFiltSection
|
||||
, defaultDisplaySections
|
||||
, updateSections
|
||||
-- , updateSections
|
||||
, updateSection
|
||||
) where
|
||||
|
||||
import Control.Monad
|
||||
import Regex
|
||||
import Data.Maybe
|
||||
import Picture.Base
|
||||
@@ -26,13 +27,10 @@ import Dodge.Data.World
|
||||
|
||||
updateDisplayInventory :: World -> Configuration -> SelectionSections () -> SelectionSections ()
|
||||
updateDisplayInventory w cfig sss = case cr ^? crManipulation . manObject of
|
||||
-- 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
|
||||
Just mo -> updateSectionsPositioning
|
||||
(sss & sssSelPos ?~ manObjIndex mo)
|
||||
availablelines
|
||||
(addorder mo)
|
||||
_ -> error "error when getting cr inv sel"
|
||||
where
|
||||
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]
|
||||
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,filtcloseitems)
|
||||
filtclosesec = fromMaybe (defaultFiltSection & ssIndent .~ 2)
|
||||
$ sss ^? sssSections . ix 2
|
||||
filtcloseitems = case cr ^? crManipulation . closeRegex . _Just of
|
||||
Just str -> IM.singleton 0 (SelectionRegex ["NEARBY FILTER: " ++ str,numfiltclose] 2 True white 0)
|
||||
Nothing -> mempty
|
||||
@@ -59,16 +52,11 @@ updateDisplayInventory w cfig sss = case cr ^? crManipulation . manObject of
|
||||
numfiltclose = " " ++ show numfiltclose' ++ " FILTERED"
|
||||
numfiltclose' = length coitems' - length 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 3
|
||||
invsec = fromMaybe defaultInvSection $ sss ^? sssSections . ix 0
|
||||
coitems' = IM.fromDistinctAscList . zip [0..]
|
||||
$ map closeObjectToSelectionItem (w ^. hud . closeObjects)
|
||||
coitems = case cr ^? crManipulation . closeRegex . _Just of
|
||||
@@ -91,29 +79,48 @@ displayFreeSlots x = case x of
|
||||
|
||||
updateSectionsPositioning
|
||||
:: SelectionSections a
|
||||
-> Int -> (Int, Int) -> [(Int,IM.IntMap (SelectionItem a))]
|
||||
-> Int -> [(Int,IM.IntMap (SelectionItem a))]
|
||||
-> SelectionSections a
|
||||
updateSectionsPositioning sss _ _ [] = sss & sssSections .~ mempty
|
||||
updateSectionsPositioning sss allavailablelines (i,j) ((k,y) : xs)
|
||||
updateSectionsPositioning sss _ [] = sss & sssSections .~ mempty
|
||||
updateSectionsPositioning sss allavailablelines ((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
|
||||
mscel = do
|
||||
(i,j) <- sss ^? sssSelPos . _Just
|
||||
guard $ i == k
|
||||
return j
|
||||
ss = updateSection y mscel 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
|
||||
linesleft = allavailablelines - sum (fmap linestaken $ _sssSections previoussections)
|
||||
linestaken ss' = max (length $ _ssShownItems ss') (_ssMinSize ss')
|
||||
previoussections = updateSectionsPositioning sss availablelines 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 (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
|
||||
--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 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)
|
||||
@@ -125,12 +132,12 @@ manObjIndex mo = case mo of
|
||||
InNearby (SelCloseObject i) -> (3,i)
|
||||
|
||||
updateSection
|
||||
:: Maybe Int
|
||||
-> IM.IntMap (SelectionItem a)
|
||||
:: IM.IntMap (SelectionItem a)
|
||||
-> Maybe Int
|
||||
-> Int
|
||||
-> SelectionSection a
|
||||
-> SelectionSection a
|
||||
updateSection mcsel sis availablelines ss = ss
|
||||
updateSection sis mcsel availablelines ss = ss
|
||||
{ _ssItems = sis
|
||||
, _ssCursor = scurs
|
||||
, _ssOffset = offset
|
||||
@@ -140,11 +147,11 @@ updateSection mcsel sis availablelines ss = ss
|
||||
oldoffset = ss ^. ssOffset
|
||||
scurs = do
|
||||
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)
|
||||
csize = length $ _siPictures si
|
||||
ccolor = _siColor si
|
||||
return $ SectionCursor csel (cpos - offset) csize ccolor
|
||||
return $ SectionCursor (cpos - offset) csize ccolor
|
||||
offset = fromMaybe oldoffset $ do
|
||||
csel <- mcsel
|
||||
maxcsel <- fst <$> IM.lookupMax sis
|
||||
@@ -178,12 +185,3 @@ updateSection mcsel sis availablelines ss = ss
|
||||
theindent = replicate (_ssIndent ss) ' '
|
||||
xtra str = color white . text $ theindent ++ str ++ " MORE " ++ _ssDescriptor ss
|
||||
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"
|
||||
|
||||
|
||||
Reference in New Issue
Block a user