module Graphics.Vty.Widgets.List
( List
, SimpleList
, ListItem
, mkList
, mkSimpleList
, scrollBy
, scrollUp
, scrollDown
, pageUp
, pageDown
, resize
, listItems
, getSelected
, selectedIndex
, scrollTopIndex
, scrollWindowSize
, getVisibleItems
)
where
import Graphics.Vty ( Attr, vert_cat )
import Graphics.Vty.Widgets.Base
( Widget(..)
, Text
, text
, anyWidget
, hFill
)
type ListItem a b = (a, b)
data List a b = List { normalAttr :: Attr
, selectedAttr :: Attr
, selectedIndex :: Int
, scrollTopIndex :: Int
, scrollWindowSize :: Int
, listItems :: [ListItem a b]
}
type SimpleList = List String Text
mkList :: (Widget b) =>
Attr
-> Attr
-> Int
-> [ListItem a b]
-> List a b
mkList _ _ _ [] = error "Lists cannot be empty"
mkList normAttr selAttr swSize contents
| swSize <= 0 = error "Scrolling window size must be > 0"
| otherwise = List normAttr selAttr 0 0 swSize contents
mkSimpleList :: Attr
-> Attr
-> Int
-> [String]
-> SimpleList
mkSimpleList normAttr selAttr swSize labels =
mkList normAttr selAttr swSize widgets
where
widgets = map (\l -> (l, text normAttr l)) labels
getSelected :: List a b -> ListItem a b
getSelected list = (listItems list) !! (selectedIndex list)
resize :: Int -> List a b -> List a b
resize newSize list
| newSize == 0 = error "Cannot resize list window to zero"
| newSize == scrollWindowSize list = list
| newSize > scrollWindowSize list = list { scrollWindowSize = newSize }
| otherwise = list { scrollWindowSize = newSize
, selectedIndex = newSelected
}
where
newBottomPosition = scrollTopIndex list + newSize 1
current = selectedIndex list
newSelected = if current > newBottomPosition
then newBottomPosition
else current
scrollBy :: Int -> List a b -> List a b
scrollBy amount list =
list { scrollTopIndex = adjustedTop
, selectedIndex = newSelected }
where
sel = selectedIndex list
lastPos = (length $ listItems list) 1
validPositions = [0..lastPos]
newPosition = sel + amount
newSelected = if newPosition `elem` validPositions
then newPosition
else if newPosition > lastPos
then lastPos
else 0
bottomPosition = scrollTopIndex list + scrollWindowSize list 1
topPosition = scrollTopIndex list
windowPositions = [topPosition..bottomPosition]
adjustedTop = if newPosition `elem` windowPositions
then topPosition
else if newSelected >= bottomPosition
then newSelected scrollWindowSize list + 1
else newSelected
scrollDown :: List a b -> List a b
scrollDown = scrollBy 1
scrollUp :: List a b -> List a b
scrollUp = scrollBy (1)
pageDown :: List a b -> List a b
pageDown list = scrollBy (scrollWindowSize list) list
pageUp :: List a b -> List a b
pageUp list = scrollBy (1 * scrollWindowSize list) list
getVisibleItems :: List a b -> [(ListItem a b, Bool)]
getVisibleItems list =
let start = scrollTopIndex list
stop = scrollTopIndex list + scrollWindowSize list
adjustedStop = (min stop $ length $ listItems list) 1
in [ (listItems list !! i, i == selectedIndex list)
| i <- [start..adjustedStop] ]
instance (Widget b) => Widget (List a b) where
growHorizontal _ = False
growVertical _ = False
withAttribute w att = w { normalAttr = att }
primaryAttribute = normalAttr
render s list =
vert_cat images
where
images = map (render s) (visible ++ filler)
visible = map highlight items
items = map (\((_, w), sel) -> (w, sel)) $ getVisibleItems list
filler = replicate (scrollWindowSize list length visible)
(anyWidget $ hFill (normalAttr list) ' ' 1)
highlight (w, selected) = let att = if selected
then selectedAttr
else normalAttr
in anyWidget $ withAttribute w (att list)