Add editor line number demo program

This commit is contained in:
Jonathan Daugherty 2022-11-25 09:57:20 -08:00
parent ba477ef1c4
commit fda7e084b2
2 changed files with 148 additions and 0 deletions

View File

@ -505,6 +505,23 @@ executable brick-edit-demo
microlens-th,
microlens-mtl
executable brick-editor-line-numbers-demo
if !flag(demos)
Buildable: False
hs-source-dirs: programs
ghc-options: -threaded -Wall -Wcompat -O2
default-language: Haskell2010
main-is: EditorLineNumbersDemo.hs
build-depends: base,
brick,
vty,
text,
vector,
mtl,
microlens >= 0.3.0.0,
microlens-th,
microlens-mtl
executable brick-border-demo
if !flag(demos)
Buildable: False

View File

@ -0,0 +1,131 @@
{-# LANGUAGE TemplateHaskell #-}
module Main where
import Control.Monad (void)
import Lens.Micro
import Lens.Micro.TH
import Lens.Micro.Mtl
import qualified Graphics.Vty as V
import qualified Brick.Main as M
import qualified Brick.Types as T
import Brick.Widgets.Core
( (<+>)
, vBox
, hLimit
, vLimit
, str
, visible
, viewport
, withDefAttr
)
import qualified Brick.Widgets.Center as C
import qualified Brick.Widgets.Edit as E
import qualified Brick.AttrMap as A
import Brick.Util (on, fg)
data Name = Edit
| EditLines
deriving (Ord, Show, Eq)
data St =
St { _edit :: E.Editor String Name
}
makeLenses ''St
drawUI :: St -> [T.Widget Name]
drawUI st = [ui]
where
e = renderWithLineNumbers (st^.edit)
ui = C.center $ hLimit 50 $ vLimit 10 e
-- | Given an editor, render the editor with line numbers to the left of
-- the editor.
--
-- This essentially exploits knowledge of how the editor is implemented:
-- we make a viewport containing line numbers that is just as high as
-- the editor, then request that the line number associated with the
-- editor's current line position be made visible, thus scrolling it
-- into view. This is slightly brittle, however, because it relies on
-- essentially keeping the line number viewport and the editor viewport
-- in the same vertical scrolling state; with direct scrolling requests
-- from EventM it is easily possible to put the two viewports into a
-- state where they do not have the same vertical scrolling offset. That
-- means that visibility requests made with 'visible' won't necessarily
-- have the same effect in each viewport in that case. So this is
-- only really usable in the case where you're sure that the editor's
-- viewport and the line number viewports will not be managed by direct
-- viewport operations in EventM. That's what I'd recommend anyway, but
-- still, this is an important caveat.
--
-- There's another important caveat here: this particular implementation
-- has @O(n)@ performance for editor height @n@ because we generate
-- the entire list of line numbers on each rendering depending on the
-- height of the editor. That means that for sufficiently large files,
-- it will get more expensive to render the line numbers. There is a way
-- around this problem, which is to take the approach that the @List@
-- implementation takes: only render a region of visible line numbers
-- around the currently-edited line that is just large enough to be
-- guaranteed to fill the viewport, then translate that so that it
-- appears at the right viewport offset, thus faking a viewport filled
-- with line numbers when in fact we'd only ever render at most @2 * K +
-- 1@ line numbers for a viewport height of @K@. That's more involved,
-- so I didn't do it here, but that would be the way to go for a Real
-- Application.
renderWithLineNumbers :: E.Editor String Name -> T.Widget Name
renderWithLineNumbers e =
lineNumbersVp <+> editorVp
where
lineNumbersVp = hLimit (maxNumWidth + 1) $ viewport EditLines T.Vertical body
editorVp = E.renderEditor (str . unlines) True e
body = withDefAttr lineNumberAttr $ vBox numWidgets
numWidgets = mkNumWidget <$> numbers
mkNumWidget i = maybeVisible i $ str $ show i
maybeVisible i
| i == curLine + 1 =
visible . withDefAttr currentLineNumberAttr
| otherwise =
id
numbers = [1..h]
contents = E.getEditContents e
h = length contents
curLine = fst $ E.getCursorPosition e
maxNumWidth = length $ show h
appEvent :: T.BrickEvent Name e -> T.EventM Name St ()
appEvent (T.VtyEvent (V.EvKey V.KEsc [])) =
M.halt
appEvent ev = do
zoom edit $ E.handleEditorEvent ev
initialState :: St
initialState =
St (E.editor Edit Nothing "")
lineNumberAttr :: A.AttrName
lineNumberAttr = A.attrName "lineNumber"
currentLineNumberAttr :: A.AttrName
currentLineNumberAttr = lineNumberAttr <> A.attrName "current"
theMap :: A.AttrMap
theMap = A.attrMap V.defAttr
[ (E.editAttr, V.white `on` V.blue)
, (E.editFocusedAttr, V.black `on` V.yellow)
, (lineNumberAttr, fg V.cyan)
, (currentLineNumberAttr, V.defAttr `V.withStyle` V.bold)
]
theApp :: M.App St e Name
theApp =
M.App { M.appDraw = drawUI
, M.appChooseCursor = const $ M.showCursorNamed Edit
, M.appHandleEvent = appEvent
, M.appStartEvent = return ()
, M.appAttrMap = const theMap
}
main :: IO ()
main = do
void $ M.defaultMain theApp initialState