diff --git a/src/Hamming/App/Events.hs b/src/Hamming/App/Events.hs index 67cfd52..9c0cd71 100644 --- a/src/Hamming/App/Events.hs +++ b/src/Hamming/App/Events.hs @@ -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 diff --git a/src/Hamming/App/Types.hs b/src/Hamming/App/Types.hs index 3b62dc9..525fd7f 100644 --- a/src/Hamming/App/Types.hs +++ b/src/Hamming/App/Types.hs @@ -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