Add support for easier focus management

This commit is contained in:
Jonathan Daugherty 2015-05-09 00:57:14 -07:00
parent a991cdc789
commit a699e172ba

View File

@ -2,7 +2,6 @@
module Main where
import Data.Maybe
import Data.Monoid
import Graphics.Vty
import System.Exit
@ -10,14 +9,37 @@ import Brick
data St =
St { msg :: String
, cursorName :: Name
, focus :: FocusRing
}
data FocusRing = FocusRingEmpty
| FocusRingNonemtpy [Name] Int
focusRing :: [Name] -> FocusRing
focusRing [] = FocusRingEmpty
focusRing names = FocusRingNonemtpy names 0
focusNext :: FocusRing -> FocusRing
focusNext FocusRingEmpty = FocusRingEmpty
focusNext (FocusRingNonemtpy ns i) = FocusRingNonemtpy ns i'
where
i' = (i + 1) `mod` (length ns)
focusPrev :: FocusRing -> FocusRing
focusPrev FocusRingEmpty = FocusRingEmpty
focusPrev (FocusRingNonemtpy ns i) = FocusRingNonemtpy ns i'
where
i' = (i + (length ns) - 1) `mod` (length ns)
focusGetCurrent :: FocusRing -> Maybe Name
focusGetCurrent FocusRingEmpty = Nothing
focusGetCurrent (FocusRingNonemtpy ns i) = Just $ ns !! i
drawUI :: St -> Widget
drawUI st =
hBox [ vBox [ "-- header --" `withNamedCursor` (Name "bar", Location (0, 0))
, txt $ "-- " <> msg st <> " --"
] `withAttr` (fg red)
hBox [ hLimit 25 $ vBox [ "-- header --"
, (txt (msg st)) `withNamedCursor` (Name "bar", Location (length $ msg st, 0))
] `withAttr` (fg red)
, vBorder '|'
, "stuff things" `withNamedCursor` (Name "foo", Location (0, 0))
]
@ -26,21 +48,18 @@ handleEvent :: Event -> St -> Either ExitCode St
handleEvent e st =
case e of
EvKey KEsc [] -> Left ExitSuccess
EvKey (KChar '\t') [] -> Right $ st { cursorName = case cursorName st of
Name "foo" -> Name "bar"
_ -> Name "foo"
}
EvKey (KChar '\t') [] -> Right $ st { focus = focusNext $ focus st }
EvKey (KChar c) [] -> Right $ st { msg = msg st ++ [c] }
_ -> Right st
pickCursor :: St -> [CursorLocation] -> Maybe CursorLocation
pickCursor st ls =
listToMaybe $ filter (\cl -> cursorLocationName cl == Just (cursorName st)) ls
listToMaybe $ filter (\cl -> cursorLocationName cl == (focusGetCurrent $ focus st)) ls
initialState :: St
initialState =
St { msg = ""
, cursorName = Name "foo"
, focus = focusRing [Name "foo", Name "bar"]
}
main :: IO ()