mirror of
https://github.com/jtdaugherty/brick.git
synced 2024-09-11 15:55:54 +03:00
Add viewport scrolling demo
This commit is contained in:
parent
6a1f884663
commit
2e13a1cde5
12
brick.cabal
12
brick.cabal
@ -101,6 +101,18 @@ executable brick-bench
|
||||
containers,
|
||||
vector
|
||||
|
||||
executable brick-viewport-scroll-demo
|
||||
hs-source-dirs: programs
|
||||
ghc-options: -threaded -Wall -fno-warn-unused-do-bind -O3
|
||||
default-language: Haskell2010
|
||||
main-is: ViewportScrollDemo.hs
|
||||
build-depends: base,
|
||||
brick,
|
||||
vty >= 5.2.9,
|
||||
data-default,
|
||||
text,
|
||||
lens
|
||||
|
||||
executable brick-dialog-demo
|
||||
hs-source-dirs: programs
|
||||
ghc-options: -threaded -Wall -fno-warn-unused-do-bind -O3
|
||||
|
64
programs/ViewportScrollDemo.hs
Normal file
64
programs/ViewportScrollDemo.hs
Normal file
@ -0,0 +1,64 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
module Main where
|
||||
|
||||
import Control.Applicative
|
||||
import Control.Monad (void)
|
||||
import Data.Monoid
|
||||
import Data.Default
|
||||
import Graphics.Vty
|
||||
|
||||
import Brick.Types
|
||||
import Brick.Main
|
||||
import Brick.Widgets.Core
|
||||
import Brick.Widgets.Center
|
||||
import Brick.Widgets.Border
|
||||
|
||||
vp1Name :: Name
|
||||
vp1Name = "demo1"
|
||||
|
||||
vp2Name :: Name
|
||||
vp2Name = "demo2"
|
||||
|
||||
drawUi :: () -> [Widget]
|
||||
drawUi = const [ui]
|
||||
where
|
||||
ui = center $
|
||||
hLimit 60 $
|
||||
vLimit 20 $
|
||||
border $
|
||||
hBox [ viewport vp1Name Vertical $
|
||||
vBox $ "Press up and down arrow keys" :
|
||||
"to scroll this viewport." :
|
||||
(str <$> [ "Line " <> (show i) | i <- [3..50::Int] ])
|
||||
, vBorder
|
||||
, viewport vp2Name Horizontal
|
||||
"Press left and right arrow keys to scroll this viewport."
|
||||
]
|
||||
|
||||
vp1Scroll :: ViewportScroll
|
||||
vp1Scroll = viewportScroll vp1Name
|
||||
|
||||
vp2Scroll :: ViewportScroll
|
||||
vp2Scroll = viewportScroll vp2Name
|
||||
|
||||
appEvent :: () -> Event -> EventM (Next ())
|
||||
appEvent _ (EvKey KDown []) = scrollBy vp1Scroll 1 >> continue ()
|
||||
appEvent _ (EvKey KUp []) = scrollBy vp1Scroll (-1) >> continue ()
|
||||
appEvent _ (EvKey KRight []) = scrollBy vp2Scroll 1 >> continue ()
|
||||
appEvent _ (EvKey KLeft []) = scrollBy vp2Scroll (-1) >> continue ()
|
||||
appEvent _ (EvKey KEsc []) = halt ()
|
||||
appEvent _ _ = continue ()
|
||||
|
||||
app :: App () Event
|
||||
app =
|
||||
App { appDraw = drawUi
|
||||
, appStartEvent = return
|
||||
, appHandleEvent = appEvent
|
||||
, appAttrMap = const def
|
||||
, appMakeVtyEvent = id
|
||||
, appChooseCursor = neverShowCursor
|
||||
}
|
||||
|
||||
main :: IO ()
|
||||
main = void $ defaultMain app ()
|
Loading…
Reference in New Issue
Block a user