Changed name from brick-spreadsheet to brick-table
    
    
      
        Getty Ritter
        8 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 | ] |