2020-02-08 03:43:36 +03:00
|
|
|
{-# LANGUAGE CPP #-}
|
2016-07-01 05:10:44 +03:00
|
|
|
{-# LANGUAGE TemplateHaskell #-}
|
|
|
|
module Main where
|
|
|
|
|
2022-07-17 09:10:03 +03:00
|
|
|
import Lens.Micro ((^.))
|
2016-07-01 05:10:44 +03:00
|
|
|
import Lens.Micro.TH (makeLenses)
|
2022-07-17 09:10:03 +03:00
|
|
|
import Lens.Micro.Mtl
|
2016-07-01 05:10:44 +03:00
|
|
|
import Control.Monad (void)
|
2022-07-22 00:22:11 +03:00
|
|
|
import Control.Monad.Trans (liftIO)
|
2020-02-08 03:43:36 +03:00
|
|
|
#if !(MIN_VERSION_base(4,11,0))
|
2016-07-01 05:10:44 +03:00
|
|
|
import Data.Monoid ((<>))
|
2020-02-08 03:43:36 +03:00
|
|
|
#endif
|
2016-07-01 05:10:44 +03:00
|
|
|
import qualified Graphics.Vty as V
|
|
|
|
|
|
|
|
import qualified Brick.Types as T
|
2016-07-01 05:25:16 +03:00
|
|
|
import Brick.AttrMap
|
|
|
|
import Brick.Util
|
2016-12-04 07:39:51 +03:00
|
|
|
import Brick.Types (Widget, ViewportType(Vertical))
|
2016-07-01 05:10:44 +03:00
|
|
|
import qualified Brick.Main as M
|
2016-12-04 07:26:19 +03:00
|
|
|
import qualified Brick.Widgets.Edit as E
|
2016-07-01 05:10:44 +03:00
|
|
|
import qualified Brick.Widgets.Center as C
|
2016-10-28 08:02:56 +03:00
|
|
|
import qualified Brick.Widgets.Border as B
|
2016-07-01 05:10:44 +03:00
|
|
|
import Brick.Widgets.Core
|
|
|
|
|
2016-12-04 07:26:19 +03:00
|
|
|
data Name = Info | Button1 | Button2 | Button3 | Prose | TextBox
|
2016-11-30 10:06:44 +03:00
|
|
|
deriving (Show, Ord, Eq)
|
2016-07-01 05:10:44 +03:00
|
|
|
|
|
|
|
data St =
|
2016-10-28 08:02:56 +03:00
|
|
|
St { _clicked :: [T.Extent Name]
|
2016-10-26 08:32:36 +03:00
|
|
|
, _lastReportedClick :: Maybe (Name, T.Location)
|
2016-11-30 10:06:44 +03:00
|
|
|
, _prose :: String
|
2016-12-04 07:26:19 +03:00
|
|
|
, _edit :: E.Editor String Name
|
2016-07-01 05:10:44 +03:00
|
|
|
}
|
|
|
|
|
|
|
|
makeLenses ''St
|
|
|
|
|
2016-10-24 08:42:51 +03:00
|
|
|
drawUi :: St -> [Widget Name]
|
2016-07-01 05:10:44 +03:00
|
|
|
drawUi st =
|
2016-10-28 08:02:56 +03:00
|
|
|
[ buttonLayer st
|
2016-11-30 10:06:44 +03:00
|
|
|
, proseLayer st
|
2016-10-28 08:02:56 +03:00
|
|
|
, infoLayer st
|
2016-07-01 05:10:44 +03:00
|
|
|
]
|
|
|
|
|
2016-10-28 08:02:56 +03:00
|
|
|
buttonLayer :: St -> Widget Name
|
|
|
|
buttonLayer st =
|
2016-12-04 07:26:19 +03:00
|
|
|
C.vCenterLayer $
|
2022-07-23 02:07:00 +03:00
|
|
|
C.hCenterLayer (padBottom (Pad 1) $ str "Click a button:") <=>
|
2016-12-04 07:26:19 +03:00
|
|
|
C.hCenterLayer (hBox $ padLeftRight 1 <$> buttons) <=>
|
|
|
|
C.hCenterLayer (padTopBottom 1 $ str "Or enter text and then click in this editor:") <=>
|
2017-06-26 21:52:46 +03:00
|
|
|
C.hCenterLayer (vLimit 3 $ hLimit 50 $ E.renderEditor (str . unlines) True (st^.edit))
|
2016-10-28 08:02:56 +03:00
|
|
|
where
|
|
|
|
buttons = mkButton <$> buttonData
|
2022-08-05 04:44:57 +03:00
|
|
|
buttonData = [ (Button1, "Button 1", attrName "button1")
|
|
|
|
, (Button2, "Button 2", attrName "button2")
|
|
|
|
, (Button3, "Button 3", attrName "button3")
|
2016-10-28 08:02:56 +03:00
|
|
|
]
|
|
|
|
mkButton (name, label, attr) =
|
|
|
|
let wasClicked = (fst <$> st^.lastReportedClick) == Just name
|
|
|
|
in clickable name $
|
|
|
|
withDefAttr attr $
|
|
|
|
B.border $
|
|
|
|
padTopBottom 1 $
|
|
|
|
padLeftRight (if wasClicked then 2 else 3) $
|
|
|
|
str (if wasClicked then "<" <> label <> ">" else label)
|
|
|
|
|
2016-11-30 10:06:44 +03:00
|
|
|
proseLayer :: St -> Widget Name
|
|
|
|
proseLayer st =
|
|
|
|
B.border $
|
|
|
|
C.hCenterLayer $
|
|
|
|
vLimit 8 $
|
|
|
|
viewport Prose Vertical $
|
|
|
|
vBox $ map str $ lines (st^.prose)
|
|
|
|
|
2016-10-24 08:42:51 +03:00
|
|
|
infoLayer :: St -> Widget Name
|
|
|
|
infoLayer st = T.Widget T.Fixed T.Fixed $ do
|
|
|
|
c <- T.getContext
|
|
|
|
let h = c^.T.availHeightL
|
2016-10-28 08:02:56 +03:00
|
|
|
msg = case st^.lastReportedClick of
|
2022-05-12 18:14:27 +03:00
|
|
|
Nothing ->
|
|
|
|
"Click and hold/drag to report a mouse click"
|
|
|
|
Just (name, T.Location l) ->
|
|
|
|
"Mouse down at " <> show name <> " @ " <> show l
|
2016-10-28 08:02:56 +03:00
|
|
|
T.render $ translateBy (T.Location (0, h-1)) $ clickable Info $
|
2022-08-05 04:44:57 +03:00
|
|
|
withDefAttr (attrName "info") $
|
2022-05-12 18:14:27 +03:00
|
|
|
C.hCenter $ str msg
|
2016-07-01 05:10:44 +03:00
|
|
|
|
2022-07-17 09:10:03 +03:00
|
|
|
appEvent :: T.BrickEvent Name e -> T.EventM Name St ()
|
|
|
|
appEvent ev@(T.MouseDown n _ _ loc) = do
|
|
|
|
lastReportedClick .= Just (n, loc)
|
2022-07-27 05:49:29 +03:00
|
|
|
zoom edit $ E.handleEditorEvent ev
|
2022-07-22 00:18:49 +03:00
|
|
|
appEvent (T.MouseUp {}) =
|
|
|
|
lastReportedClick .= Nothing
|
|
|
|
appEvent (T.VtyEvent (V.EvMouseUp {})) =
|
|
|
|
lastReportedClick .= Nothing
|
|
|
|
appEvent (T.VtyEvent (V.EvKey V.KUp [V.MCtrl])) =
|
|
|
|
M.vScrollBy (M.viewportScroll Prose) (-1)
|
|
|
|
appEvent (T.VtyEvent (V.EvKey V.KDown [V.MCtrl])) =
|
|
|
|
M.vScrollBy (M.viewportScroll Prose) 1
|
|
|
|
appEvent (T.VtyEvent (V.EvKey V.KEsc [])) =
|
|
|
|
M.halt
|
|
|
|
appEvent ev =
|
2022-07-27 05:49:29 +03:00
|
|
|
zoom edit $ E.handleEditorEvent ev
|
2016-07-01 05:10:44 +03:00
|
|
|
|
2016-07-01 05:25:16 +03:00
|
|
|
aMap :: AttrMap
|
|
|
|
aMap = attrMap V.defAttr
|
2022-08-05 04:44:57 +03:00
|
|
|
[ (attrName "info", V.white `on` V.magenta)
|
|
|
|
, (attrName "button1", V.white `on` V.cyan)
|
|
|
|
, (attrName "button2", V.white `on` V.green)
|
|
|
|
, (attrName "button3", V.white `on` V.blue)
|
2016-12-04 07:26:19 +03:00
|
|
|
, (E.editFocusedAttr, V.black `on` V.yellow)
|
2016-07-01 05:25:16 +03:00
|
|
|
]
|
|
|
|
|
2016-10-26 06:19:31 +03:00
|
|
|
app :: M.App St e Name
|
2016-07-01 05:10:44 +03:00
|
|
|
app =
|
|
|
|
M.App { M.appDraw = drawUi
|
2022-07-22 00:22:11 +03:00
|
|
|
, M.appStartEvent = do
|
|
|
|
vty <- M.getVtyHandle
|
|
|
|
liftIO $ V.setMode (V.outputIface vty) V.Mouse True
|
2016-07-01 05:10:44 +03:00
|
|
|
, M.appHandleEvent = appEvent
|
2016-07-01 05:25:16 +03:00
|
|
|
, M.appAttrMap = const aMap
|
2016-12-04 07:26:19 +03:00
|
|
|
, M.appChooseCursor = M.showFirstCursor
|
2016-07-01 05:10:44 +03:00
|
|
|
}
|
|
|
|
|
|
|
|
main :: IO ()
|
2016-11-01 23:22:25 +03:00
|
|
|
main = do
|
2022-07-22 00:22:11 +03:00
|
|
|
void $ M.defaultMain app $ St [] Nothing
|
2020-02-08 03:43:36 +03:00
|
|
|
(unlines [ "Try clicking on various UI elements."
|
|
|
|
, "Observe that the click coordinates identify the"
|
|
|
|
, "underlying widget coordinates."
|
|
|
|
, ""
|
|
|
|
, "Lorem ipsum dolor sit amet,"
|
|
|
|
, "consectetur adipiscing elit,"
|
|
|
|
, "sed do eiusmod tempor incididunt ut labore"
|
|
|
|
, "et dolore magna aliqua."
|
|
|
|
, ""
|
|
|
|
, "Ut enim ad minim veniam"
|
|
|
|
, "quis nostrud exercitation ullamco laboris"
|
|
|
|
, "isi ut aliquip ex ea commodo consequat."
|
|
|
|
, ""
|
|
|
|
, "Duis aute irure dolor in reprehenderit"
|
|
|
|
, "in voluptate velit esse cillum dolore eu fugiat nulla pariatur."
|
|
|
|
, ""
|
|
|
|
, "Excepteur sint occaecat cupidatat not proident,"
|
|
|
|
, "sunt in culpa qui officia deserunt mollit"
|
|
|
|
, "anim id est laborum."
|
|
|
|
])
|
2017-06-26 21:52:46 +03:00
|
|
|
(E.editor TextBox Nothing "")
|