Allow for swapping inventory items

This commit is contained in:
2023-02-23 14:12:08 +00:00
parent 6fff71cdcc
commit 683acf8a05
9 changed files with 161 additions and 104 deletions
+27 -30
View File
@@ -17,41 +17,37 @@ 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
| yi > 0 = foldr ($) sss $ replicate yi (ssScrollUsing ssLookupUp)
| otherwise = foldr ($) sss $ replicate (negate yi) (ssScrollUsing ssLookupDown)
setFirstPosSelectionSections :: SelectionSections a -> SelectionSections a
setFirstPosSelectionSections sss = fromMaybe sss $ do
(i, j, _) <- ssLookupMin sss
return $ sss & sssExtra . sssSelPos ?~ (i, j)
scrollUpSelectionSections :: SelectionSections a -> SelectionSections a
scrollUpSelectionSections sss = sss & sssExtra . sssSelPos .~
fmap f (ssScrollUp (sss & sssSections %~ fmap (ssItems %~ IM.filter _siIsSelectable)))
ssScrollUsing ::
(Int -> Int -> SelectionSections a -> Maybe (Int, Int, SelectionItem a)) ->
SelectionSections a ->
SelectionSections a
ssScrollUsing g sss =
sss & sssExtra . sssSelPos
.~ fmap f (ssScrollUsing' g (sss & sssSections %~ fmap (ssItems %~ IM.filter _siIsSelectable)))
where
f (i,j,_) = (i,j)
f (i, j, _) = (i, j)
ssScrollUp :: SelectionSections a -> Maybe (Int,Int,SelectionItem a)
ssScrollUp sss = l <|> ssLookupMin sss
ssScrollUsing' ::
( Int ->
Int ->
SelectionSections a ->
Maybe (Int, Int, SelectionItem a)
) ->
SelectionSections a ->
Maybe (Int, Int, SelectionItem a)
ssScrollUsing' f sss = l <|> ssLookupMin sss
where
l = do
(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 ^? sssExtra . sssSelPos . _Just
ssLookupDown i j sss
scrollDownSelectionSections :: SelectionSections a -> SelectionSections a
scrollDownSelectionSections sss = sss & sssExtra . sssSelPos .~
fmap f (ssScrollDown (sss & sssSections %~ fmap (ssItems %~ IM.filter _siIsSelectable)))
where
f (i,j,_) = (i,j)
-- & sssSections . ix i' . ssCursor ?~ SectionCursor j' j' (_siHeight si) (_siColor si)
(i, j) <- sss ^? sssExtra . sssSelPos . _Just
f i j sss
ssSetCursor ::
(SelectionSections a -> Maybe (Int, Int, SelectionItem a)) ->
@@ -131,11 +127,12 @@ selSecSelSize i j sss = fmap length $ sss ^? sssSections . ix i . ssItems . ix j
selSecSelPos :: Int -> Int -> SelectionSections a -> Maybe Int
selSecSelPos i j sss = do
ss <- sss ^? sssSections . ix i
return . (secpos +)
. subtract (ss ^. ssOffset)
. sum
. fmap (length . _siPictures)
. fst $ IM.split j (ss ^. ssItems)
return . (secpos +)
. subtract (ss ^. ssOffset)
. sum
. fmap (length . _siPictures)
. fst
$ IM.split j (ss ^. ssItems)
where
secpos = sum . fmap (length . _ssShownItems) . fst $ IM.split i $ sss ^. sssSections