brick/programs/ViewportScrollDemo.hs
Jonathan Daugherty 3081e7367d Replace "Name" type with custom name type variable everywhere
This experimental change makes it possible to:
* Avoid runtime errors due to name typos
* Achieve compile-time guarantees about name matching and usage
* Force widget functions to be name-agnostic by being polymorphic
  in their name type
* Clean up focus handling by making it possible to pattern-match
  on cursor location names

The change also made many types more heavyweight and in some cases
this is unpleasant when we don't want to have to care about names.
But in those cases we can just use 'n' or '()' depending on how
concrete we need to be.  I'm not yet sure how this is going to play
out in practice.
2016-03-04 14:42:49 -08:00

82 lines
2.7 KiB
Haskell

{-# LANGUAGE OverloadedStrings #-}
module Main where
import Control.Applicative
import Control.Monad (void)
import Data.Monoid
import Data.Default
import qualified Graphics.Vty as V
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, Vertical, Both)
)
import Brick.Widgets.Core
( hLimit
, vLimit
, hBox
, vBox
, viewport
, str
)
data Name = VP1
| VP2
| VP3
deriving (Ord, Show, Eq)
drawUi :: () -> [Widget Name]
drawUi = const [ui]
where
ui = C.center $ B.border $ hLimit 60 $ vLimit 21 $
vBox [ pair, B.hBorder, singleton ]
singleton = viewport VP3 Both $
vBox $ str "Press ctrl-arrow keys to scroll this viewport horizontally and vertically."
: (str <$> [ "Line " <> show i | i <- [2..25::Int] ])
pair = hBox [ viewport VP1 Vertical $
vBox $ str "Press up and down arrow keys" :
str "to scroll this viewport." :
(str <$> [ "Line " <> (show i) | i <- [3..50::Int] ])
, B.vBorder
, viewport VP2 Horizontal $
str "Press left and right arrow keys to scroll this viewport."
]
vp1Scroll :: M.ViewportScroll Name
vp1Scroll = M.viewportScroll VP1
vp2Scroll :: M.ViewportScroll Name
vp2Scroll = M.viewportScroll VP2
vp3Scroll :: M.ViewportScroll Name
vp3Scroll = M.viewportScroll VP3
appEvent :: () -> V.Event -> T.EventM Name (T.Next ())
appEvent _ (V.EvKey V.KDown [V.MCtrl]) = M.vScrollBy vp3Scroll 1 >> M.continue ()
appEvent _ (V.EvKey V.KUp [V.MCtrl]) = M.vScrollBy vp3Scroll (-1) >> M.continue ()
appEvent _ (V.EvKey V.KRight [V.MCtrl]) = M.hScrollBy vp3Scroll 1 >> M.continue ()
appEvent _ (V.EvKey V.KLeft [V.MCtrl]) = M.hScrollBy vp3Scroll (-1) >> M.continue ()
appEvent _ (V.EvKey V.KDown []) = M.vScrollBy vp1Scroll 1 >> M.continue ()
appEvent _ (V.EvKey V.KUp []) = M.vScrollBy vp1Scroll (-1) >> M.continue ()
appEvent _ (V.EvKey V.KRight []) = M.hScrollBy vp2Scroll 1 >> M.continue ()
appEvent _ (V.EvKey V.KLeft []) = M.hScrollBy vp2Scroll (-1) >> M.continue ()
appEvent _ (V.EvKey V.KEsc []) = M.halt ()
appEvent _ _ = M.continue ()
app :: M.App () V.Event Name
app =
M.App { M.appDraw = drawUi
, M.appStartEvent = return
, M.appHandleEvent = appEvent
, M.appAttrMap = const def
, M.appLiftVtyEvent = id
, M.appChooseCursor = M.neverShowCursor
}
main :: IO ()
main = void $ M.defaultMain app ()