File: VisibilityDemo.hs

package info (click to toggle)
haskell-brick 2.1.1-2
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 1,328 kB
  • sloc: haskell: 8,492; makefile: 5
file content (135 lines) | stat: -rw-r--r-- 4,249 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE CPP #-}
module Main where

import Control.Monad (void)
import Lens.Micro
import Lens.Micro.TH
import Lens.Micro.Mtl
#if !(MIN_VERSION_base(4,11,0))
import Data.Monoid
#endif
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.AttrMap (AttrMap, AttrName, attrMap, attrName)
import Brick.Util (on)
import Brick.Types
  ( Widget
  , ViewportType(Horizontal, Vertical, Both)
  )
import Brick.Widgets.Core
  ( withAttr
  , hLimit
  , vLimit
  , hBox
  , vBox
  , viewport
  , str
  , visible
  )

data St =
    St { _vp1Index :: Int
       , _vp2Index :: Int
       , _vp3Index :: (Int, Int)
       }

makeLenses ''St

data Name = VP1
          | VP2
          | VP3
          deriving (Show, Ord, Eq)

vp1Size :: Int
vp1Size = 15

vp2Size :: Int
vp2Size = 15

vp3Size :: (Int, Int)
vp3Size = (25, 25)

selectedAttr :: AttrName
selectedAttr = attrName "selected"

drawUi :: St -> [Widget Name]
drawUi st = [ui]
    where
        ui = C.center $ hLimit 60 $ vLimit 30 $
             vBox [ B.border $ vBox [ pair, B.hBorder, singleton ]
                  , str $ "- Up/down arrow keys scroll the top-left viewport\n" <>
                          "- Left/right arrow keys scroll the top-right viewport\n" <>
                          "- Ctrl-arrow keys move the bottom viewport"
                  ]
        singleton = viewport VP3 Both $
                    vBox $ do
                         i <- [1..vp3Size^._1]
                         let row = do
                               j <- [1..vp3Size^._2]
                               let mkItem = if (i, j) == st^.vp3Index
                                            then withAttr selectedAttr . visible
                                            else id
                               return $ mkItem $ str $ "Item " <> show (i, j) <> " "
                         return $ hBox row

        pair = hBox [ vp1, B.vBorder, vp2 ]
        vp1 = viewport VP1 Vertical $
                  vBox $ do
                      i <- [1..vp1Size]
                      let mkItem = if i == st^.vp1Index
                                   then withAttr selectedAttr . visible
                                   else id
                      return $ mkItem $ str $ "Item " <> show i
        vp2 = viewport VP2 Horizontal $
                  hBox $ do
                      i <- [1..vp2Size]
                      let mkItem = if i == st^.vp2Index
                                   then withAttr selectedAttr . visible
                                   else id
                      return $ mkItem $ str $ "Item " <> show i <> " "

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 :: T.BrickEvent Name e -> T.EventM Name St ()
appEvent (T.VtyEvent (V.EvKey V.KDown  [V.MCtrl])) = vp3Index._1 %= min (vp3Size^._1) . (+ 1)
appEvent (T.VtyEvent (V.EvKey V.KUp    [V.MCtrl])) = vp3Index._1 %= max 1 . subtract 1
appEvent (T.VtyEvent (V.EvKey V.KRight [V.MCtrl])) = vp3Index._2 %= min (vp3Size^._1) . (+ 1)
appEvent (T.VtyEvent (V.EvKey V.KLeft  [V.MCtrl])) = vp3Index._2 %= max 1 .  subtract 1
appEvent (T.VtyEvent (V.EvKey V.KDown []))         = vp1Index %= min vp1Size . (+ 1)
appEvent (T.VtyEvent (V.EvKey V.KUp []))           = vp1Index %= max 1 . subtract 1
appEvent (T.VtyEvent (V.EvKey V.KRight []))        = vp2Index %= min vp2Size . (+ 1)
appEvent (T.VtyEvent (V.EvKey V.KLeft []))         = vp2Index %= max 1 . subtract 1
appEvent (T.VtyEvent (V.EvKey V.KEsc [])) = M.halt
appEvent _ = return ()

theMap :: AttrMap
theMap = attrMap V.defAttr
    [ (selectedAttr, V.black `on` V.yellow)
    ]

app :: M.App St e Name
app =
    M.App { M.appDraw = drawUi
          , M.appStartEvent = return ()
          , M.appHandleEvent = appEvent
          , M.appAttrMap = const theMap
          , M.appChooseCursor = M.neverShowCursor
          }

initialState :: St
initialState = St 1 1 (1, 1)

main :: IO ()
main = void $ M.defaultMain app initialState