module Graphics.Vty.Widgets.List
( List
, ListItem
, mkList
, mkSimpleList
, listWidget
, scrollBy
, scrollUp
, scrollDown
, pageUp
, pageDown
, resize
, listItems
, getSelected
, selectedIndex
, scrollTopIndex
, scrollWindowSize
, getVisibleItems
)
where
import Graphics.Vty ( Attr, DisplayRegion )
import Graphics.Vty.Widgets.Rendering
( Widget(..)
, Orientation(..)
, Render
)
import Graphics.Vty.Widgets.Rendering
( renderMany
)
import Graphics.Vty.Widgets.Base
( hFill
)
import Graphics.Vty.Widgets.Text
( simpleText
)
type ListItem a = (a, Widget)
data List a = List { normalAttr :: Attr
, selectedAttr :: Attr
, selectedIndex :: Int
, scrollTopIndex :: Int
, scrollWindowSize :: Int
, listItems :: [ListItem a]
}
mkList :: Attr
-> Attr
-> Int
-> [ListItem a]
-> List a
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
listWidget :: List a -> Widget
listWidget list = Widget {
growHorizontal = False
, growVertical = False
, withAttribute = \att -> listWidget list { normalAttr = att }
, primaryAttribute = normalAttr list
, render = renderListWidget list
}
renderListWidget :: List a -> DisplayRegion -> Render
renderListWidget list s =
renderMany Vertical ws
where
ws = map (\w -> render w s) (visible ++ filler)
visible = map highlight items
items = map (\((_, w), sel) -> (w, sel)) $ getVisibleItems list
filler = replicate (scrollWindowSize list length visible)
(hFill (normalAttr list) ' ' 1)
highlight (w, selected) = let att = if selected
then selectedAttr
else normalAttr
in withAttribute w (att list)
mkSimpleList :: Attr
-> Attr
-> Int
-> [String]
-> List String
mkSimpleList normAttr selAttr swSize labels =
mkList normAttr selAttr swSize widgets
where
widgets = map (\l -> (l, simpleText normAttr l)) labels
getSelected :: List a -> ListItem a
getSelected list = (listItems list) !! (selectedIndex list)
resize :: Int -> List a -> List a
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 -> List a
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 -> List a
scrollDown = scrollBy 1
scrollUp :: List a -> List a
scrollUp = scrollBy (1)
pageDown :: List a -> List a
pageDown list = scrollBy (scrollWindowSize list) list
pageUp :: List a -> List a
pageUp list = scrollBy (1 * scrollWindowSize list) list
getVisibleItems :: List a -> [(ListItem a, 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] ]