mirror of
https://github.com/jtdaugherty/brick.git
synced 2025-01-05 21:03:07 +03:00
Add support for scrolling to windows rather than points and add support for variably-sized list prims
This commit is contained in:
parent
0c7914175a
commit
76a7fc83c8
@ -33,6 +33,7 @@ library
|
||||
vty >= 5.2.9,
|
||||
transformers,
|
||||
data-default,
|
||||
containers,
|
||||
lens
|
||||
|
||||
executable brick
|
||||
|
@ -96,7 +96,8 @@ listDrawElem sel i =
|
||||
maybeSelect = if sel
|
||||
then UseAttr selAttr
|
||||
else id
|
||||
in maybeSelect $ hCenter (Txt $ "Number " <> show i)
|
||||
in maybeSelect $ hCenter $ VBox $ for [1..i+1] $ \j ->
|
||||
(Txt $ "Item " <> show i <> " L" <> show j, High)
|
||||
|
||||
theApp :: App St Event
|
||||
theApp =
|
||||
|
@ -7,7 +7,9 @@ module Brick.List
|
||||
where
|
||||
|
||||
import Control.Applicative ((<$>), (<|>))
|
||||
import Graphics.Vty (Event(..), Key(..))
|
||||
import Data.Maybe (catMaybes)
|
||||
import Graphics.Vty (Event(..), Key(..), DisplayRegion)
|
||||
import qualified Data.Map as M
|
||||
|
||||
import Brick.Core (HandleEvent(..), SetSize(..))
|
||||
import Brick.Prim (Prim(..), Priority(..), (<<=), (<<+))
|
||||
@ -19,6 +21,7 @@ data List e =
|
||||
, listElementDraw :: Bool -> e -> Prim (List e)
|
||||
, listSelected :: !(Maybe Int)
|
||||
, listScroll :: !VScroll
|
||||
, listElementHeights :: M.Map Int Int
|
||||
}
|
||||
|
||||
instance HandleEvent (List e) where
|
||||
@ -32,21 +35,24 @@ instance HandleEvent (List e) where
|
||||
instance SetSize (List e) where
|
||||
setSize sz l =
|
||||
let updatedScroll = setSize sz $ listScroll l
|
||||
Just scrollTo = listSelected l <|> Just 0
|
||||
in l { listScroll = vScrollToView scrollTo updatedScroll
|
||||
}
|
||||
in ensureSelectedVisible $ l { listScroll = updatedScroll }
|
||||
|
||||
list :: (Bool -> e -> Prim (List e)) -> [e] -> List e
|
||||
list draw es =
|
||||
let selIndex = if null es then Nothing else Just 0
|
||||
in List es draw selIndex (VScroll 0 0)
|
||||
in List es draw selIndex (VScroll 0 0) M.empty
|
||||
|
||||
listSetElementSize :: Int -> DisplayRegion -> List e -> List e
|
||||
listSetElementSize i sz l =
|
||||
l { listElementHeights = M.insert i (snd sz) (listElementHeights l)
|
||||
}
|
||||
|
||||
drawList :: List e -> Prim (List e)
|
||||
drawList l =
|
||||
let es = listElements l
|
||||
drawn = for (zip [0..] es) $ \(i, e) ->
|
||||
let isSelected = Just i == listSelected l
|
||||
in (listElementDraw l isSelected e, High)
|
||||
in (SetSize (listSetElementSize i) $ listElementDraw l isSelected e, High)
|
||||
in SetSize setSize $
|
||||
vScroll (listScroll l) $
|
||||
(VBox drawn <<= VPad ' ') <<+ HPad ' '
|
||||
@ -61,10 +67,9 @@ listInsert pos e l =
|
||||
then s + 1
|
||||
else s
|
||||
(front, back) = splitAt safePos es
|
||||
in l { listSelected = Just newSel
|
||||
, listElements = front ++ (e : back)
|
||||
, listScroll = vScrollToView newSel (listScroll l)
|
||||
}
|
||||
in ensureSelectedVisible $ l { listSelected = Just newSel
|
||||
, listElements = front ++ (e : back)
|
||||
}
|
||||
|
||||
moveUp :: List e -> List e
|
||||
moveUp = moveBy (-1)
|
||||
@ -75,7 +80,15 @@ moveDown = moveBy 1
|
||||
moveBy :: Int -> List e -> List e
|
||||
moveBy amt l =
|
||||
let newSel = clamp 0 (length (listElements l) - 1) <$> (amt +) <$> listSelected l
|
||||
Just scrollTo = newSel <|> Just 0
|
||||
in l { listSelected = newSel
|
||||
, listScroll = vScrollToView scrollTo (listScroll l)
|
||||
in ensureSelectedVisible $ l { listSelected = newSel }
|
||||
|
||||
ensureSelectedVisible :: List e -> List e
|
||||
ensureSelectedVisible l =
|
||||
let Just scrollTo = (listSelected l) <|> (Just 0)
|
||||
heights = listElementHeights l
|
||||
scrollTop = sum $ catMaybes $ (\k -> M.lookup k heights) <$> [0..scrollTo-1]
|
||||
scrollBottom = case M.lookup scrollTo heights of
|
||||
Nothing -> 1
|
||||
Just k -> k
|
||||
in l { listScroll = vScrollToView (scrollTop, scrollBottom) (listScroll l)
|
||||
}
|
||||
|
@ -23,15 +23,25 @@ instance SetSize VScroll where
|
||||
vScroll :: VScroll -> Prim a -> Prim a
|
||||
vScroll vs p = Translate (Location (0, -1 * vScrollTop vs)) $ VRelease p
|
||||
|
||||
vScrollToView :: Int -> VScroll -> VScroll
|
||||
vScrollToView row vs =
|
||||
vScrollToView :: (Int, Int) -> VScroll -> VScroll
|
||||
vScrollToView (reqTop, reqHeight) vs =
|
||||
vs { vScrollTop = newTop }
|
||||
where
|
||||
newTop = if row < vScrollTop vs
|
||||
then row
|
||||
else if row >= vScrollTop vs + vScrollHeight vs
|
||||
then row - vScrollHeight vs + 1
|
||||
else vScrollTop vs
|
||||
-- cases:
|
||||
-- window is bigger than visible area -> scroll to top of requested region
|
||||
-- else
|
||||
-- top is before current top -> top
|
||||
-- top is below current bottom -> scroll so that requested bottom is new bottom
|
||||
-- bottom is below current bottom -> scroll so that requested bottom is new bottom
|
||||
-- else do nothing
|
||||
curBottom = curTop + vScrollHeight vs -- XXX should be - 1 more, too?
|
||||
curTop = vScrollTop vs
|
||||
reqBottom = reqTop + reqHeight
|
||||
newTop = if reqTop < curTop
|
||||
then reqTop
|
||||
else if reqTop > curBottom || reqBottom > curBottom
|
||||
then reqBottom - vScrollHeight vs
|
||||
else curTop
|
||||
|
||||
data HScroll =
|
||||
HScroll { hScrollLeft :: !Int
|
||||
|
Loading…
Reference in New Issue
Block a user