use keybindings funcitonality

This commit is contained in:
Jonathan Lamothe 2024-08-13 13:52:55 -04:00
parent 26436538c7
commit 6426057571
2 changed files with 139 additions and 44 deletions

View File

@ -24,17 +24,28 @@ License along with this program. If not, see
|-} |-}
{-# LANGUAGE LambdaCase #-} {-# LANGUAGE LambdaCase, OverloadedStrings #-}
module Hamming.App.Events (eventHandler) where module Hamming.App.Events (eventHandler) where
import Brick.Main (halt) import Brick (BrickEvent (..), halt, )
import Brick.Types (BrickEvent (VtyEvent), gets, modify) import Brick.Keybindings
import Control.Monad.State.Class (put) ( 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 import Graphics.Vty.Input.Events
( Event (EvKey) ( Event (EvKey)
, Key (..) , Key (..)
, Modifier (MCtrl)
) )
import Lens.Micro ((^.)) import Lens.Micro ((^.))
import Lens.Micro.Mtl (zoom, (.=), (%=)) import Lens.Micro.Mtl (zoom, (.=), (%=))
@ -43,48 +54,115 @@ import Hamming
import Hamming.App.Actions import Hamming.App.Actions
import Hamming.App.Types 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 -- | Handles an event
eventHandler :: Handler eventHandler :: Handler
eventHandler (VtyEvent (EvKey (KChar 'c') [MCtrl])) = halt eventHandler (VtyEvent (EvKey k m)) = do
eventHandler (VtyEvent (EvKey (KChar 'q') [])) = halt bs <- bindingsFor <$> gets (^.appMode)
eventHandler (VtyEvent (EvKey (KChar 'c') [])) = let
hammingCode %= setCheckBits kConf = newKeyConfig appEvents bs []
eventHandler (VtyEvent (EvKey (KChar 'v') [])) = disp = fromRight (error "can't build dispatcher") $ keyDispatcher kConf
zoom hammingCode $ gets correctErrors >>= \case [ onEvent QuitEvent "Quit Program" halt
Just c -> put c , onEvent EditEvent "Edit Mode" $
Nothing -> return ()
eventHandler (VtyEvent (EvKey (KChar 'r') [])) =
hammingCode .= 0
eventHandler e = gets (^.appMode) >>= \case
DisplayMode -> displayHandler e
EditMode _ -> editHandler e
displayHandler :: Handler
displayHandler (VtyEvent (EvKey (KChar 'e') [])) =
appMode .= EditMode initialEditor appMode .= EditMode initialEditor
displayHandler _ = return () , onEvent DisplayEvent "Display Mode" $
editHandler :: Handler
editHandler (VtyEvent (EvKey KEsc [])) =
appMode .= DisplayMode appMode .= DisplayMode
editHandler (VtyEvent (EvKey KUp [])) = , onEvent UpEvent "Cursor Up" $
appMode.editState %= moveUp appMode.editState %= moveUp
editHandler (VtyEvent (EvKey (KChar 'k') [])) = , onEvent DownEvent "Cursor Down" $
appMode.editState %= moveUp
editHandler (VtyEvent (EvKey KDown [])) =
appMode.editState %= moveDown appMode.editState %= moveDown
editHandler (VtyEvent (EvKey (KChar 'j') [])) = , onEvent LeftEvent "Cursor Left" $
appMode.editState %= moveDown
editHandler (VtyEvent (EvKey KLeft [])) =
appMode.editState %= moveLeft appMode.editState %= moveLeft
editHandler (VtyEvent (EvKey (KChar 'h') [])) = , onEvent RightEvent "Cursor Right" $
appMode.editState %= moveLeft
editHandler (VtyEvent (EvKey KRight [])) =
appMode.editState %= moveRight appMode.editState %= moveRight
editHandler (VtyEvent (EvKey (KChar 'l') [])) = , onEvent FlipBitEvent "Flip Selected Bit" $
appMode.editState %= moveRight
editHandler (VtyEvent (EvKey (KChar 'f') [])) =
modify flipBit modify flipBit
editHandler _ = return () , 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
EditMode _ -> editBindings
where
coreBindings =
[ ( QuitEvent
, [ ctrl 'c'
, bind 'q'
]
)
, ( CheckBitsEvent
, [bind 'c']
)
, ( FixCodeEvent
, [bind 'v']
)
, ( ResetEvent
, [bind 'r']
)
]
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 --jl

View File

@ -42,6 +42,8 @@ module Hamming.App.Types (
-- *** Lenses -- *** Lenses
rowNum, rowNum,
colNum, colNum,
-- * Event Types
AppEvent (..),
-- * Other Types -- * Other Types
ResName, ResName,
Event, Event,
@ -78,6 +80,21 @@ data EditState = EditState
-- ^ The selected column -- ^ The selected column
} deriving (Eq, Show) } 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 -- | Identifies a resource
type ResName = () type ResName = ()