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-10-28 08:02:56 +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
|
|
|
|
import Brick.Types (Widget)
|
2016-07-01 05:10:44 +03:00
|
|
|
import qualified Brick.Main as M
|
|
|
|
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-10-28 08:02:56 +03:00
|
|
|
data Name = Info | Button1 | Button2 | Button3 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-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
|
|
|
|
, infoLayer st
|
2016-07-01 05:10:44 +03:00
|
|
|
]
|
|
|
|
|
2016-10-28 08:02:56 +03:00
|
|
|
buttonLayer :: St -> Widget Name
|
|
|
|
buttonLayer st =
|
|
|
|
C.centerLayer $ hBox $ padAll 1 <$> buttons
|
|
|
|
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-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-10-30 23:44:51 +03:00
|
|
|
appEvent st (T.MouseDown n _ _ loc) = M.continue $ st & lastReportedClick .~ Just (n, loc)
|
|
|
|
appEvent st (T.MouseUp _ _ _) = M.continue $ st & lastReportedClick .~ Nothing
|
|
|
|
appEvent st (T.VtyEvent (V.EvMouseUp _ _ _)) = M.continue $ st & lastReportedClick .~ Nothing
|
2016-10-26 06:19:31 +03:00
|
|
|
appEvent st (T.VtyEvent (V.EvKey V.KEsc [])) = M.halt st
|
|
|
|
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-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-07-01 05:10:44 +03:00
|
|
|
, M.appChooseCursor = M.neverShowCursor
|
|
|
|
}
|
|
|
|
|
|
|
|
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
|
|
|
|
|
|
|
|
void $ M.customMain buildVty Nothing app $ St [] Nothing
|