Add support for scrolling to windows rather than points and add support for variably-sized list prims

This commit is contained in:
Jonathan Daugherty 2015-05-19 19:28:22 -07:00
parent 0c7914175a
commit 76a7fc83c8
4 changed files with 46 additions and 21 deletions

View File

@ -33,6 +33,7 @@ library
vty >= 5.2.9,
transformers,
data-default,
containers,
lens
executable brick

View File

@ -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 =

View File

@ -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)
}

View File

@ -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