Improve drawRBOptions positioning
This commit is contained in:
@@ -18,8 +18,8 @@ data LDParams = LDP -- List display parameters
|
|||||||
}
|
}
|
||||||
|
|
||||||
data CursorDisplay
|
data CursorDisplay
|
||||||
= BoundaryCursor [CardinalPoint]
|
= BoundCurs [CardinalPoint]
|
||||||
| BackdropCursor
|
| BackdropCurs
|
||||||
|
|
||||||
data SectionCursor = SectionCursor
|
data SectionCursor = SectionCursor
|
||||||
{ _scurPos :: Int
|
{ _scurPos :: Int
|
||||||
|
|||||||
@@ -51,19 +51,13 @@ invSelectionItem w indent loc =
|
|||||||
-- note the convoluted display of the hotkey/equipment, this was done to avoid a
|
-- note the convoluted display of the hotkey/equipment, this was done to avoid a
|
||||||
-- space leak
|
-- space leak
|
||||||
itemDisplay :: World -> Creature -> CItem -> [String]
|
itemDisplay :: World -> Creature -> CItem -> [String]
|
||||||
itemDisplay w cr ci = -- f
|
itemDisplay w cr ci = basicItemDisplay itm `g` anyextra
|
||||||
basicItemDisplay itm
|
|
||||||
-- (itemNumberDisplay w cr ci)
|
|
||||||
`g` anyextra
|
|
||||||
where
|
where
|
||||||
itm = ci ^. _1
|
itm = ci ^. _1
|
||||||
NInt itid = itm ^. itID
|
NInt itid = itm ^. itID
|
||||||
--f (x:xs) (y:_) = itemDisplayPad x y : xs
|
g (x:xs) (Just y) = (x <> y) : xs
|
||||||
--f xs _ = xs
|
|
||||||
--g (x:xs) (y:_) = (rightPad 15 ' ' x ++ y) : xs
|
|
||||||
g (x:xs) (y:_) = (x ++ y) : xs
|
|
||||||
g xs _ = xs
|
g xs _ = xs
|
||||||
anyextra = maybeToList (anyscroll <> anyexternal <> anyhotkey <> anyequippos)
|
anyextra = anyscroll <> anyexternal <> anyhotkey <> anyequippos
|
||||||
anyhotkey = fmap hotkeyToString
|
anyhotkey = fmap hotkeyToString
|
||||||
(w ^? cWorld . lWorld . imHotkeys . unNIntMap . ix itid)
|
(w ^? cWorld . lWorld . imHotkeys . unNIntMap . ix itid)
|
||||||
anyequippos = do
|
anyequippos = do
|
||||||
|
|||||||
@@ -17,7 +17,8 @@ import Linear
|
|||||||
import SDL (MouseButton (..))
|
import SDL (MouseButton (..))
|
||||||
|
|
||||||
defaultLDP :: LDParams
|
defaultLDP :: LDParams
|
||||||
defaultLDP = LDP
|
defaultLDP =
|
||||||
|
LDP
|
||||||
{ _ldpVerticalGap = 0
|
{ _ldpVerticalGap = 0
|
||||||
, _ldpScale = 1
|
, _ldpScale = 1
|
||||||
, _ldpPos =
|
, _ldpPos =
|
||||||
@@ -32,10 +33,13 @@ invDP :: LDParams
|
|||||||
invDP = defaultLDP & ldpPos . spPixelOff .~ V2 16 (-20)
|
invDP = defaultLDP & ldpPos . spPixelOff .~ V2 16 (-20)
|
||||||
|
|
||||||
invCursorParams :: World -> CursorDisplay
|
invCursorParams :: World -> CursorDisplay
|
||||||
invCursorParams w = BoundaryCursor $ case w ^? hud . subInventory of
|
invCursorParams w = BoundCurs $ case w ^? hud . subInventory of
|
||||||
-- Just ExamineInventory{} -> [North, South, East, West]
|
-- Just ExamineInventory{} -> [North, South, East, West]
|
||||||
Just CombineInventory{} -> []
|
Just CombineInventory{} -> []
|
||||||
_ | ButtonRight `M.member` _mouseButtons (_input w) -> [North, South, East, West]
|
_
|
||||||
|
| ButtonRight `M.member` _mouseButtons (_input w)
|
||||||
|
&& (null $ w ^? rbState . opSel) ->
|
||||||
|
[North, South, East, West]
|
||||||
_ -> [North, South, West]
|
_ -> [North, South, West]
|
||||||
|
|
||||||
secondColumnLDP :: LDParams
|
secondColumnLDP :: LDParams
|
||||||
|
|||||||
+48
-42
@@ -79,8 +79,8 @@ drawInventory sss w cfig = \case
|
|||||||
Just (_ : _) -> Nothing
|
Just (_ : _) -> Nothing
|
||||||
_ -> return . drawItemConnections sss cfig $ invAdj inv
|
_ -> return . drawItemConnections sss cfig $ invAdj inv
|
||||||
|
|
||||||
drawRootCursor
|
drawRootCursor ::
|
||||||
:: World -> IMSS () -> Maybe Selection -> LDParams -> Config -> Picture
|
World -> IMSS () -> Maybe Selection -> LDParams -> Config -> Picture
|
||||||
drawRootCursor w sss msel ldp cfig = fromMaybe mempty $ do
|
drawRootCursor w sss msel ldp cfig = fromMaybe mempty $ do
|
||||||
cr <- w ^? cWorld . lWorld . creatures . ix 0
|
cr <- w ^? cWorld . lWorld . creatures . ix 0
|
||||||
guard $ crIsAiming cr
|
guard $ crIsAiming cr
|
||||||
@@ -90,13 +90,17 @@ drawRootCursor w sss msel ldp cfig = fromMaybe mempty $ do
|
|||||||
inv' <- w ^? cWorld . lWorld . creatures . ix 0 . crInv
|
inv' <- w ^? cWorld . lWorld . creatures . ix 0 . crInv
|
||||||
let inv = fmap (\k -> w ^?! cWorld . lWorld . items . ix k) inv'
|
let inv = fmap (\k -> w ^?! cWorld . lWorld . items . ix k) inv'
|
||||||
(x, y) <- getRootItemBounds j $ _unNIntMap inv
|
(x, y) <- getRootItemBounds j $ _unNIntMap inv
|
||||||
|
let curs =
|
||||||
|
if null (w ^? rbState . opSel)
|
||||||
|
then BoundCurs [minBound ..]
|
||||||
|
else BoundCurs [North, South, West]
|
||||||
return $
|
return $
|
||||||
drawSSMultiCursor
|
drawSSMultiCursor
|
||||||
sss
|
sss
|
||||||
(Just (0, x))
|
(Just (0, x))
|
||||||
(Just (y - x))
|
(Just (y - x))
|
||||||
ldp
|
ldp
|
||||||
(BoundaryCursor [minBound ..])
|
curs
|
||||||
cfig
|
cfig
|
||||||
|
|
||||||
getRootItemBounds :: Int -> IM.IntMap Item -> Maybe (Int, Int)
|
getRootItemBounds :: Int -> IM.IntMap Item -> Maybe (Int, Int)
|
||||||
@@ -125,7 +129,7 @@ drawMouseOver cfig w =
|
|||||||
-- . color white
|
-- . color white
|
||||||
$ selSecDrawCursor invDP curs sss (Sel j i mempty)
|
$ selSecDrawCursor invDP curs sss (Sel j i mempty)
|
||||||
-- curs = BoundaryCursor [West]
|
-- curs = BoundaryCursor [West]
|
||||||
curs = BackdropCursor
|
curs = BackdropCurs
|
||||||
combinvsel = do
|
combinvsel = do
|
||||||
(j, i) <-
|
(j, i) <-
|
||||||
(w ^? input . mouseContext . mcoCombSelect)
|
(w ^? input . mouseContext . mcoCombSelect)
|
||||||
@@ -148,7 +152,7 @@ drawDragSelected cfig w = do
|
|||||||
)
|
)
|
||||||
Sel i _ _ <- w ^? hud . diSelection . _Just
|
Sel i _ _ <- w ^? hud . diSelection . _Just
|
||||||
sss <- w ^? hud . diSections
|
sss <- w ^? hud . diSections
|
||||||
let f x = (selSecDrawCursor invDP BackdropCursor sss (Sel i x mempty) <>)
|
let f x = (selSecDrawCursor invDP BackdropCurs sss (Sel i x mempty) <>)
|
||||||
return
|
return
|
||||||
. translateScreenPos cfig (invDP ^. ldpPos)
|
. translateScreenPos cfig (invDP ^. ldpPos)
|
||||||
. color (0.2 *^ white)
|
. color (0.2 *^ white)
|
||||||
@@ -159,7 +163,7 @@ drawDragSelecting :: Config -> World -> Maybe Picture
|
|||||||
drawDragSelecting cfig w = do
|
drawDragSelecting cfig w = do
|
||||||
OverInvDragSelect (Just (i, j)) (Just b) <- w ^? input . mouseContext
|
OverInvDragSelect (Just (i, j)) (Just b) <- w ^? input . mouseContext
|
||||||
sss <- w ^? hud . diSections
|
sss <- w ^? hud . diSections
|
||||||
let f x = selSecDrawCursor invDP BackdropCursor sss (Sel i x mempty)
|
let f x = selSecDrawCursor invDP BackdropCurs sss (Sel i x mempty)
|
||||||
return
|
return
|
||||||
. translateScreenPos cfig (invDP ^. ldpPos)
|
. translateScreenPos cfig (invDP ^. ldpPos)
|
||||||
. color (0.2 *^ white)
|
. color (0.2 *^ white)
|
||||||
@@ -189,7 +193,7 @@ drawCombineInventory cfig sss w =
|
|||||||
<> foldMap (drawSSCursor sss secondColumnLDP curs cfig) msel
|
<> foldMap (drawSSCursor sss secondColumnLDP curs cfig) msel
|
||||||
<> combineInventoryExtra sss msel cfig w
|
<> combineInventoryExtra sss msel cfig w
|
||||||
where
|
where
|
||||||
curs = BoundaryCursor [North, South, West]
|
curs = BoundCurs [North, South, West]
|
||||||
msel = w ^? hud . subInventory . ciSelection . _Just
|
msel = w ^? hud . subInventory . ciSelection . _Just
|
||||||
|
|
||||||
drawExamineInventory :: Config -> World -> Picture
|
drawExamineInventory :: Config -> World -> Picture
|
||||||
@@ -259,49 +263,51 @@ drawRBOptions cfig w = fold $ do
|
|||||||
sss <- w ^? hud . diSections
|
sss <- w ^? hud . diSections
|
||||||
Sel i' j _ <- w ^? hud . diSelection . _Just
|
Sel i' j _ <- w ^? hud . diSelection . _Just
|
||||||
curpos <- selSecYint i' j sss
|
curpos <- selSecYint i' j sss
|
||||||
|
itext <- sss ^? ix i' . ssItems . ix j . siPictures . ix 0
|
||||||
|
ind <- sss ^? ix i' . ssItems . ix j . siOffX
|
||||||
let ytext = drawListElement 0 1 0 curpos . text
|
let ytext = drawListElement 0 1 0 curpos . text
|
||||||
midstr = equipAllocString ae
|
midstr = equipAllocString ae
|
||||||
extrastr = case ae of
|
extrastr = case ae of
|
||||||
SwapEquipment{_allocOldPos = oldp, _allocSwapID = sid} ->
|
SwapEquipment{_allocOldPos = oldp, _allocSwapID = sid} ->
|
||||||
"SWAPS " ++ otheritem sid ++ " ONTO " ++ eqPosText oldp
|
" SWAPS " ++ otheritem sid ++ " ONTO " ++ eqPosText oldp
|
||||||
ReplaceEquipment{_allocRemoveID = rid} ->
|
ReplaceEquipment{_allocRemoveID = rid} ->
|
||||||
"REMOVES " ++ otheritem rid
|
" REMOVES " ++ otheritem rid
|
||||||
_ -> ""
|
_ -> ""
|
||||||
return $
|
return
|
||||||
--toTopLeft cfig $
|
. translateScreenPos cfig (invDP ^. ldpPos)
|
||||||
translateScreenPos cfig (invDP ^. ldpPos) $
|
. translate (10 * fromIntegral (ind + length itext)) 0
|
||||||
--translate 290 (-1) (ytext midstr)
|
$ translate (290 - xt) 0 (ytext midstr)
|
||||||
translate 290 0 (ytext midstr)
|
<> translate
|
||||||
<> translate
|
(120 - xt)
|
||||||
160
|
0
|
||||||
|
( listCursor
|
||||||
0
|
0
|
||||||
( listCursorChooseBorderScale
|
1
|
||||||
0
|
(BoundCurs [North, South])
|
||||||
1
|
curpos
|
||||||
(BoundaryCursor [North, South])
|
|
||||||
curpos
|
|
||||||
0
|
|
||||||
white
|
|
||||||
21
|
|
||||||
1
|
|
||||||
)
|
|
||||||
<> translate
|
|
||||||
380
|
|
||||||
0
|
0
|
||||||
( drawListYoff (curpos - i) (map (text . eqPosText) eslist)
|
white
|
||||||
<> listCursorChooseBorderScale 0 1 (bc East) (curpos - i) 0 white 7 (length eslist)
|
25
|
||||||
<> listCursorChooseBorderScale 0 1 (bc West) (curpos + 1) 0 white 7 (length eslist - (i + 1))
|
1
|
||||||
<> listCursorChooseBorderScale 0 1 (bc West) (curpos - i) 0 white 7 i
|
)
|
||||||
<> maybetopborder i curpos
|
<> translate
|
||||||
<> maybebottomborder i (length eslist) curpos
|
(380 - xt)
|
||||||
)
|
0
|
||||||
<> translate 460 0 (ytext extrastr)
|
( drawListYoff (curpos - i) (map (text . eqPosText) eslist)
|
||||||
|
<> listCursor 0 1 (bc East) (curpos - i) 0 white 7 (length eslist)
|
||||||
|
<> listCursor 0 1 (bc West) (curpos + 1) 0 white 7 (length eslist - (i + 1))
|
||||||
|
<> listCursor 0 1 (bc West) (curpos - i) 0 white 7 i
|
||||||
|
<> maybetopborder i curpos
|
||||||
|
<> maybebottomborder i (length eslist) curpos
|
||||||
|
)
|
||||||
|
<> translate (460 - xt) 0 (ytext extrastr)
|
||||||
where
|
where
|
||||||
bc x = BoundaryCursor [x]
|
xt = 260
|
||||||
maybetopborder 0 curpos = listCursorChooseBorderScale 0 1 (bc North) curpos 0 white 7 1
|
bc x = BoundCurs [x]
|
||||||
|
maybetopborder 0 curpos = listCursor 0 1 (bc North) curpos 0 white 7 1
|
||||||
maybetopborder _ _ = mempty
|
maybetopborder _ _ = mempty
|
||||||
maybebottomborder a b curpos
|
maybebottomborder a b curpos
|
||||||
| a == b - 1 = listCursorChooseBorderScale 0 1 (bc South) curpos 0 white 7 1
|
| a == b - 1 = listCursor 0 1 (bc South) curpos 0 white 7 1
|
||||||
| otherwise = mempty
|
| otherwise = mempty
|
||||||
otheritem (NInt j) = fromMaybe "" $ do
|
otheritem (NInt j) = fromMaybe "" $ do
|
||||||
itype <- w ^? cWorld . lWorld . items . ix j . itType
|
itype <- w ^? cWorld . lWorld . items . ix j . itType
|
||||||
@@ -344,7 +350,7 @@ combineInventoryExtra sss msel cfig w = fold $ do
|
|||||||
translateScreenPos cfig (invDP ^. ldpPos) $
|
translateScreenPos cfig (invDP ^. ldpPos) $
|
||||||
selSecDrawCursor
|
selSecDrawCursor
|
||||||
invDP
|
invDP
|
||||||
(BoundaryCursor [North, South, East, West])
|
(BoundCurs [North, South, East, West])
|
||||||
(w ^. hud . diSections)
|
(w ^. hud . diSections)
|
||||||
(Sel 0 i mempty)
|
(Sel 0 i mempty)
|
||||||
|
|
||||||
@@ -353,7 +359,7 @@ drawTerminalDisplay w cfig tid = fold $ do
|
|||||||
tm <- w ^? cWorld . lWorld . terminals . ix tid
|
tm <- w ^? cWorld . lWorld . terminals . ix tid
|
||||||
let toselitm (str, col) = SelItem [str] 1 55 True col 0 Nothing NoSIDisplayMod
|
let toselitm (str, col) = SelItem [str] 1 55 True col 0 Nothing NoSIDisplayMod
|
||||||
f =
|
f =
|
||||||
--toselitm ("TERMINAL " ++ show tid, white)
|
-- toselitm ("TERMINAL " ++ show tid, white)
|
||||||
toselitm ("", white)
|
toselitm ("", white)
|
||||||
: ( map (toselitm . (_1 %~ (" " <>)))
|
: ( map (toselitm . (_1 %~ (" " <>)))
|
||||||
. displayTermInput
|
. displayTermInput
|
||||||
@@ -395,7 +401,7 @@ drawTerminalCursorLink w cfig tm = fold $ do
|
|||||||
(invDP ^. ldpPos)
|
(invDP ^. ldpPos)
|
||||||
( selSecDrawCursor
|
( selSecDrawCursor
|
||||||
invDP
|
invDP
|
||||||
(BoundaryCursor [North, South, East, West])
|
(BoundCurs [North, South, East, West])
|
||||||
(w ^. hud . diSections)
|
(w ^. hud . diSections)
|
||||||
(Sel 5 j mempty)
|
(Sel 5 j mempty)
|
||||||
)
|
)
|
||||||
|
|||||||
@@ -28,10 +28,10 @@ renderInfoListAt x y cfig cam (p, ss) =
|
|||||||
<> toTopLeft
|
<> toTopLeft
|
||||||
cfig
|
cfig
|
||||||
( translate x (- y) $
|
( translate x (- y) $
|
||||||
listCursorChooseBorderScale
|
listCursor
|
||||||
0
|
0
|
||||||
1
|
1
|
||||||
(BoundaryCursor [North, South])
|
(BoundCurs [North, South])
|
||||||
0
|
0
|
||||||
0
|
0
|
||||||
white
|
white
|
||||||
|
|||||||
@@ -10,7 +10,7 @@ module Dodge.Render.List (
|
|||||||
drawListYoff,
|
drawListYoff,
|
||||||
stackPicturesAt,
|
stackPicturesAt,
|
||||||
toTopLeft,
|
toTopLeft,
|
||||||
listCursorChooseBorderScale,
|
listCursor,
|
||||||
selSecDrawCursor,
|
selSecDrawCursor,
|
||||||
drawTitleBackground, -- should be renamed, made sensible
|
drawTitleBackground, -- should be renamed, made sensible
|
||||||
drawCursorAt,
|
drawCursorAt,
|
||||||
@@ -76,7 +76,7 @@ drawCursorAt mi lis ldps width curs = fromMaybe mempty $ do
|
|||||||
i <- mi
|
i <- mi
|
||||||
selit <- lis !? i
|
selit <- lis !? i
|
||||||
return $
|
return $
|
||||||
listCursorChooseBorderScale
|
listCursor
|
||||||
(_ldpVerticalGap ldps)
|
(_ldpVerticalGap ldps)
|
||||||
(_ldpScale ldps)
|
(_ldpScale ldps)
|
||||||
curs
|
curs
|
||||||
@@ -106,7 +106,7 @@ selSecDrawCursor ldp curs sss sel = fold $ do
|
|||||||
sindent <- sss ^? ix i . ssIndent
|
sindent <- sss ^? ix i . ssIndent
|
||||||
si <- sss ^? ix i . ssItems . ix j
|
si <- sss ^? ix i . ssItems . ix j
|
||||||
return $
|
return $
|
||||||
listCursorChooseBorderScale
|
listCursor
|
||||||
(ldp ^. ldpVerticalGap)
|
(ldp ^. ldpVerticalGap)
|
||||||
(ldp ^. ldpScale)
|
(ldp ^. ldpScale)
|
||||||
curs
|
curs
|
||||||
@@ -117,7 +117,7 @@ selSecDrawCursor ldp curs sss sel = fold $ do
|
|||||||
(_siHeight si)
|
(_siHeight si)
|
||||||
|
|
||||||
-- displays a cursor that should match up to list text pictures
|
-- displays a cursor that should match up to list text pictures
|
||||||
listCursorChooseBorderScale ::
|
listCursor ::
|
||||||
Float ->
|
Float ->
|
||||||
Float ->
|
Float ->
|
||||||
CursorDisplay ->
|
CursorDisplay ->
|
||||||
@@ -127,7 +127,7 @@ listCursorChooseBorderScale ::
|
|||||||
Int ->
|
Int ->
|
||||||
Int ->
|
Int ->
|
||||||
Picture
|
Picture
|
||||||
listCursorChooseBorderScale ygap s curs yint xint col cursxsize cursysize =
|
listCursor ygap s curs yint xint col cursxsize cursysize =
|
||||||
translate
|
translate
|
||||||
((10 * fromIntegral xint - 5) * s)
|
((10 * fromIntegral xint - 5) * s)
|
||||||
(-(ygap + (s * 20 + ygap) * fromIntegral yint))
|
(-(ygap + (s * 20 + ygap) * fromIntegral yint))
|
||||||
@@ -140,8 +140,8 @@ listCursorChooseBorderScale ygap s curs yint xint col cursxsize cursysize =
|
|||||||
-- note we cannot simply scale lines because they are drawn as solid rectangles
|
-- note we cannot simply scale lines because they are drawn as solid rectangles
|
||||||
chooseCursorBorders :: Float -> Float -> CursorDisplay -> Picture
|
chooseCursorBorders :: Float -> Float -> CursorDisplay -> Picture
|
||||||
chooseCursorBorders w h = \case
|
chooseCursorBorders w h = \case
|
||||||
BoundaryCursor ps -> foldMap (line . toLine) ps
|
BoundCurs ps -> foldMap (line . toLine) ps
|
||||||
BackdropCursor -> polygon $ rectNSWE 0 h' 0 w
|
BackdropCurs -> polygon $ rectNSWE 0 h' 0 w
|
||||||
where
|
where
|
||||||
h' = negate h
|
h' = negate h
|
||||||
toLine North = [V2 0 0, V2 w 0]
|
toLine North = [V2 0 0, V2 w 0]
|
||||||
|
|||||||
@@ -41,7 +41,7 @@ drawOptions title msel sl cf =
|
|||||||
<> translateScreenPos
|
<> translateScreenPos
|
||||||
cf
|
cf
|
||||||
(menuLDP ^. ldpPos)
|
(menuLDP ^. ldpPos)
|
||||||
(drawCursorAt msel sl menuLDP 50 (BoundaryCursor [North, South]))
|
(drawCursorAt msel sl menuLDP 50 (BoundCurs [North, South]))
|
||||||
|
|
||||||
darkenBackground :: Config -> Picture
|
darkenBackground :: Config -> Picture
|
||||||
darkenBackground = color (withAlpha 0.5 black) . polygon . reverse . screenBox
|
darkenBackground = color (withAlpha 0.5 black) . polygon . reverse . screenBox
|
||||||
|
|||||||
@@ -10,17 +10,17 @@ module Dodge.SelectionSections (
|
|||||||
inverseSelNumPos,
|
inverseSelNumPos,
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Dodge.Data.HUD
|
|
||||||
import Dodge.Data.CardinalPoint
|
|
||||||
import qualified Data.IntSet as IS
|
|
||||||
import Control.Applicative
|
import Control.Applicative
|
||||||
import qualified Control.Foldl as L
|
import qualified Control.Foldl as L
|
||||||
import Control.Lens
|
import Control.Lens
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
import Data.Foldable
|
import Data.Foldable
|
||||||
import qualified Data.IntMap.Strict as IM
|
import qualified Data.IntMap.Strict as IM
|
||||||
|
import qualified Data.IntSet as IS
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
|
import Dodge.Data.CardinalPoint
|
||||||
import Dodge.Data.Config
|
import Dodge.Data.Config
|
||||||
|
import Dodge.Data.HUD
|
||||||
import Dodge.Data.SelectionList
|
import Dodge.Data.SelectionList
|
||||||
import Dodge.ScreenPos
|
import Dodge.ScreenPos
|
||||||
import Geometry.Data
|
import Geometry.Data
|
||||||
@@ -86,14 +86,14 @@ ssLookupDown i j sss = case ssLookupGT i j sss of
|
|||||||
|
|
||||||
ssLookupNextMax :: Int -> Int -> IMSS 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
|
ssLookupNextMax i j sss = case ssLookupGT i j sss of
|
||||||
Just x@(i',j',_) | i' == i && j' > j -> Just x
|
Just x@(i', j', _) | i' == i && j' > j -> Just x
|
||||||
_ -> ssLookupMaxInSection i sss <|> ssLookupDown i j sss
|
_ -> ssLookupMaxInSection i sss <|> ssLookupDown i j sss
|
||||||
|
|
||||||
ssLookupMaxInSection :: Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)
|
ssLookupMaxInSection :: Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)
|
||||||
ssLookupMaxInSection i sss = do
|
ssLookupMaxInSection i sss = do
|
||||||
ss <- sss ^? ix i . ssItems
|
ss <- sss ^? ix i . ssItems
|
||||||
(j,s) <- IM.lookupMax ss
|
(j, s) <- IM.lookupMax ss
|
||||||
return (i,j,s)
|
return (i, j, s)
|
||||||
|
|
||||||
ssLookupLT :: Int -> Int -> IMSS 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
|
ssLookupLT i j sss = fromMaybe (ssLookupLT' i sss) $ do
|
||||||
@@ -152,7 +152,8 @@ posSelSecYint cfig ldp y = floor $ (y0 - y) / (20 / ldp ^. ldpScale + ldp ^. ldp
|
|||||||
selSecYint :: Int -> Int -> IMSS a -> Maybe Int
|
selSecYint :: Int -> Int -> IMSS a -> Maybe Int
|
||||||
selSecYint i j sss = do
|
selSecYint i j sss = do
|
||||||
ss <- sss ^? ix i
|
ss <- sss ^? ix i
|
||||||
return . (secpos +)
|
return
|
||||||
|
. (secpos +)
|
||||||
. subtract (ss ^. ssOffset)
|
. subtract (ss ^. ssOffset)
|
||||||
. sum
|
. sum
|
||||||
. fmap _siHeight
|
. fmap _siHeight
|
||||||
@@ -162,7 +163,7 @@ selSecYint i j sss = do
|
|||||||
secpos = sum . fmap _ssShownLength . fst $ IM.split i sss
|
secpos = sum . fmap _ssShownLength . fst $ IM.split i sss
|
||||||
|
|
||||||
inverseSelSecYint :: Int -> IMSS a -> XInfinity (Int, Int)
|
inverseSelSecYint :: Int -> IMSS a -> XInfinity (Int, Int)
|
||||||
inverseSelSecYint yint sss
|
inverseSelSecYint yint sss
|
||||||
| yint < 0 = NegInf
|
| yint < 0 = NegInf
|
||||||
| otherwise = fromMaybe PosInf $ do
|
| otherwise = fromMaybe PosInf $ do
|
||||||
((i, ss), othersss) <- IM.minViewWithKey sss
|
((i, ss), othersss) <- IM.minViewWithKey sss
|
||||||
@@ -171,19 +172,19 @@ inverseSelSecYint yint sss
|
|||||||
then return $ inverseSelSecYint (yint - l) othersss
|
then return $ inverseSelSecYint (yint - l) othersss
|
||||||
else do
|
else do
|
||||||
let ls = L.postscan (L.premap _siHeight L.sum) (_ssItems ss)
|
let ls = L.postscan (L.premap _siHeight L.sum) (_ssItems ss)
|
||||||
(j,_) <- L.fold (L.find (\(_,x) -> x - _ssOffset ss > yint)) $ IM.toList ls
|
(j, _) <- L.fold (L.find (\(_, x) -> x - _ssOffset ss > yint)) $ IM.toList ls
|
||||||
return $ NonInf (i, j)
|
return $ NonInf (i, j)
|
||||||
|
|
||||||
inverseSelSecYintXPosCheck ::
|
inverseSelSecYintXPosCheck ::
|
||||||
Config -> LDParams -> Float -> Int -> IMSS a -> Maybe (Int,Int)
|
Config -> LDParams -> Float -> Int -> IMSS a -> Maybe (Int, Int)
|
||||||
inverseSelSecYintXPosCheck cfig ldp x yint sss = do
|
inverseSelSecYintXPosCheck cfig ldp x yint sss = do
|
||||||
(i,j) <- inverseSelSecYint yint sss ^? nonInf
|
(i, j) <- inverseSelSecYint yint sss ^? nonInf
|
||||||
let V2 x0 _ = screenPosAbs cfig (ldp ^. ldpPos)
|
let V2 x0 _ = screenPosAbs cfig (ldp ^. ldpPos)
|
||||||
sindent <- sss ^? ix i . ssIndent
|
sindent <- sss ^? ix i . ssIndent
|
||||||
itindent <- sss ^? ix i . ssItems . ix j . siOffX
|
itindent <- sss ^? ix i . ssItems . ix j . siOffX
|
||||||
let x1 = x0 + _ldpScale ldp * 10 * (fromIntegral (sindent + itindent) - 0.5)
|
let x1 = x0 + _ldpScale ldp * 10 * (fromIntegral (sindent + itindent) - 0.5)
|
||||||
guard $ x - x1 < 160 && x > x1
|
guard $ x - x1 < 160 && x > x1
|
||||||
return (i,j)
|
return (i, j)
|
||||||
|
|
||||||
inverseSelNumPos :: Config -> LDParams -> Point2 -> IMSS a -> Maybe (Int, Int)
|
inverseSelNumPos :: Config -> LDParams -> Point2 -> IMSS a -> Maybe (Int, Int)
|
||||||
inverseSelNumPos cfig ldp (V2 x y) =
|
inverseSelNumPos cfig ldp (V2 x y) =
|
||||||
|
|||||||
@@ -55,7 +55,7 @@ drawSSMultiCursor sss msel mextra ldp curs cfig = translateScreenPos cfig (ldp ^
|
|||||||
maxxoff = maximum . fmap _siOffX $ selitms
|
maxxoff = maximum . fmap _siOffX $ selitms
|
||||||
minxoff = minimum . fmap _siOffX $ selitms
|
minxoff = minimum . fmap _siOffX $ selitms
|
||||||
return $
|
return $
|
||||||
listCursorChooseBorderScale
|
listCursor
|
||||||
(ldp ^. ldpVerticalGap)
|
(ldp ^. ldpVerticalGap)
|
||||||
(ldp ^. ldpScale)
|
(ldp ^. ldpScale)
|
||||||
curs
|
curs
|
||||||
|
|||||||
Reference in New Issue
Block a user