2020-02-08 03:43:36 +03:00
|
|
|
{-# LANGUAGE CPP #-}
|
2015-08-20 05:40:06 +03:00
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
2015-07-09 21:03:48 +03:00
|
|
|
module Main where
|
|
|
|
|
|
|
|
import Control.Monad (void)
|
2020-02-08 03:43:36 +03:00
|
|
|
#if !(MIN_VERSION_base(4,11,0))
|
2016-05-27 21:47:16 +03:00
|
|
|
import Data.Monoid ((<>))
|
2020-02-08 03:43:36 +03:00
|
|
|
#endif
|
2015-07-10 23:38:05 +03:00
|
|
|
import qualified Graphics.Vty as V
|
2015-07-09 21:03:48 +03:00
|
|
|
|
2015-07-10 23:38:05 +03:00
|
|
|
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
|
2015-08-20 05:40:06 +03:00
|
|
|
import Brick.Types
|
2015-07-10 23:38:05 +03:00
|
|
|
( Widget
|
2015-07-18 05:30:42 +03:00
|
|
|
, ViewportType(Horizontal, Vertical, Both)
|
2015-08-20 05:40:06 +03:00
|
|
|
)
|
2017-01-25 00:48:45 +03:00
|
|
|
import Brick.AttrMap
|
|
|
|
( attrMap
|
|
|
|
)
|
2015-08-20 05:40:06 +03:00
|
|
|
import Brick.Widgets.Core
|
|
|
|
( hLimit
|
2015-07-10 23:38:05 +03:00
|
|
|
, vLimit
|
|
|
|
, hBox
|
|
|
|
, vBox
|
|
|
|
, viewport
|
|
|
|
, str
|
|
|
|
)
|
2015-07-09 21:03:48 +03:00
|
|
|
|
2016-03-05 01:42:49 +03:00
|
|
|
data Name = VP1
|
|
|
|
| VP2
|
|
|
|
| VP3
|
|
|
|
deriving (Ord, Show, Eq)
|
2015-07-09 21:03:48 +03:00
|
|
|
|
2016-03-05 01:42:49 +03:00
|
|
|
drawUi :: () -> [Widget Name]
|
2015-07-09 21:03:48 +03:00
|
|
|
drawUi = const [ui]
|
|
|
|
where
|
2015-07-18 05:30:42 +03:00
|
|
|
ui = C.center $ B.border $ hLimit 60 $ vLimit 21 $
|
|
|
|
vBox [ pair, B.hBorder, singleton ]
|
2016-03-05 01:42:49 +03:00
|
|
|
singleton = viewport VP3 Both $
|
2015-08-20 05:40:06 +03:00
|
|
|
vBox $ str "Press ctrl-arrow keys to scroll this viewport horizontally and vertically."
|
2015-07-18 05:30:42 +03:00
|
|
|
: (str <$> [ "Line " <> show i | i <- [2..25::Int] ])
|
2016-03-05 01:42:49 +03:00
|
|
|
pair = hBox [ viewport VP1 Vertical $
|
2015-08-20 05:40:06 +03:00
|
|
|
vBox $ str "Press up and down arrow keys" :
|
|
|
|
str "to scroll this viewport." :
|
2015-07-18 05:30:42 +03:00
|
|
|
(str <$> [ "Line " <> (show i) | i <- [3..50::Int] ])
|
|
|
|
, B.vBorder
|
2016-03-05 01:42:49 +03:00
|
|
|
, viewport VP2 Horizontal $
|
2015-08-20 05:40:06 +03:00
|
|
|
str "Press left and right arrow keys to scroll this viewport."
|
2015-07-18 05:30:42 +03:00
|
|
|
]
|
2015-07-09 21:03:48 +03:00
|
|
|
|
2022-07-17 09:10:03 +03:00
|
|
|
vp1Scroll :: M.ViewportScroll Name s
|
2016-03-05 01:42:49 +03:00
|
|
|
vp1Scroll = M.viewportScroll VP1
|
2015-07-09 21:03:48 +03:00
|
|
|
|
2022-07-17 09:10:03 +03:00
|
|
|
vp2Scroll :: M.ViewportScroll Name s
|
2016-03-05 01:42:49 +03:00
|
|
|
vp2Scroll = M.viewportScroll VP2
|
2015-07-09 21:03:48 +03:00
|
|
|
|
2022-07-17 09:10:03 +03:00
|
|
|
vp3Scroll :: M.ViewportScroll Name s
|
2016-03-05 01:42:49 +03:00
|
|
|
vp3Scroll = M.viewportScroll VP3
|
2015-07-18 05:30:42 +03:00
|
|
|
|
2022-07-17 09:10:03 +03:00
|
|
|
appEvent :: T.BrickEvent Name e -> T.EventM Name () ()
|
|
|
|
appEvent (T.VtyEvent (V.EvKey V.KDown [V.MCtrl])) = M.vScrollBy vp3Scroll 1
|
|
|
|
appEvent (T.VtyEvent (V.EvKey V.KUp [V.MCtrl])) = M.vScrollBy vp3Scroll (-1)
|
|
|
|
appEvent (T.VtyEvent (V.EvKey V.KRight [V.MCtrl])) = M.hScrollBy vp3Scroll 1
|
|
|
|
appEvent (T.VtyEvent (V.EvKey V.KLeft [V.MCtrl])) = M.hScrollBy vp3Scroll (-1)
|
|
|
|
appEvent (T.VtyEvent (V.EvKey V.KDown [])) = M.vScrollBy vp1Scroll 1
|
|
|
|
appEvent (T.VtyEvent (V.EvKey V.KUp [])) = M.vScrollBy vp1Scroll (-1)
|
|
|
|
appEvent (T.VtyEvent (V.EvKey V.KRight [])) = M.hScrollBy vp2Scroll 1
|
|
|
|
appEvent (T.VtyEvent (V.EvKey V.KLeft [])) = M.hScrollBy vp2Scroll (-1)
|
|
|
|
appEvent (T.VtyEvent (V.EvKey V.KEsc [])) = M.halt
|
|
|
|
appEvent _ = return ()
|
2015-07-09 21:03:48 +03:00
|
|
|
|
2016-10-26 06:19:31 +03:00
|
|
|
app :: M.App () e Name
|
2015-07-09 21:03:48 +03:00
|
|
|
app =
|
2015-07-10 23:38:05 +03:00
|
|
|
M.App { M.appDraw = drawUi
|
2022-07-17 09:10:03 +03:00
|
|
|
, M.appStartEvent = return ()
|
2015-07-10 23:38:05 +03:00
|
|
|
, M.appHandleEvent = appEvent
|
2017-01-25 00:48:45 +03:00
|
|
|
, M.appAttrMap = const $ attrMap V.defAttr []
|
2015-07-10 23:38:05 +03:00
|
|
|
, M.appChooseCursor = M.neverShowCursor
|
|
|
|
}
|
2015-07-09 21:03:48 +03:00
|
|
|
|
|
|
|
main :: IO ()
|
2015-07-10 23:38:05 +03:00
|
|
|
main = void $ M.defaultMain app ()
|