mirror of
https://github.com/jtdaugherty/brick.git
synced 2024-10-26 17:17:43 +03:00
Mouse demo: remove dragging code, add demo buttons
This commit is contained in:
Jonathan Daugherty
parent
665e19ebfe
commit
5af29b43f8
@ -2,7 +2,7 @@
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
module Main where
|
||||
|
||||
import Lens.Micro ((^.), (&), (%~), (.~))
|
||||
import Lens.Micro ((^.), (&), (.~))
|
||||
import Lens.Micro.TH (makeLenses)
|
||||
import Control.Monad (void)
|
||||
import Data.Monoid ((<>))
|
||||
@ -13,21 +13,14 @@ import Brick.AttrMap
|
||||
import Brick.Util
|
||||
import Brick.Types (Widget)
|
||||
import qualified Brick.Main as M
|
||||
import qualified Brick.Widgets.Border as B
|
||||
import qualified Brick.Widgets.Center as C
|
||||
import qualified Brick.Widgets.Border as B
|
||||
import Brick.Widgets.Core
|
||||
|
||||
data Name = MainUI | Layer | Info deriving (Show, Ord, Eq)
|
||||
|
||||
data DragState =
|
||||
NotDragging
|
||||
| LastLocation T.Location Bool
|
||||
deriving (Show)
|
||||
data Name = Info | Button1 | Button2 | Button3 deriving (Show, Ord, Eq)
|
||||
|
||||
data St =
|
||||
St { _draggableLayerLocation :: T.Location
|
||||
, _lastDragLoc :: DragState
|
||||
, _clicked :: [T.Extent Name]
|
||||
St { _clicked :: [T.Extent Name]
|
||||
, _lastReportedClick :: Maybe (Name, T.Location)
|
||||
}
|
||||
|
||||
@ -35,81 +28,50 @@ makeLenses ''St
|
||||
|
||||
drawUi :: St -> [Widget Name]
|
||||
drawUi st =
|
||||
[ infoLayer st
|
||||
, draggableLayer st
|
||||
[ buttonLayer st
|
||||
, infoLayer st
|
||||
]
|
||||
|
||||
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)
|
||||
|
||||
infoLayer :: St -> Widget Name
|
||||
infoLayer st = T.Widget T.Fixed T.Fixed $ do
|
||||
c <- T.getContext
|
||||
let h = c^.T.availHeightL
|
||||
T.render $ translateBy (T.Location (0, h-3)) $ clickable Info $
|
||||
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 $
|
||||
withDefAttr "info" $
|
||||
dragInfo st <=>
|
||||
C.hCenter (str ("Last reported click: " <> show (st^.lastReportedClick)))
|
||||
|
||||
dragInfo :: St -> Widget Name
|
||||
dragInfo st =
|
||||
let infoStr = case st^.lastDragLoc of
|
||||
NotDragging -> str "Not dragging"
|
||||
LastLocation (T.Location (c,r)) b ->
|
||||
str $ "Dragging at column " <> show c <> ", row " <> show r <> " " <>
|
||||
if b
|
||||
then "(dragging layer)"
|
||||
else "(dragging outside of layer)"
|
||||
in C.hCenter (str $ show $ st^.clicked) <=> C.hCenter infoStr
|
||||
|
||||
draggableLayer :: St -> Widget Name
|
||||
draggableLayer st =
|
||||
let highlight = case st^.lastDragLoc of
|
||||
LastLocation _ True -> withDefAttr "dragging"
|
||||
_ -> id
|
||||
in reportExtent MainUI $
|
||||
(translateBy (st^.draggableLayerLocation) $
|
||||
reportExtent Layer $
|
||||
highlight $
|
||||
B.border $ str $ "This layer can be dragged by\n" <>
|
||||
"clicking and dragging anywhere\n" <>
|
||||
"on or within its border.") <+> fill ' '
|
||||
C.hCenter (str ("Last reported click: " <> msg))
|
||||
|
||||
appEvent :: St -> T.BrickEvent Name e -> T.EventM Name (T.Next St)
|
||||
appEvent st (T.Clicked n _ _ loc) = M.continue $ st & lastReportedClick .~ Just (n, loc)
|
||||
appEvent st (T.VtyEvent (V.EvKey V.KEsc [])) = M.halt st
|
||||
appEvent st (T.VtyEvent ev) = do
|
||||
Just e <- M.lookupExtent Layer
|
||||
M.continue =<< case ev of
|
||||
-- If the mouse button was released, stop dragging.
|
||||
(V.EvMouseUp _ _ _) ->
|
||||
return $ st & lastDragLoc .~ NotDragging
|
||||
& clicked .~ []
|
||||
(V.EvMouseDown c r V.BLeft _) -> do
|
||||
let mouseLoc = T.Location (c, r)
|
||||
st' = case st^.lastDragLoc of
|
||||
NotDragging
|
||||
-- If the mouse button was down in the layer and
|
||||
-- we were not already dragging it, start dragging
|
||||
-- the layer.
|
||||
| M.clickedExtent (c, r) e -> st & lastDragLoc .~ LastLocation mouseLoc True
|
||||
-- If the mouse button was down outside the layer,
|
||||
-- start dragging outside the layer.
|
||||
| otherwise -> st & lastDragLoc .~ LastLocation mouseLoc False
|
||||
-- If the mouse button was down and we were already
|
||||
-- dragging, update the drag location. If the drag
|
||||
-- was a continuation of a layer movement, update the
|
||||
-- layer location.
|
||||
LastLocation (T.Location (lc, lr)) bound ->
|
||||
let off = T.Location (c-lc, r-lr)
|
||||
in st & lastDragLoc .~ LastLocation mouseLoc bound
|
||||
& draggableLayerLocation %~ if bound then (<> off) else id
|
||||
es <- M.findClickedExtents (c, r)
|
||||
return $ st' & clicked .~ es
|
||||
_ -> return st
|
||||
appEvent st _ = M.continue st
|
||||
|
||||
aMap :: AttrMap
|
||||
aMap = attrMap V.defAttr
|
||||
[ ("info", V.white `on` V.magenta)
|
||||
, ("dragging", V.black `on` V.yellow)
|
||||
, ("button1", V.white `on` V.cyan)
|
||||
, ("button2", V.white `on` V.green)
|
||||
, ("button3", V.white `on` V.blue)
|
||||
]
|
||||
|
||||
app :: M.App St e Name
|
||||
@ -122,4 +84,4 @@ app =
|
||||
}
|
||||
|
||||
main :: IO ()
|
||||
main = void $ M.defaultMain app $ St (T.Location (0, 0)) NotDragging [] Nothing
|
||||
main = void $ M.defaultMain app $ St [] Nothing
|
||||
|
||||
Loading…
Reference in New Issue
Block a user