From 6426057571ef9d2ccec1bf6c9744aa77d22e4529 Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Tue, 13 Aug 2024 13:52:55 -0400 Subject: [PATCH] use keybindings funcitonality --- src/Hamming/App/Events.hs | 166 ++++++++++++++++++++++++++++---------- src/Hamming/App/Types.hs | 17 ++++ 2 files changed, 139 insertions(+), 44 deletions(-) diff --git a/src/Hamming/App/Events.hs b/src/Hamming/App/Events.hs index 0f0b735..c896e4d 100644 --- a/src/Hamming/App/Events.hs +++ b/src/Hamming/App/Events.hs @@ -24,17 +24,28 @@ License along with this program. If not, see |-} -{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE LambdaCase, OverloadedStrings #-} module Hamming.App.Events (eventHandler) where -import Brick.Main (halt) -import Brick.Types (BrickEvent (VtyEvent), gets, modify) -import Control.Monad.State.Class (put) +import Brick (BrickEvent (..), halt, ) +import Brick.Keybindings + ( Binding + , KeyEvents + , bind + , ctrl + , handleKey + , keyDispatcher + , keyEvents + , newKeyConfig + , onEvent + ) +import Control.Monad (void) +import Control.Monad.State.Class (get, gets, modify, put) +import Data.Either (fromRight) import Graphics.Vty.Input.Events ( Event (EvKey) , Key (..) - , Modifier (MCtrl) ) import Lens.Micro ((^.)) import Lens.Micro.Mtl (zoom, (.=), (%=)) @@ -43,48 +54,115 @@ import Hamming import Hamming.App.Actions import Hamming.App.Types +appEvents :: KeyEvents AppEvent +appEvents = keyEvents + [ ( "quit", QuitEvent ) + , ( "edit", EditEvent ) + , ( "display", DisplayEvent ) + , ( "up", UpEvent ) + , ( "down", DownEvent ) + , ( "left", LeftEvent ) + , ( "right", RightEvent ) + , ( "flip_bit", FlipBitEvent ) + , ( "chk_bits", CheckBitsEvent ) + , ( "fix_code", FixCodeEvent ) + , ( "reset", ResetEvent ) + ] + -- | Handles an event eventHandler :: Handler -eventHandler (VtyEvent (EvKey (KChar 'c') [MCtrl])) = halt -eventHandler (VtyEvent (EvKey (KChar 'q') [])) = halt -eventHandler (VtyEvent (EvKey (KChar 'c') [])) = - hammingCode %= setCheckBits -eventHandler (VtyEvent (EvKey (KChar 'v') [])) = - zoom hammingCode $ gets correctErrors >>= \case - Just c -> put c - Nothing -> return () -eventHandler (VtyEvent (EvKey (KChar 'r') [])) = - hammingCode .= 0 -eventHandler e = gets (^.appMode) >>= \case - DisplayMode -> displayHandler e - EditMode _ -> editHandler e +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 () -displayHandler :: Handler -displayHandler (VtyEvent (EvKey (KChar 'e') [])) = - appMode .= EditMode initialEditor -displayHandler _ = return () +bindingsFor :: AppMode -> [(AppEvent, [Binding])] +bindingsFor m = coreBindings ++ case m of + DisplayMode -> displayBindings + EditMode _ -> editBindings + where + coreBindings = + [ ( QuitEvent + , [ ctrl 'c' + , bind 'q' + ] + ) + , ( CheckBitsEvent + , [bind 'c'] + ) + , ( FixCodeEvent + , [bind 'v'] + ) + , ( ResetEvent + , [bind 'r'] + ) + ] -editHandler :: Handler -editHandler (VtyEvent (EvKey KEsc [])) = - appMode .= DisplayMode -editHandler (VtyEvent (EvKey KUp [])) = - appMode.editState %= moveUp -editHandler (VtyEvent (EvKey (KChar 'k') [])) = - appMode.editState %= moveUp -editHandler (VtyEvent (EvKey KDown [])) = - appMode.editState %= moveDown -editHandler (VtyEvent (EvKey (KChar 'j') [])) = - appMode.editState %= moveDown -editHandler (VtyEvent (EvKey KLeft [])) = - appMode.editState %= moveLeft -editHandler (VtyEvent (EvKey (KChar 'h') [])) = - appMode.editState %= moveLeft -editHandler (VtyEvent (EvKey KRight [])) = - appMode.editState %= moveRight -editHandler (VtyEvent (EvKey (KChar 'l') [])) = - appMode.editState %= moveRight -editHandler (VtyEvent (EvKey (KChar 'f') [])) = - modify flipBit -editHandler _ = return () + displayBindings = + [ ( EditEvent + , [bind 'e'] + ) + ] + + editBindings = + [ ( DisplayEvent + , [bind KEsc] + ) + , ( UpEvent + , [ bind KUp + , ctrl 'p' + , bind 'k' + ] + ) + , ( DownEvent + , [ bind KDown + , ctrl 'n' + , bind 'j' + ] + ) + , ( LeftEvent + , [ bind KLeft + , ctrl 'p' + , bind 'h' + ] + ) + , ( RightEvent + , [ bind KRight + , ctrl 'f' + , bind 'l' + ] + ) + , ( FlipBitEvent + , [bind 'f'] + ) + ] --jl diff --git a/src/Hamming/App/Types.hs b/src/Hamming/App/Types.hs index e26ac98..3b62dc9 100644 --- a/src/Hamming/App/Types.hs +++ b/src/Hamming/App/Types.hs @@ -42,6 +42,8 @@ module Hamming.App.Types ( -- *** Lenses rowNum, colNum, + -- * Event Types + AppEvent (..), -- * Other Types ResName, Event, @@ -78,6 +80,21 @@ data EditState = EditState -- ^ The selected column } deriving (Eq, Show) +-- | Event identifiers +data AppEvent + = QuitEvent + | EditEvent + | DisplayEvent + | UpEvent + | DownEvent + | LeftEvent + | RightEvent + | FlipBitEvent + | CheckBitsEvent + | FixCodeEvent + | ResetEvent + deriving (Eq, Ord, Show) + -- | Identifies a resource type ResName = ()