expose keybinding data
This commit is contained in:
parent
289499fd0d
commit
d3e3e7e4a5
|
@ -26,11 +26,17 @@ License along with this program. If not, see
|
|||
|
||||
{-# LANGUAGE LambdaCase, OverloadedStrings #-}
|
||||
|
||||
module Hamming.App.Events (eventHandler) where
|
||||
module Hamming.App.Events (
|
||||
eventHandler,
|
||||
keyConfigFor,
|
||||
keyEventHandlers
|
||||
) where
|
||||
|
||||
import Brick (BrickEvent (..), halt, )
|
||||
import Brick (BrickEvent (..), EventM, halt)
|
||||
import Brick.Keybindings
|
||||
( Binding
|
||||
, KeyConfig
|
||||
, KeyEventHandler
|
||||
, KeyEvents
|
||||
, bind
|
||||
, ctrl
|
||||
|
@ -54,8 +60,51 @@ import Hamming
|
|||
import Hamming.App.Actions
|
||||
import Hamming.App.Types
|
||||
|
||||
appEvents :: KeyEvents AppEvent
|
||||
appEvents = keyEvents
|
||||
-- | Handles an event
|
||||
eventHandler :: Handler
|
||||
eventHandler (VtyEvent (EvKey k m)) = do
|
||||
config <- keyConfigFor <$> gets (^.appMode)
|
||||
let
|
||||
disp = fromRight (error "can't built dispatcher") $
|
||||
keyDispatcher config keyEventHandlers
|
||||
void $ handleKey disp k m
|
||||
eventHandler _ = return ()
|
||||
|
||||
-- | The key configuration from a given applicaiton mode
|
||||
keyConfigFor :: AppMode -> KeyConfig AppKeyEvent
|
||||
keyConfigFor m = newKeyConfig appKeyEvents (keyBindingsFor m) []
|
||||
|
||||
-- | Defines the actual key events
|
||||
keyEventHandlers :: [KeyEventHandler AppKeyEvent (EventM ResName AppState)]
|
||||
keyEventHandlers =
|
||||
[ onEvent QuitEvent "Quit Program" halt
|
||||
, onEvent EditEvent "Edit Mode" $
|
||||
appMode .= EditMode initialEditor
|
||||
, onEvent DisplayEvent "Display Mode" $
|
||||
appMode .= DisplayMode
|
||||
, onEvent UpEvent "Cursor Up" $
|
||||
appMode.editState %= moveUp
|
||||
, onEvent DownEvent "Cursor Down" $
|
||||
appMode.editState %= moveDown
|
||||
, onEvent LeftEvent "Cursor Left" $
|
||||
appMode.editState %= moveLeft
|
||||
, onEvent RightEvent "Cursor Right" $
|
||||
appMode.editState %= moveRight
|
||||
, onEvent FlipBitEvent "Flip Selected Bit" $
|
||||
modify flipBit
|
||||
, onEvent CheckBitsEvent "Set Check Bits" $
|
||||
hammingCode %= setCheckBits
|
||||
, onEvent FixCodeEvent "Attempt to Correct Errors" $
|
||||
zoom hammingCode $ get >>= \case
|
||||
Nothing -> return ()
|
||||
Just c -> put c
|
||||
. correctErrors
|
||||
, onEvent ResetEvent "Reset Code" $
|
||||
hammingCode .= 0
|
||||
]
|
||||
|
||||
appKeyEvents :: KeyEvents AppKeyEvent
|
||||
appKeyEvents = keyEvents
|
||||
[ ( "quit", QuitEvent )
|
||||
, ( "edit", EditEvent )
|
||||
, ( "display", DisplayEvent )
|
||||
|
@ -69,43 +118,8 @@ appEvents = keyEvents
|
|||
, ( "reset", ResetEvent )
|
||||
]
|
||||
|
||||
-- | Handles an event
|
||||
eventHandler :: Handler
|
||||
eventHandler (VtyEvent (EvKey k m)) = do
|
||||
bs <- bindingsFor <$> gets (^.appMode)
|
||||
let
|
||||
kConf = newKeyConfig appEvents bs []
|
||||
disp = fromRight (error "can't build dispatcher") $ keyDispatcher kConf
|
||||
[ onEvent QuitEvent "Quit Program" halt
|
||||
, onEvent EditEvent "Edit Mode" $
|
||||
appMode .= EditMode initialEditor
|
||||
, onEvent DisplayEvent "Display Mode" $
|
||||
appMode .= DisplayMode
|
||||
, onEvent UpEvent "Cursor Up" $
|
||||
appMode.editState %= moveUp
|
||||
, onEvent DownEvent "Cursor Down" $
|
||||
appMode.editState %= moveDown
|
||||
, onEvent LeftEvent "Cursor Left" $
|
||||
appMode.editState %= moveLeft
|
||||
, onEvent RightEvent "Cursor Right" $
|
||||
appMode.editState %= moveRight
|
||||
, onEvent FlipBitEvent "Flip Selected Bit" $
|
||||
modify flipBit
|
||||
, onEvent CheckBitsEvent "Set Check Bits" $
|
||||
hammingCode %= setCheckBits
|
||||
, onEvent FixCodeEvent "Attempt to Correct Errors" $
|
||||
zoom hammingCode $ get >>= \case
|
||||
Nothing -> return ()
|
||||
Just c -> put c
|
||||
. correctErrors
|
||||
, onEvent ResetEvent "Reset Code" $
|
||||
hammingCode .= 0
|
||||
]
|
||||
void $ handleKey disp k m
|
||||
eventHandler _ = return ()
|
||||
|
||||
bindingsFor :: AppMode -> [(AppEvent, [Binding])]
|
||||
bindingsFor m = coreBindings ++ case m of
|
||||
keyBindingsFor :: AppMode -> [(AppKeyEvent, [Binding])]
|
||||
keyBindingsFor m = coreBindings ++ case m of
|
||||
DisplayMode -> displayBindings
|
||||
EditMode _ -> editBindings
|
||||
where
|
||||
|
|
|
@ -43,7 +43,7 @@ module Hamming.App.Types (
|
|||
rowNum,
|
||||
colNum,
|
||||
-- * Event Types
|
||||
AppEvent (..),
|
||||
AppKeyEvent (..),
|
||||
-- * Other Types
|
||||
ResName,
|
||||
Event,
|
||||
|
@ -81,7 +81,7 @@ data EditState = EditState
|
|||
} deriving (Eq, Show)
|
||||
|
||||
-- | Event identifiers
|
||||
data AppEvent
|
||||
data AppKeyEvent
|
||||
= QuitEvent
|
||||
| EditEvent
|
||||
| DisplayEvent
|
||||
|
|
Loading…
Reference in New Issue
Block a user