This commit is contained in:
2025-08-26 18:51:14 +01:00
parent b87c3380b8
commit 1ebdbdd8ae
34 changed files with 210 additions and 246 deletions
+24 -59
View File
@@ -39,10 +39,7 @@ ssScrollUsing ::
IMSS a ->
Maybe Selection ->
Maybe Selection
ssScrollUsing g =
ssScrollMinOnFail
g
. fmap (ssItems %~ IM.filter _siIsSelectable)
ssScrollUsing g = ssScrollMinOnFail g . fmap (ssItems %~ IM.filter _siIsSelectable)
ssScrollMinOnFail ::
(Int -> Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)) ->
@@ -60,8 +57,8 @@ ssScrollMinOnFail f sss msel = fmap (\(i, j, _) -> Sel i j (q i j)) $ l <|> ssLo
f i j sss
ssSetCursor ::
(IM.IntMap (SelectionSection a) -> Maybe (Int, Int, SelectionItem a)) ->
IM.IntMap (SelectionSection a) ->
(IMSS a -> Maybe (Int, Int, SelectionItem a)) ->
IMSS a ->
Maybe Selection ->
Maybe Selection
ssSetCursor f sss msel = fromMaybe msel $ do
@@ -72,111 +69,87 @@ ssSetCursor f sss msel = fromMaybe msel $ do
return xs
return $ Just (Sel i j newxs)
ssLookupMax :: IM.IntMap (SelectionSection a) -> Maybe (Int, Int, SelectionItem a)
ssLookupMax :: IMSS a -> Maybe (Int, Int, SelectionItem a)
ssLookupMax sss = do
(i, _) <- IM.lookupMax sss
ssLookupLE' i sss
ssLookupUp ::
Int ->
Int ->
IM.IntMap (SelectionSection a) ->
Maybe (Int, Int, SelectionItem a)
ssLookupUp :: Int -> Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)
ssLookupUp i j sss = case ssLookupLT i j sss of
Nothing -> ssLookupMax sss
x -> x
ssLookupDown ::
Int ->
Int ->
IM.IntMap (SelectionSection a) ->
Maybe (Int, Int, SelectionItem a)
ssLookupDown :: Int -> Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)
ssLookupDown i j sss = case ssLookupGT i j sss of
Nothing -> ssLookupMin sss
x -> x
ssLookupNextMax ::
Int ->
Int ->
IM.IntMap (SelectionSection a) ->
Maybe (Int, Int, SelectionItem a)
ssLookupNextMax :: Int -> Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)
ssLookupNextMax i j sss = case ssLookupGT i j sss of
Just x@(i',j',_) | i' == i && j' > j -> Just x
_ -> ssLookupMaxInSection i sss <|> ssLookupDown i j sss
ssLookupMaxInSection :: Int -> IM.IntMap (SelectionSection a) ->
Maybe (Int, Int, SelectionItem a)
ssLookupMaxInSection :: Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)
ssLookupMaxInSection i sss = do
ss <- sss ^? ix i . ssItems
(j,s) <- IM.lookupMax ss
return (i,j,s)
ssLookupLT ::
Int ->
Int ->
IM.IntMap (SelectionSection a) ->
Maybe (Int, Int, SelectionItem a)
ssLookupLT :: Int -> Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)
ssLookupLT i j sss = fromMaybe (ssLookupLT' i sss) $ do
ss <- sss ^? ix i
(j', si) <- IM.lookupLT j (ss ^. ssItems)
return $ Just (i, j', si)
ssLookupLT' ::
Int ->
IM.IntMap (SelectionSection a) ->
Maybe (Int, Int, SelectionItem a)
ssLookupLT' :: Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)
ssLookupLT' i sss = do
(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 -> IM.IntMap (SelectionSection a) -> Maybe (Int, Int, SelectionItem a)
ssLookupLE' :: Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)
ssLookupLE' i sss = do
(i', ss) <- IM.lookupLE i sss
case IM.lookupMax (ss ^. ssItems) of
Just (j', si) -> return (i', j', si)
Nothing -> ssLookupLT' i' sss
ssLookupMin :: IM.IntMap (SelectionSection a) -> Maybe (Int, Int, SelectionItem a)
ssLookupMin :: IMSS a -> Maybe (Int, Int, SelectionItem a)
ssLookupMin sss = do
(i, _) <- IM.lookupMin sss
ssLookupGE' i sss
ssLookupGT ::
Int ->
Int ->
IM.IntMap (SelectionSection a) ->
Maybe (Int, Int, SelectionItem a)
ssLookupGT :: Int -> Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)
ssLookupGT i j sss = fromMaybe (ssLookupGT' i sss) $ do
ss <- sss ^? ix i
(j', si) <- IM.lookupGT j (ss ^. ssItems)
return $ Just (i, j', si)
ssLookupGT' :: Int -> IM.IntMap (SelectionSection a) -> Maybe (Int, Int, SelectionItem a)
ssLookupGT' :: Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)
ssLookupGT' i sss = do
(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 -> IM.IntMap (SelectionSection a) -> Maybe (Int, Int, SelectionItem a)
ssLookupGE' :: Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)
ssLookupGE' i sss = do
(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 -> IM.IntMap (SelectionSection a) -> Maybe Int
selSecSelSize :: Int -> Int -> IMSS a -> Maybe Int
selSecSelSize i j = (^? ix i . ssItems . ix j . siHeight)
-- need to check that the vertical gap is correctly put in here
posSelSecYint :: Configuration -> ListDisplayParams -> Float -> Int
posSelSecYint :: Config -> ListDisplayParams -> Float -> Int
posSelSecYint cfig ldp y = floor $ (y0 - y) / (20 / ldp ^. ldpScale + ldp ^. ldpVerticalGap)
where
V2 _ y0 = screenPosAbs cfig (ldp ^. ldpPos)
selSecYint :: Int -> Int -> IM.IntMap (SelectionSection a) -> Maybe Int
selSecYint :: Int -> Int -> IMSS a -> Maybe Int
selSecYint i j sss = do
ss <- sss ^? ix i
return . (secpos +)
@@ -188,7 +161,7 @@ selSecYint i j sss = do
where
secpos = sum . fmap _ssShownLength . fst $ IM.split i sss
inverseSelSecYint :: Int -> IM.IntMap (SelectionSection a) -> XInfinity (Int, Int)
inverseSelSecYint :: Int -> IMSS a -> XInfinity (Int, Int)
inverseSelSecYint yint sss
| yint < 0 = NegInf
| otherwise = fromMaybe PosInf $ do
@@ -202,11 +175,11 @@ inverseSelSecYint yint sss
return $ NonInf (i, j)
inverseSelSecYintXPosCheck ::
Configuration ->
Config ->
ListDisplayParams ->
Float ->
Int ->
IM.IntMap (SelectionSection a) ->
IMSS a ->
Maybe (Int,Int)
inverseSelSecYintXPosCheck cfig ldp x yint sss = do
(i,j) <- inverseSelSecYint yint sss ^? nonInf
@@ -217,14 +190,6 @@ inverseSelSecYintXPosCheck cfig ldp x yint sss = do
guard $ x - x1 < 160 && x > x1
return (i,j)
inverseSelNumPos ::
Configuration ->
ListDisplayParams ->
IM.IntMap (SelectionSection a) ->
Point2 ->
Maybe (Int, Int)
inverseSelNumPos cfig ldp sss (V2 x y) =
inverseSelSecYintXPosCheck cfig ldp x (posSelSecYint cfig ldp y) sss
--getIthPos :: Int -> IM.IntMap (SelectionItem a) -> Int
--getIthPos i sm = sum . fmap _siHeight . fst $ IM.split i sm
inverseSelNumPos :: Config -> ListDisplayParams -> Point2 -> IMSS a -> Maybe (Int, Int)
inverseSelNumPos cfig ldp (V2 x y) =
inverseSelSecYintXPosCheck cfig ldp x (posSelSecYint cfig ldp y)