mirror of
https://github.com/jtdaugherty/brick.git
synced 2024-09-11 15:55:54 +03:00
177 lines
5.7 KiB
Haskell
177 lines
5.7 KiB
Haskell
{-# LANGUAGE CPP #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE TemplateHaskell #-}
|
|
module Main where
|
|
|
|
import Lens.Micro.TH
|
|
import Lens.Micro.Mtl
|
|
import Control.Monad (void)
|
|
#if !(MIN_VERSION_base(4,11,0))
|
|
import Data.Monoid ((<>))
|
|
#endif
|
|
import qualified Graphics.Vty as V
|
|
import Graphics.Vty.CrossPlatform (mkVty)
|
|
|
|
import qualified Brick.Types as T
|
|
import qualified Brick.Main as M
|
|
import qualified Brick.Widgets.Center as C
|
|
import qualified Brick.Widgets.Border as B
|
|
import Brick.Types
|
|
( Widget
|
|
, ViewportType(Horizontal, Both)
|
|
, VScrollBarOrientation(..)
|
|
, HScrollBarOrientation(..)
|
|
)
|
|
import Brick.Util
|
|
( fg
|
|
)
|
|
import Brick.AttrMap
|
|
( AttrMap
|
|
, attrMap
|
|
)
|
|
import Brick.Widgets.Core
|
|
( Padding(..)
|
|
, hLimit
|
|
, vLimit
|
|
, padRight
|
|
, hBox
|
|
, vBox
|
|
, viewport
|
|
, str
|
|
, fill
|
|
, withVScrollBars
|
|
, withHScrollBars
|
|
, withHScrollBarRenderer
|
|
, withVScrollBarRenderer
|
|
, withVScrollBarHandles
|
|
, withHScrollBarHandles
|
|
, withClickableHScrollBars
|
|
, withClickableVScrollBars
|
|
, VScrollbarRenderer(..)
|
|
, HScrollbarRenderer(..)
|
|
, scrollbarAttr
|
|
, scrollbarHandleAttr
|
|
)
|
|
|
|
customHScrollbars :: HScrollbarRenderer n
|
|
customHScrollbars =
|
|
HScrollbarRenderer { renderHScrollbar = vLimit 1 $ fill '^'
|
|
, renderHScrollbarTrough = vLimit 1 $ fill ' '
|
|
, renderHScrollbarHandleBefore = str "<<"
|
|
, renderHScrollbarHandleAfter = str ">>"
|
|
, scrollbarHeightAllocation = 2
|
|
}
|
|
|
|
customVScrollbars :: VScrollbarRenderer n
|
|
customVScrollbars =
|
|
VScrollbarRenderer { renderVScrollbar = C.hCenter $ hLimit 1 $ fill '*'
|
|
, renderVScrollbarTrough = fill ' '
|
|
, renderVScrollbarHandleBefore = C.hCenter $ str "-^-"
|
|
, renderVScrollbarHandleAfter = C.hCenter $ str "-v-"
|
|
, scrollbarWidthAllocation = 5
|
|
}
|
|
|
|
data Name = VP1 | VP2 | SBClick T.ClickableScrollbarElement Name
|
|
deriving (Ord, Show, Eq)
|
|
|
|
data St = St { _lastClickedElement :: Maybe (T.ClickableScrollbarElement, Name) }
|
|
|
|
makeLenses ''St
|
|
|
|
drawUi :: St -> [Widget Name]
|
|
drawUi st = [ui]
|
|
where
|
|
ui = C.center $ hLimit 80 $ vLimit 21 $
|
|
(vBox [ pair
|
|
, C.hCenter (str "Last clicked scroll bar element:")
|
|
, str $ show $ _lastClickedElement st
|
|
])
|
|
pair = hBox [ padRight (Pad 5) $
|
|
B.border $
|
|
withClickableHScrollBars SBClick $
|
|
withHScrollBars OnBottom $
|
|
withHScrollBarRenderer customHScrollbars $
|
|
withHScrollBarHandles $
|
|
viewport VP1 Horizontal $
|
|
str $ "Press left and right arrow keys to scroll this viewport.\n" <>
|
|
"This viewport uses a\n" <>
|
|
"custom scroll bar renderer!"
|
|
, B.border $
|
|
withClickableVScrollBars SBClick $
|
|
withVScrollBars OnLeft $
|
|
withVScrollBarRenderer customVScrollbars $
|
|
withVScrollBarHandles $
|
|
viewport VP2 Both $
|
|
vBox $
|
|
(str $ unlines $
|
|
[ "Press up and down arrow keys to"
|
|
, "scroll this viewport vertically."
|
|
, "This viewport uses a custom"
|
|
, "scroll bar renderer with"
|
|
, "a larger space allocation and"
|
|
, "even more fancy rendering."
|
|
])
|
|
: (str <$> [ "Line " <> show i | i <- [2..55::Int] ])
|
|
]
|
|
|
|
vp1Scroll :: M.ViewportScroll Name
|
|
vp1Scroll = M.viewportScroll VP1
|
|
|
|
vp2Scroll :: M.ViewportScroll Name
|
|
vp2Scroll = M.viewportScroll VP2
|
|
|
|
appEvent :: T.BrickEvent Name e -> T.EventM Name St ()
|
|
appEvent (T.VtyEvent (V.EvKey V.KRight [])) = M.hScrollBy vp1Scroll 1
|
|
appEvent (T.VtyEvent (V.EvKey V.KLeft [])) = M.hScrollBy vp1Scroll (-1)
|
|
appEvent (T.VtyEvent (V.EvKey V.KDown [])) = M.vScrollBy vp2Scroll 1
|
|
appEvent (T.VtyEvent (V.EvKey V.KUp [])) = M.vScrollBy vp2Scroll (-1)
|
|
appEvent (T.VtyEvent (V.EvKey V.KEsc [])) = M.halt
|
|
appEvent (T.MouseDown (SBClick el n) _ _ _) = do
|
|
lastClickedElement .= Just (el, n)
|
|
case n of
|
|
VP1 -> do
|
|
let vp = M.viewportScroll VP1
|
|
case el of
|
|
T.SBHandleBefore -> M.hScrollBy vp (-1)
|
|
T.SBHandleAfter -> M.hScrollBy vp 1
|
|
T.SBTroughBefore -> M.hScrollBy vp (-10)
|
|
T.SBTroughAfter -> M.hScrollBy vp 10
|
|
T.SBBar -> return ()
|
|
VP2 -> do
|
|
let vp = M.viewportScroll VP2
|
|
case el of
|
|
T.SBHandleBefore -> M.vScrollBy vp (-1)
|
|
T.SBHandleAfter -> M.vScrollBy vp 1
|
|
T.SBTroughBefore -> M.vScrollBy vp (-10)
|
|
T.SBTroughAfter -> M.vScrollBy vp 10
|
|
T.SBBar -> return ()
|
|
_ ->
|
|
return ()
|
|
appEvent _ = return ()
|
|
|
|
theme :: AttrMap
|
|
theme =
|
|
attrMap V.defAttr
|
|
[ (scrollbarAttr, fg V.white)
|
|
, (scrollbarHandleAttr, fg V.brightYellow)
|
|
]
|
|
|
|
app :: M.App St e Name
|
|
app =
|
|
M.App { M.appDraw = drawUi
|
|
, M.appStartEvent = return ()
|
|
, M.appHandleEvent = appEvent
|
|
, M.appAttrMap = const theme
|
|
, M.appChooseCursor = M.neverShowCursor
|
|
}
|
|
|
|
main :: IO ()
|
|
main = do
|
|
let buildVty = do
|
|
v <- mkVty V.defaultConfig
|
|
V.setMode (V.outputIface v) V.Mouse True
|
|
return v
|
|
|
|
initialVty <- buildVty
|
|
void $ M.customMain initialVty buildVty Nothing app (St Nothing)
|