2016-07-01 05:10:44 +03:00
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
{-# LANGUAGE TemplateHaskell #-}
|
|
|
|
module Main where
|
|
|
|
|
2016-10-30 23:17:08 +03:00
|
|
|
import Control.Applicative ((<$>))
|
2016-12-04 07:26:19 +03:00
|
|
|
import Lens.Micro ((^.), (&), (.~), (%~))
|
2016-07-01 05:10:44 +03:00
|
|
|
import Lens.Micro.TH (makeLenses)
|
|
|
|
import Control.Monad (void)
|
|
|
|
import Data.Monoid ((<>))
|
|
|
|
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
|
|
|
import Data.Text.Zipper (moveCursor)
|
|
|
|
import Data.Tuple (swap)
|
2016-07-01 05:10:44 +03:00
|
|
|
|
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 $
|
|
|
|
C.hCenterLayer (padBottom (T.Pad 1) $ str "Click a button:") <=>
|
|
|
|
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
|
|
|
|
buttonData = [ (Button1, "Button 1", "button1")
|
|
|
|
, (Button2, "Button 2", "button2")
|
|
|
|
, (Button3, "Button 3", "button3")
|
|
|
|
]
|
|
|
|
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 $
|
|
|
|
-- n.b. if clickable and viewport are inverted here, click event
|
|
|
|
-- coordinates will only identify the viewable range, not the actual
|
|
|
|
-- editor widget coordinates.
|
|
|
|
viewport Prose Vertical $
|
|
|
|
clickable Prose $
|
|
|
|
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
|
|
|
|
Nothing -> "nothing"
|
|
|
|
Just (name, T.Location l) -> show name <> " at " <> show l
|
|
|
|
T.render $ translateBy (T.Location (0, h-1)) $ clickable Info $
|
2016-10-26 06:44:22 +03:00
|
|
|
withDefAttr "info" $
|
2016-10-28 08:02:56 +03:00
|
|
|
C.hCenter (str ("Last reported click: " <> msg))
|
2016-07-01 05:10:44 +03:00
|
|
|
|
2016-10-26 06:19:31 +03:00
|
|
|
appEvent :: St -> T.BrickEvent Name e -> T.EventM Name (T.Next St)
|
2016-12-04 07:26:19 +03:00
|
|
|
appEvent st (T.MouseDown n _ _ loc) = do
|
|
|
|
let T.Location pos = loc
|
|
|
|
M.continue $ st & lastReportedClick .~ Just (n, loc)
|
|
|
|
& edit %~ E.applyEdit (if n == TextBox then moveCursor (swap pos) else id)
|
2016-10-30 23:44:51 +03:00
|
|
|
appEvent st (T.MouseUp _ _ _) = M.continue $ st & lastReportedClick .~ Nothing
|
|
|
|
appEvent st (T.VtyEvent (V.EvMouseUp _ _ _)) = M.continue $ st & lastReportedClick .~ Nothing
|
2016-12-04 07:26:19 +03:00
|
|
|
appEvent st (T.VtyEvent (V.EvKey V.KUp [V.MCtrl])) = M.vScrollBy (M.viewportScroll Prose) (-1) >> M.continue st
|
|
|
|
appEvent st (T.VtyEvent (V.EvKey V.KDown [V.MCtrl])) = M.vScrollBy (M.viewportScroll Prose) 1 >> M.continue st
|
2016-10-26 06:19:31 +03:00
|
|
|
appEvent st (T.VtyEvent (V.EvKey V.KEsc [])) = M.halt st
|
2016-12-04 07:26:19 +03:00
|
|
|
appEvent st (T.VtyEvent ev) = M.continue =<< T.handleEventLensed st edit E.handleEditorEvent ev
|
2016-10-26 06:19:31 +03:00
|
|
|
appEvent st _ = M.continue st
|
2016-07-01 05:10:44 +03:00
|
|
|
|
2016-07-01 05:25:16 +03:00
|
|
|
aMap :: AttrMap
|
|
|
|
aMap = attrMap V.defAttr
|
|
|
|
[ ("info", V.white `on` V.magenta)
|
2016-10-28 08:02:56 +03:00
|
|
|
, ("button1", V.white `on` V.cyan)
|
|
|
|
, ("button2", V.white `on` V.green)
|
|
|
|
, ("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
|
|
|
|
, M.appStartEvent = return
|
|
|
|
, 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
|
|
|
|
let buildVty = do
|
|
|
|
v <- V.mkVty =<< V.standardIOConfig
|
|
|
|
V.setMode (V.outputIface v) V.Mouse True
|
|
|
|
return v
|
|
|
|
|
2019-03-19 18:25:49 +03:00
|
|
|
initialVty <- buildVty
|
|
|
|
void $ M.customMain initialVty buildVty Nothing app $ St [] Nothing
|
2018-11-18 19:50:32 +03:00
|
|
|
"Try clicking on various UI elements.\n\
|
2017-12-10 03:18:35 +03:00
|
|
|
\Observe that the click coordinates identify the\n\
|
2016-11-30 10:06:44 +03:00
|
|
|
\underlying widget coordinates.\n\
|
|
|
|
\\n\
|
|
|
|
\Lorem ipsum dolor sit amet,\n\
|
|
|
|
\consectetur adipiscing elit,\n\
|
|
|
|
\sed do eiusmod tempor incididunt ut labore\n\
|
|
|
|
\et dolore magna aliqua.\n\
|
|
|
|
\ \n\
|
|
|
|
\Ut enim ad minim veniam\n\
|
|
|
|
\quis nostrud exercitation ullamco laboris\n\
|
|
|
|
\nisi ut aliquip ex ea commodo consequat.\n\
|
|
|
|
\\n\
|
|
|
|
\Duis aute irure dolor in reprehenderit\n\
|
|
|
|
\in voluptate velit esse cillum dolore eu fugiat nulla pariatur.\n\
|
|
|
|
\\n\
|
|
|
|
\Excepteur sint occaecat cupidatat not proident,\n\
|
|
|
|
\sunt in culpa qui officia deserunt mollit\n\
|
|
|
|
\anim id est laborum.\n"
|
2017-06-26 21:52:46 +03:00
|
|
|
(E.editor TextBox Nothing "")
|