expose keybinding data

This commit is contained in:
Jonathan Lamothe 2024-08-13 18:00:45 -04:00
parent 289499fd0d
commit d3e3e7e4a5
2 changed files with 57 additions and 43 deletions

View File

@ -26,11 +26,17 @@ License along with this program. If not, see
{-# LANGUAGE LambdaCase, OverloadedStrings #-} {-# 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 import Brick.Keybindings
( Binding ( Binding
, KeyConfig
, KeyEventHandler
, KeyEvents , KeyEvents
, bind , bind
, ctrl , ctrl
@ -54,8 +60,51 @@ import Hamming
import Hamming.App.Actions import Hamming.App.Actions
import Hamming.App.Types import Hamming.App.Types
appEvents :: KeyEvents AppEvent -- | Handles an event
appEvents = keyEvents 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 ) [ ( "quit", QuitEvent )
, ( "edit", EditEvent ) , ( "edit", EditEvent )
, ( "display", DisplayEvent ) , ( "display", DisplayEvent )
@ -69,43 +118,8 @@ appEvents = keyEvents
, ( "reset", ResetEvent ) , ( "reset", ResetEvent )
] ]
-- | Handles an event keyBindingsFor :: AppMode -> [(AppKeyEvent, [Binding])]
eventHandler :: Handler keyBindingsFor m = coreBindings ++ case m of
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
DisplayMode -> displayBindings DisplayMode -> displayBindings
EditMode _ -> editBindings EditMode _ -> editBindings
where where

View File

@ -43,7 +43,7 @@ module Hamming.App.Types (
rowNum, rowNum,
colNum, colNum,
-- * Event Types -- * Event Types
AppEvent (..), AppKeyEvent (..),
-- * Other Types -- * Other Types
ResName, ResName,
Event, Event,
@ -81,7 +81,7 @@ data EditState = EditState
} deriving (Eq, Show) } deriving (Eq, Show)
-- | Event identifiers -- | Event identifiers
data AppEvent data AppKeyEvent
= QuitEvent = QuitEvent
| EditEvent | EditEvent
| DisplayEvent | DisplayEvent