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

Remove SelectionSections

Browse Source
This commit is contained in:
justin
2024-10-25 22:19:04 +01:00
parent a20fc48eaa
commit d93c548d3c
15 changed files with 202 additions and 195 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/SelectionSections.hs
+60 -41
View File
@@ -17,17 +17,17 @@ import Control.Applicative
import qualified Control.Foldl as L
import Control.Lens
import Control.Monad
import Data.Foldable
import qualified Data.IntMap.Strict as IM
import Data.Maybe
import Dodge.Data.Config
import Dodge.Data.SelectionList
import Dodge.ScreenPos
import Geometry.Data
import Data.Foldable
scrollSelectionSections ::
Int ->
SelectionSections a ->
IM.IntMap (SelectionSection a) ->
Maybe (Int, Int) ->
Maybe (Int, Int)
scrollSelectionSections yi sss msel
@@ -41,18 +41,18 @@ scrollSelectionSections yi sss msel
-- return $ sss & sssExtra . sssSelPos ?~ (i, j)
ssScrollUsing ::
(Int -> Int -> SelectionSections a -> Maybe (Int, Int, SelectionItem a)) ->
SelectionSections a ->
(Int -> Int -> IM.IntMap (SelectionSection a) -> Maybe (Int, Int, SelectionItem a)) ->
IM.IntMap (SelectionSection a) ->
Maybe (Int, Int) ->
Maybe (Int, Int)
ssScrollUsing g =
ssScrollMinOnFail
g
. (sssSections %~ fmap (ssItems %~ IM.filter _siIsSelectable))
. fmap (ssItems %~ IM.filter _siIsSelectable)
ssScrollMinOnFail ::
(Int -> Int -> SelectionSections a -> Maybe (Int, Int, SelectionItem a)) ->
SelectionSections a ->
(Int -> Int -> IM.IntMap (SelectionSection a) -> Maybe (Int, Int, SelectionItem a)) ->
IM.IntMap (SelectionSection a) ->
Maybe (Int, Int) ->
Maybe (Int, Int)
ssScrollMinOnFail f sss msel = fmap (\(i, j, _) -> (i, j)) $ l <|> ssLookupMin sss
@@ -62,76 +62,95 @@ ssScrollMinOnFail f sss msel = fmap (\(i, j, _) -> (i, j)) $ l <|> ssLookupMin s
f i j sss
ssSetCursor ::
(SelectionSections a -> Maybe (Int, Int, SelectionItem a)) ->
SelectionSections a ->
(IM.IntMap (SelectionSection a) -> Maybe (Int, Int, SelectionItem a)) ->
IM.IntMap (SelectionSection a) ->
Maybe (Int, Int) ->
Maybe (Int, Int)
ssSetCursor f sss msel = fromMaybe msel $ do
(i, j, _) <- f sss
return $ Just (i, j)
ssLookupMax :: SelectionSections a -> Maybe (Int, Int, SelectionItem a)
ssLookupMax :: IM.IntMap (SelectionSection a) -> Maybe (Int, Int, SelectionItem a)
ssLookupMax sss = do
(i, _) <- IM.lookupMax (sss ^. sssSections)
(i, _) <- IM.lookupMax sss
ssLookupLE' i sss
ssLookupUp :: Int -> Int -> SelectionSections a -> Maybe (Int, Int, SelectionItem a)
ssLookupUp ::
Int ->
Int ->
IM.IntMap (SelectionSection 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 ::
Int ->
Int ->
IM.IntMap (SelectionSection 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 ::
Int ->
Int ->
IM.IntMap (SelectionSection a) ->
Maybe (Int, Int, SelectionItem a)
ssLookupLT i j sss = fromMaybe (ssLookupLT' i sss) $ do
ss <- sss ^? sssSections . ix i
ss <- sss ^? ix i
(j', si) <- IM.lookupLT j (ss ^. ssItems)
return $ Just (i, j', si)
ssLookupLT' :: Int -> SelectionSections a -> Maybe (Int, Int, SelectionItem a)
ssLookupLT' ::
Int ->
IM.IntMap (SelectionSection a) ->
Maybe (Int, Int, SelectionItem a)
ssLookupLT' i sss = do
(i', ss) <- IM.lookupLT i (sss ^. sssSections)
(i', ss) <- IM.lookupLT i sss
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' :: Int -> IM.IntMap (SelectionSection a) -> Maybe (Int, Int, SelectionItem a)
ssLookupLE' i sss = do
(i', ss) <- IM.lookupLE i (sss ^. sssSections)
(i', ss) <- IM.lookupLE i sss
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 :: IM.IntMap (SelectionSection a) -> Maybe (Int, Int, SelectionItem a)
ssLookupMin sss = do
(i, _) <- IM.lookupMin (sss ^. sssSections)
(i, _) <- IM.lookupMin sss
ssLookupGE' i sss
ssLookupGT :: Int -> Int -> SelectionSections a -> Maybe (Int, Int, SelectionItem a)
ssLookupGT ::
Int ->
Int ->
IM.IntMap (SelectionSection a) ->
Maybe (Int, Int, SelectionItem a)
ssLookupGT i j sss = fromMaybe (ssLookupGT' i sss) $ do
ss <- sss ^? sssSections . ix i
ss <- sss ^? ix i
(j', si) <- IM.lookupGT j (ss ^. ssItems)
return $ Just (i, j', si)
ssLookupGT' :: Int -> SelectionSections a -> Maybe (Int, Int, SelectionItem a)
ssLookupGT' :: Int -> IM.IntMap (SelectionSection a) -> Maybe (Int, Int, SelectionItem a)
ssLookupGT' i sss = do
(i', ss) <- IM.lookupGT i (sss ^. sssSections)
(i', ss) <- IM.lookupGT i sss
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' :: Int -> IM.IntMap (SelectionSection a) -> Maybe (Int, Int, SelectionItem a)
ssLookupGE' i sss = do
(i', ss) <- IM.lookupGE i (sss ^. sssSections)
(i', ss) <- IM.lookupGE i sss
case IM.lookupMin (ss ^. ssItems) of
Just (j', si) -> return (i', j', si)
Nothing -> ssLookupGT' i' sss
selSecSelSize :: Int -> Int -> SelectionSections a -> Maybe Int
selSecSelSize i j sss = fmap length $ sss ^? sssSections . ix i . ssItems . ix j . siPictures
selSecSelSize :: Int -> Int -> IM.IntMap (SelectionSection a) -> Maybe Int
selSecSelSize i j = fmap length . (^? ix i . ssItems . ix j . siPictures)
-- need to check that the vertical gap is correctly put in here
posSelSecYint :: Configuration -> ListDisplayParams -> Float -> Int
@@ -139,9 +158,9 @@ posSelSecYint cfig ldp y = floor $ (y0 - y) / (20 / ldp ^. ldpScale + ldp ^. ldp
where
V2 _ y0 = screenPosAbs cfig (ldp ^. ldpPos)
selSecYint :: Int -> Int -> SelectionSections a -> Maybe Int
selSecYint :: Int -> Int -> IM.IntMap (SelectionSection a) -> Maybe Int
selSecYint i j sss = do
ss <- sss ^? sssSections . ix i
ss <- sss ^? ix i
return . (secpos +)
. subtract (ss ^. ssOffset)
. sum
@@ -149,16 +168,16 @@ selSecYint i j sss = do
. fst
$ IM.split j (ss ^. ssItems)
where
secpos = sum . fmap (length . _ssShownItems) . fst $ IM.split i $ sss ^. sssSections
secpos = sum . fmap (length . _ssShownItems) . fst $ IM.split i $ sss
-- it is annoying that Control.Foldl doesn't seem to allow for scans to be done
-- at the same time as folds
inverseSelSecYint :: Int -> SelectionSections a -> Maybe (Int, Int)
inverseSelSecYint :: Int -> IM.IntMap (SelectionSection a) -> Maybe (Int, Int)
inverseSelSecYint yint sss = do
((i, ss), othersss) <- IM.minViewWithKey (_sssSections sss)
((i, ss), othersss) <- IM.minViewWithKey sss
let l = length $ _ssShownItems ss
if l <= yint
then inverseSelSecYint (yint - l) (sss & sssSections .~ othersss)
then inverseSelSecYint (yint - l) othersss
else do
let ls = L.postscan (L.premap _siHeight L.sum) (_ssItems ss)
j <- L.fold (L.findIndex (\x -> x - _ssOffset ss > yint)) ls
@@ -169,15 +188,15 @@ inverseSelSecYintXPosCheck ::
ListDisplayParams ->
Float ->
Int ->
SelectionSections a ->
IM.IntMap (SelectionSection a) ->
Maybe (Int, Int)
inverseSelSecYintXPosCheck cfig ldp x yint sss = do
((i, ss), othersss) <- IM.minViewWithKey (_sssSections sss)
((i, ss), othersss) <- IM.minViewWithKey sss
let l = length $ _ssShownItems ss
V2 x0 _ = screenPosAbs cfig (ldp ^. ldpPos)
guard (x - x0 < 150) -- HACK, should determine selection item width and offset below
if l <= yint
then inverseSelSecYint (yint - l) (sss & sssSections .~ othersss)
then inverseSelSecYint (yint - l) othersss
else do
let ls = L.postscan (L.premap _siHeight L.sum) (_ssItems ss)
j <- L.fold (L.findIndex (\val -> val - _ssOffset ss > yint)) ls
@@ -186,7 +205,7 @@ inverseSelSecYintXPosCheck cfig ldp x yint sss = do
inverseSelNumPos ::
Configuration ->
ListDisplayParams ->
SelectionSections a ->
IM.IntMap (SelectionSection a) ->
Point2 ->
Maybe (Int, Int)
inverseSelNumPos cfig ldp sss (V2 x y) =
@@ -195,7 +214,7 @@ inverseSelNumPos cfig ldp sss (V2 x y) =
inverseSelBoundaryUp ::
Configuration ->
ListDisplayParams ->
SelectionSections a ->
IM.IntMap (SelectionSection a) ->
Point2 ->
Maybe (Int, Int)
inverseSelBoundaryUp cfig ldp sss (V2 _ y) = do
@@ -208,7 +227,7 @@ inverseSelBoundaryUp cfig ldp sss (V2 _ y) = do
inverseSelBoundaryDown ::
Configuration ->
ListDisplayParams ->
SelectionSections a ->
IM.IntMap (SelectionSection a) ->
Point2 ->
Maybe (Int, Int)
inverseSelBoundaryDown cfig ldp sss (V2 _ y) = do