gdritter repos brick-table / ce65282
Reworked type to include selection range rather than basic selection Getty Ritter 7 years ago
3 changed file(s) with 168 addition(s) and 48 deletion(s). Collapse all Expand all
+10
-0
brick-table.cabal less more
2222 default-language: Haskell2010
2323 default-extensions: OverloadedStrings,
2424 ScopedTypeVariables
25
26 executable example
27 hs-source-dirs: example
28 main-is: Main.hs
29 ghc-options: -Wall -threaded
30 build-depends: base >=4.7 && <4.10
31 , brick
32 , vty
33 , brick-extras-table
34 default-language: Haskell2010
+44
-0
example/Main.hs less more
1 {-# LANGUAGE OverloadedStrings #-}
2
3 module Main where
4
5 import qualified Brick
6 import Brick.Extras.Table
7 import qualified Graphics.Vty as Vty
8
9 app :: Brick.App (Table Int ()) () ()
10 app = Brick.App
11 { Brick.appDraw = \ s ->
12 [ Brick.vBox [ renderTable True s
13 , Brick.str "Keybindings:"
14 , Brick.str " move with {h,j,k,l}"
15 , Brick.str " expand with {H,J,K,L}"
16 , Brick.str " contract with M-{h,j,k,l}"
17 , Brick.str " increment the current cells with enter"
18 , Brick.str " quit with q or ESC"
19 , Brick.str ("Current selection: " ++ show (getFocused s))
20 ]]
21 , Brick.appChooseCursor = \_ _ -> Nothing
22 , Brick.appHandleEvent = \s e -> case e of
23 Brick.VtyEvent (Vty.EvKey (Vty.KEsc) []) -> Brick.halt s
24 Brick.VtyEvent (Vty.EvKey (Vty.KChar 'q') _) -> Brick.halt s
25 Brick.VtyEvent (Vty.EvKey (Vty.KEnter) []) ->
26 Brick.continue (modifyFocused s (\ _ x -> x + 1))
27 Brick.VtyEvent (ev) -> do
28 s' <- handleTableEventVimKeys ev s
29 Brick.continue s'
30 _ -> Brick.continue s
31 , Brick.appStartEvent = return
32 , Brick.appAttrMap = \ _ ->
33 Brick.attrMap mempty [("selected", Vty.withForeColor Vty.defAttr Vty.red)]
34 }
35
36 drawElem :: Int -> Bool -> Brick.Widget n
37 drawElem n True = Brick.str ("*" ++ show n ++ "*")
38 drawElem n False = Brick.str (show n)
39
40 main :: IO ()
41 main = do
42 let tb = table () (10, 10) drawElem 0
43 _ <- Brick.customMain (Vty.mkVty mempty) (Nothing) app tb
44 return ()
+114
-48
src/Brick/Extras/Table.hs less more
11 module Brick.Extras.Table
22 ( Table(..)
33 , table
4 , renderTable
5 -- * Event Handlers
6 , TableEvent(..)
47 , handleTableEvent
58 , handleTableEventArrowKeys
69 , handleTableEventVimKeys
7 , renderTable
8 , getFocusedElement
9 , setFocusedElement
10 -- * Table manipulation helpers
11 , Focus(..)
12 , getFocused
13 , modifyFocused
1014 , getElement
11 , setElement
15 , modifyElement
1216 ) where
1317
1418 import qualified Brick as Brick
2327 { tableContents :: A.Array (Int, Int) e
2428 -- ^ The array which represents the contents of the
2529 -- table. This always begins at index @(0,0)@.
26 , tableCurIndex :: (Int, Int)
30 , tableCurIndex :: ((Int, Int), (Int, Int))
2731 -- ^ The currently focused index
2832 , tableDraw :: e -> Bool -> Brick.Widget n
2933 -- ^ The function the table uses to draw its contents. The
3337 -- ^ The name of the table
3438 }
3539
40 type Idx = (Int, Int)
41 type Range = (Idx, Idx)
42
3643 -- | Create a new table state with a single default value for
3744 -- all cells.
3845 table :: n
39 -- ^ The name of the table (must be unique)
40 -> (Int, Int)
41 -- ^ The @(width, height)@ of the desired table
42 -> (e -> Bool -> Brick.Widget n)
43 -- ^ The rendering function for contents of the
44 -- table. The boolean parameter will be 'True' if
45 -- the element is the currently focused element, and
46 -- 'False' otherwise.
47 -> e
48 -- ^ The default element with which to fill the table
49 -> Table e n
46 -- ^ The name of the table (must be unique)
47 -> (Int, Int)
48 -- ^ The @(width, height)@ of the desired table
49 -> (e -> Bool -> Brick.Widget n)
50 -- ^ The rendering function for contents of the
51 -- table. The boolean parameter will be 'True' if
52 -- the element is the currently focused element, and
53 -- 'False' otherwise.
54 -> e
55 -- ^ The default element with which to fill the table
56 -> Table e n
5057 table name (width, height) draw def = Table
5158 { tableContents = A.listArray bounds (repeat def)
52 , tableCurIndex = (0, 0)
59 , tableCurIndex = ((0, 0), (0, 0))
5360 , tableDraw = draw
5461 , tableName = name
5562 } where bounds = ((0, 0), (width-1, height-1))
63
64 data Direction = L | R | U | D
5665
5766 left, right, up, down :: (Int, Int) -> (Int, Int)
5867 left (x, y) = (x - 1, y)
6069 up (x, y) = (x, y - 1)
6170 down (x, y) = (x, y + 1)
6271
63 clamp :: (Int, Int) -> (Int, Int) -> (Int, Int)
64 clamp (x, y) (maxX, maxY) = (go x maxX, go y maxY)
65 where go n maxN
66 | n < 0 = 0
67 | n > maxN = maxN
68 | otherwise = n
72 canMove :: Direction -> Idx -> Range -> Bool
73 canMove L (_, _) ((x, _), _) = x > 0
74 canMove R (m, _) (_, (x, _)) = x < m
75 canMove U (_, _) ((_, y), _) = y > 0
76 canMove D (_, m) (_, (_, y)) = y < m
77
78 onFst :: (a -> b) -> (a, c) -> (b, c)
79 onFst f (x, y) = (f x, y)
80
81 onSnd :: (a -> b) -> (c, a) -> (c, b)
82 onSnd f (x, y) = (x, f y)
83
84 onBoth :: (a -> b) -> (a, a) -> (b, b)
85 onBoth f (x, y) = (f x, f y)
6986
7087 -- | A representation of UI events which can change a table's
7188 -- state.
7491 | MoveRight
7592 | MoveUp
7693 | MoveDown
94 | ExpandLeft
95 | ExpandRight
96 | ExpandUp
97 | ExpandDown
98 | ContractLeft
99 | ContractRight
100 | ContractUp
101 | ContractDown
77102 deriving (Eq, Show)
78103
79 -- | Extract the currently-focused element from a table.
80 getFocusedElement :: Table e n -> e
81 getFocusedElement Table
104 applyEvent :: TableEvent -> Table e n -> Table e n
105 applyEvent ev tbl = case ev of
106 MoveLeft | canMove L mx idx -> go (onBoth left)
107 MoveRight | canMove R mx idx -> go (onBoth right)
108 MoveUp | canMove U mx idx -> go (onBoth up)
109 MoveDown | canMove D mx idx -> go (onBoth down)
110 ExpandLeft | canMove L mx idx -> go (onFst left)
111 ExpandRight | canMove R mx idx -> go (onSnd right)
112 ExpandUp | canMove U mx idx -> go (onFst up)
113 ExpandDown | canMove D mx idx -> go (onSnd down)
114 ContractLeft | lx < hx -> go (onSnd left)
115 ContractRight | lx < hx -> go (onFst right)
116 ContractUp | ly < hy -> go (onSnd up)
117 ContractDown | ly < hy -> go (onFst down)
118 _ -> tbl
119 where mx = snd (A.bounds (tableContents tbl))
120 idx = tableCurIndex tbl
121 go f = tbl { tableCurIndex = f idx }
122 ((lx, ly), (hx, hy)) = idx
123
124 -- | Represents the current focus: either a single element or a
125 -- contiguous rectancle of focused cells from the table.
126 data Focus e
127 = FocusElement e
128 | FocusRange (A.Array (Int, Int) e)
129 deriving (Eq, Show)
130
131 -- | Extract the currently-focused element or elements from a table.
132 getFocused :: Table e n -> Focus e
133 getFocused Table
82134 { tableContents = cs
83 , tableCurIndex = idx
84 } = cs A.! idx
85
86 -- | Modify the element currenly focused in the table.
87 setFocusedElement :: Table e n -> e -> Table e n
88 setFocusedElement sp@Table
135 , tableCurIndex = range@(lIdx, rIdx)
136 } | lIdx == rIdx = FocusElement (cs A.! lIdx)
137 | otherwise =
138 FocusRange (A.array range [ (idx, cs A.! idx)
139 | idx <- Ix.range range
140 ])
141
142 -- | Apply a function to the entire focused region. This function
143 -- is passed the index of the cell as well as current value of
144 -- the cell.
145 modifyFocused :: Table e n -> ((Int, Int) -> e -> e) -> Table e n
146 modifyFocused tbl@Table
89147 { tableContents = cs
90 , tableCurIndex = idx
91 } new = sp { tableContents = cs A.// [(idx, new)] }
148 , tableCurIndex = range
149 } func = tbl { tableContents = cs A.// [ (idx, func idx (cs A.! idx))
150 | idx <- Ix.range range
151 ]
152 }
92153
93154 -- | Extract an element at an arbitrary index from the
94155 -- table. This will return 'Nothing' if the index is outside the
101162 -- | Modify an element at an abitrary index in the table. This
102163 -- will return the table unchanged if the index is outside the
103164 -- bounds of the table.
104 setElement :: Table e n -> (Int, Int) -> e -> Table e n
105 setElement sp@Table { tableContents = cs } idx new
165 modifyElement :: Table e n -> (Int, Int) -> ((Int, Int) -> e -> e)
166 -> Table e n
167 modifyElement sp@Table { tableContents = cs } idx func
106168 | A.bounds cs `Ix.inRange` idx =
107 sp { tableContents = cs A.// [(idx, new)] }
169 sp { tableContents = cs A.// [(idx, func idx (cs A.! idx))] }
108170 | otherwise = sp
109171
110172 -- | Handle a "vty" event by moving the currently focused item in
133195 Vty.EvKey (Vty.KChar 'j') [] -> Just MoveDown
134196 Vty.EvKey (Vty.KChar 'h') [] -> Just MoveLeft
135197 Vty.EvKey (Vty.KChar 'l') [] -> Just MoveRight
198 Vty.EvKey (Vty.KChar 'k') [Vty.MShift] -> Just ExpandUp
199 Vty.EvKey (Vty.KChar 'j') [Vty.MShift] -> Just ExpandDown
200 Vty.EvKey (Vty.KChar 'h') [Vty.MShift] -> Just ExpandLeft
201 Vty.EvKey (Vty.KChar 'l') [Vty.MShift] -> Just ExpandRight
202 Vty.EvKey (Vty.KChar 'K') [] -> Just ExpandUp
203 Vty.EvKey (Vty.KChar 'J') [] -> Just ExpandDown
204 Vty.EvKey (Vty.KChar 'H') [] -> Just ExpandLeft
205 Vty.EvKey (Vty.KChar 'L') [] -> Just ExpandRight
206 Vty.EvKey (Vty.KChar 'k') [Vty.MMeta] -> Just ContractUp
207 Vty.EvKey (Vty.KChar 'j') [Vty.MMeta] -> Just ContractDown
208 Vty.EvKey (Vty.KChar 'h') [Vty.MMeta] -> Just ContractLeft
209 Vty.EvKey (Vty.KChar 'l') [Vty.MMeta] -> Just ContractRight
136210 _ -> Nothing
137211
138212 -- | Handle a 'TableEvent' event by modifying the state of the
139213 -- table accordingly. This allows you to choose your own
140214 -- keybindings for events you want to handle.
141215 handleTableEvent :: TableEvent -> Table e n
142 -> Brick.EventM n (Table e n)
143 handleTableEvent e sp =
144 let (_, maxB) = A.bounds (tableContents sp)
145 curIndex = tableCurIndex sp
146 modify f = sp { tableCurIndex = clamp (f curIndex) maxB }
147 in return $ case e of
148 MoveUp -> modify up
149 MoveDown -> modify down
150 MoveLeft -> modify left
151 MoveRight -> modify right
216 -> Brick.EventM n (Table e n)
217 handleTableEvent e sp = return (applyEvent e sp)
152218
153219 -- | Render a table to a "brick" 'Widget'.
154220 renderTable :: Bool -> Table e n -> Brick.Widget n
159225 [ Brick.padLeft Brick.Max $ tableDraw sp item isFocus
160226 | y <- [0..maxY]
161227 , let item = tableContents sp A.! (x, y)
162 isFocus = spFocus && ((x, y) == tableCurIndex sp)
228 isFocus = spFocus && (tableCurIndex sp `Ix.inRange` (x, y))
163229 ]
164230 | x <- [0..maxX]
165231 ]