Changed name from brick-spreadsheet to brick-table
Getty Ritter
7 years ago
1 | name: brick-extras-spreadsheet | |
2 | version: 0.1.0.0 | |
3 | -- synopsis: | |
4 | -- description: | |
5 | license: BSD3 | |
6 | license-file: LICENSE | |
7 | author: Getty Ritter <gdritter@galois.com> | |
8 | maintainer: Getty Ritter <gdritter@galois.com> | |
9 | copyright: ©2017 Getty Ritter | |
10 | -- category: | |
11 | build-type: Simple | |
12 | cabal-version: >= 1.14 | |
13 | ||
14 | library | |
15 | exposed-modules: Brick.Extras.Spreadsheet | |
16 | hs-source-dirs: src | |
17 | ghc-options: -Wall | |
18 | build-depends: base >=4.7 && <4.10 | |
19 | , brick | |
20 | , vty | |
21 | , array | |
22 | default-language: Haskell2010 | |
23 | default-extensions: OverloadedStrings, | |
24 | ScopedTypeVariables |
1 | name: brick-extras-table | |
2 | version: 0.1.0.0 | |
3 | -- synopsis: | |
4 | -- description: | |
5 | license: BSD3 | |
6 | license-file: LICENSE | |
7 | author: Getty Ritter <gdritter@galois.com> | |
8 | maintainer: Getty Ritter <gdritter@galois.com> | |
9 | copyright: ©2017 Getty Ritter | |
10 | -- category: | |
11 | build-type: Simple | |
12 | cabal-version: >= 1.14 | |
13 | ||
14 | library | |
15 | exposed-modules: Brick.Extras.Table | |
16 | hs-source-dirs: src | |
17 | ghc-options: -Wall | |
18 | build-depends: base >=4.7 && <4.10 | |
19 | , brick | |
20 | , vty | |
21 | , array | |
22 | default-language: Haskell2010 | |
23 | default-extensions: OverloadedStrings, | |
24 | ScopedTypeVariables |
1 | module Brick.Extras.Spreadsheet | |
2 | ( Spreadsheet(..) | |
3 | , spreadsheet | |
4 | , handleSpreadsheetEvent | |
5 | , handleSpreadsheetEventArrowKeys | |
6 | , handleSpreadsheetEventVimKeys | |
7 | , renderSpreadsheet | |
8 | , getFocusedElement | |
9 | , setFocusedElement | |
10 | , getElement | |
11 | , setElement | |
12 | ) where | |
13 | ||
14 | import qualified Brick as Brick | |
15 | import qualified Data.Array as A | |
16 | import qualified Data.Ix as Ix | |
17 | import qualified Data.List as L | |
18 | import qualified Graphics.Vty as Vty | |
19 | ||
20 | -- | Spreadsheet state. A spreadsheet is a two-dimensional array of | |
21 | -- values as well as a cursor which is focuses on one of those values. | |
22 | data Spreadsheet e n = Spreadsheet | |
23 | { spreadsheetContents :: A.Array (Int, Int) e | |
24 | -- ^ The array which represents the contents of the | |
25 | -- spreadsheet. This always begins at index @(0,0)@. | |
26 | , spreadsheetCurIndex :: (Int, Int) | |
27 | -- ^ The currently focused index | |
28 | , spreadsheetDraw :: e -> Bool -> Brick.Widget n | |
29 | -- ^ The function the spreadsheet uses to draw its contents. The | |
30 | -- boolean parameter will be 'True' if the element is the | |
31 | -- currently focused element, and 'False' otherwise. | |
32 | , spreadsheetName :: n | |
33 | -- ^ The name of the spreadsheet | |
34 | } | |
35 | ||
36 | -- | Create a new spreadsheet state with a single default value for | |
37 | -- all cells. | |
38 | spreadsheet :: n | |
39 | -- ^ The name of the spreadsheet (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 | -- spreadsheet. 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 spreadsheet | |
49 | -> Spreadsheet e n | |
50 | spreadsheet name (width, height) draw def = Spreadsheet | |
51 | { spreadsheetContents = A.listArray bounds (repeat def) | |
52 | , spreadsheetCurIndex = (0, 0) | |
53 | , spreadsheetDraw = draw | |
54 | , spreadsheetName = name | |
55 | } where bounds = ((0, 0), (width-1, height-1)) | |
56 | ||
57 | left, right, up, down :: (Int, Int) -> (Int, Int) | |
58 | left (x, y) = (x - 1, y) | |
59 | right (x, y) = (x + 1, y) | |
60 | up (x, y) = (x, y - 1) | |
61 | down (x, y) = (x, y + 1) | |
62 | ||
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 | |
69 | ||
70 | -- | A representation of UI events which can change a spreadsheet's | |
71 | -- state. | |
72 | data SpreadsheetEvent | |
73 | = MoveLeft | |
74 | | MoveRight | |
75 | | MoveUp | |
76 | | MoveDown | |
77 | deriving (Eq, Show) | |
78 | ||
79 | -- | Extract the currently-focused element from a spreadsheet. | |
80 | getFocusedElement :: Spreadsheet e n -> e | |
81 | getFocusedElement Spreadsheet | |
82 | { spreadsheetContents = cs | |
83 | , spreadsheetCurIndex = idx | |
84 | } = cs A.! idx | |
85 | ||
86 | -- | Modify the element currenly focused in the spreadsheet. | |
87 | setFocusedElement :: Spreadsheet e n -> e -> Spreadsheet e n | |
88 | setFocusedElement sp@Spreadsheet | |
89 | { spreadsheetContents = cs | |
90 | , spreadsheetCurIndex = idx | |
91 | } new = sp { spreadsheetContents = cs A.// [(idx, new)] } | |
92 | ||
93 | -- | Extract an element at an arbitrary index from the | |
94 | -- spreadsheet. This will return 'Nothing' if the index is outside the | |
95 | -- bounds of the spreadsheet. | |
96 | getElement :: Spreadsheet e n -> (Int, Int) -> Maybe e | |
97 | getElement Spreadsheet { spreadsheetContents = cs } idx | |
98 | | A.bounds cs `Ix.inRange` idx = Just (cs A.! idx) | |
99 | | otherwise = Nothing | |
100 | ||
101 | -- | Modify an element at an abitrary index in the spreadsheet. This | |
102 | -- will return the spreadsheet unchanged if the index is outside the | |
103 | -- bounds of the spreadsheet. | |
104 | setElement :: Spreadsheet e n -> (Int, Int) -> e -> Spreadsheet e n | |
105 | setElement sp@Spreadsheet { spreadsheetContents = cs } idx new | |
106 | | A.bounds cs `Ix.inRange` idx = | |
107 | sp { spreadsheetContents = cs A.// [(idx, new)] } | |
108 | | otherwise = sp | |
109 | ||
110 | -- | Handle a "vty" event by moving the currently focused item in | |
111 | -- response to the arrow keys. | |
112 | handleSpreadsheetEventArrowKeys :: Vty.Event -> Spreadsheet e n | |
113 | -> Brick.EventM n (Spreadsheet e n) | |
114 | handleSpreadsheetEventArrowKeys ev sp = case spEvent of | |
115 | Just cmd -> handleSpreadsheetEvent cmd sp | |
116 | Nothing -> return sp | |
117 | where spEvent = case ev of | |
118 | Vty.EvKey Vty.KUp [] -> Just MoveUp | |
119 | Vty.EvKey Vty.KDown [] -> Just MoveDown | |
120 | Vty.EvKey Vty.KLeft [] -> Just MoveLeft | |
121 | Vty.EvKey Vty.KRight [] -> Just MoveRight | |
122 | _ -> Nothing | |
123 | ||
124 | -- | Handle a "vty" event by moving the currently focused item in | |
125 | -- response to the vim-style movement keys @h@, @j@, @k@, or @l@. | |
126 | handleSpreadsheetEventVimKeys :: Vty.Event -> Spreadsheet e n | |
127 | -> Brick.EventM n (Spreadsheet e n) | |
128 | handleSpreadsheetEventVimKeys ev sp = case spEvent of | |
129 | Just cmd -> handleSpreadsheetEvent cmd sp | |
130 | Nothing -> return sp | |
131 | where spEvent = case ev of | |
132 | Vty.EvKey (Vty.KChar 'k') [] -> Just MoveUp | |
133 | Vty.EvKey (Vty.KChar 'j') [] -> Just MoveDown | |
134 | Vty.EvKey (Vty.KChar 'h') [] -> Just MoveLeft | |
135 | Vty.EvKey (Vty.KChar 'l') [] -> Just MoveRight | |
136 | _ -> Nothing | |
137 | ||
138 | -- | Handle a 'SpreadsheetEvent' event by modifying the state of the | |
139 | -- spreadsheet accordingly. This allows you to choose your own | |
140 | -- keybindings for events you want to handle. | |
141 | handleSpreadsheetEvent :: SpreadsheetEvent -> Spreadsheet e n | |
142 | -> Brick.EventM n (Spreadsheet e n) | |
143 | handleSpreadsheetEvent e sp = | |
144 | let (_, maxB) = A.bounds (spreadsheetContents sp) | |
145 | curIndex = spreadsheetCurIndex sp | |
146 | modify f = sp { spreadsheetCurIndex = 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 | |
152 | ||
153 | -- | Render a spreadsheet to a "brick" 'Widget'. | |
154 | renderSpreadsheet :: Bool -> Spreadsheet e n -> Brick.Widget n | |
155 | renderSpreadsheet spFocus sp = | |
156 | let (_, (maxX, maxY)) = A.bounds (spreadsheetContents sp) | |
157 | in Brick.hBox $ L.intersperse (Brick.hLimit 1 (Brick.fill '│')) | |
158 | [ Brick.vBox $ L.intersperse (Brick.vLimit 1 (Brick.fill '─')) | |
159 | [ Brick.padLeft Brick.Max $ spreadsheetDraw sp item isFocus | |
160 | | y <- [0..maxY] | |
161 | , let item = spreadsheetContents sp A.! (x, y) | |
162 | isFocus = spFocus && ((x, y) == spreadsheetCurIndex sp) | |
163 | ] | |
164 | | x <- [0..maxX] | |
165 | ] |
1 | module Brick.Extras.Table | |
2 | ( Table(..) | |
3 | , table | |
4 | , handleTableEvent | |
5 | , handleTableEventArrowKeys | |
6 | , handleTableEventVimKeys | |
7 | , renderTable | |
8 | , getFocusedElement | |
9 | , setFocusedElement | |
10 | , getElement | |
11 | , setElement | |
12 | ) where | |
13 | ||
14 | import qualified Brick as Brick | |
15 | import qualified Data.Array as A | |
16 | import qualified Data.Ix as Ix | |
17 | import qualified Data.List as L | |
18 | import qualified Graphics.Vty as Vty | |
19 | ||
20 | -- | Table state. A table is a two-dimensional array of | |
21 | -- values as well as a cursor which is focuses on one of those values. | |
22 | data Table e n = Table | |
23 | { tableContents :: A.Array (Int, Int) e | |
24 | -- ^ The array which represents the contents of the | |
25 | -- table. This always begins at index @(0,0)@. | |
26 | , tableCurIndex :: (Int, Int) | |
27 | -- ^ The currently focused index | |
28 | , tableDraw :: e -> Bool -> Brick.Widget n | |
29 | -- ^ The function the table uses to draw its contents. The | |
30 | -- boolean parameter will be 'True' if the element is the | |
31 | -- currently focused element, and 'False' otherwise. | |
32 | , tableName :: n | |
33 | -- ^ The name of the table | |
34 | } | |
35 | ||
36 | -- | Create a new table state with a single default value for | |
37 | -- all cells. | |
38 | 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 | |
50 | table name (width, height) draw def = Table | |
51 | { tableContents = A.listArray bounds (repeat def) | |
52 | , tableCurIndex = (0, 0) | |
53 | , tableDraw = draw | |
54 | , tableName = name | |
55 | } where bounds = ((0, 0), (width-1, height-1)) | |
56 | ||
57 | left, right, up, down :: (Int, Int) -> (Int, Int) | |
58 | left (x, y) = (x - 1, y) | |
59 | right (x, y) = (x + 1, y) | |
60 | up (x, y) = (x, y - 1) | |
61 | down (x, y) = (x, y + 1) | |
62 | ||
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 | |
69 | ||
70 | -- | A representation of UI events which can change a table's | |
71 | -- state. | |
72 | data TableEvent | |
73 | = MoveLeft | |
74 | | MoveRight | |
75 | | MoveUp | |
76 | | MoveDown | |
77 | deriving (Eq, Show) | |
78 | ||
79 | -- | Extract the currently-focused element from a table. | |
80 | getFocusedElement :: Table e n -> e | |
81 | getFocusedElement Table | |
82 | { 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 | |
89 | { tableContents = cs | |
90 | , tableCurIndex = idx | |
91 | } new = sp { tableContents = cs A.// [(idx, new)] } | |
92 | ||
93 | -- | Extract an element at an arbitrary index from the | |
94 | -- table. This will return 'Nothing' if the index is outside the | |
95 | -- bounds of the table. | |
96 | getElement :: Table e n -> (Int, Int) -> Maybe e | |
97 | getElement Table { tableContents = cs } idx | |
98 | | A.bounds cs `Ix.inRange` idx = Just (cs A.! idx) | |
99 | | otherwise = Nothing | |
100 | ||
101 | -- | Modify an element at an abitrary index in the table. This | |
102 | -- will return the table unchanged if the index is outside the | |
103 | -- bounds of the table. | |
104 | setElement :: Table e n -> (Int, Int) -> e -> Table e n | |
105 | setElement sp@Table { tableContents = cs } idx new | |
106 | | A.bounds cs `Ix.inRange` idx = | |
107 | sp { tableContents = cs A.// [(idx, new)] } | |
108 | | otherwise = sp | |
109 | ||
110 | -- | Handle a "vty" event by moving the currently focused item in | |
111 | -- response to the arrow keys. | |
112 | handleTableEventArrowKeys :: Vty.Event -> Table e n | |
113 | -> Brick.EventM n (Table e n) | |
114 | handleTableEventArrowKeys ev sp = case spEvent of | |
115 | Just cmd -> handleTableEvent cmd sp | |
116 | Nothing -> return sp | |
117 | where spEvent = case ev of | |
118 | Vty.EvKey Vty.KUp [] -> Just MoveUp | |
119 | Vty.EvKey Vty.KDown [] -> Just MoveDown | |
120 | Vty.EvKey Vty.KLeft [] -> Just MoveLeft | |
121 | Vty.EvKey Vty.KRight [] -> Just MoveRight | |
122 | _ -> Nothing | |
123 | ||
124 | -- | Handle a "vty" event by moving the currently focused item in | |
125 | -- response to the vim-style movement keys @h@, @j@, @k@, or @l@. | |
126 | handleTableEventVimKeys :: Vty.Event -> Table e n | |
127 | -> Brick.EventM n (Table e n) | |
128 | handleTableEventVimKeys ev sp = case spEvent of | |
129 | Just cmd -> handleTableEvent cmd sp | |
130 | Nothing -> return sp | |
131 | where spEvent = case ev of | |
132 | Vty.EvKey (Vty.KChar 'k') [] -> Just MoveUp | |
133 | Vty.EvKey (Vty.KChar 'j') [] -> Just MoveDown | |
134 | Vty.EvKey (Vty.KChar 'h') [] -> Just MoveLeft | |
135 | Vty.EvKey (Vty.KChar 'l') [] -> Just MoveRight | |
136 | _ -> Nothing | |
137 | ||
138 | -- | Handle a 'TableEvent' event by modifying the state of the | |
139 | -- table accordingly. This allows you to choose your own | |
140 | -- keybindings for events you want to handle. | |
141 | 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 | |
152 | ||
153 | -- | Render a table to a "brick" 'Widget'. | |
154 | renderTable :: Bool -> Table e n -> Brick.Widget n | |
155 | renderTable spFocus sp = | |
156 | let (_, (maxX, maxY)) = A.bounds (tableContents sp) | |
157 | in Brick.hBox $ L.intersperse (Brick.hLimit 1 (Brick.fill '│')) | |
158 | [ Brick.vBox $ L.intersperse (Brick.vLimit 1 (Brick.fill '─')) | |
159 | [ Brick.padLeft Brick.Max $ tableDraw sp item isFocus | |
160 | | y <- [0..maxY] | |
161 | , let item = tableContents sp A.! (x, y) | |
162 | isFocus = spFocus && ((x, y) == tableCurIndex sp) | |
163 | ] | |
164 | | x <- [0..maxX] | |
165 | ] |