implemented keyboard handler

This commit is contained in:
Jonathan Lamothe 2024-08-22 15:09:42 -04:00
parent 052901ed27
commit 6a4a1fda82
5 changed files with 93 additions and 3 deletions

View File

@ -21,6 +21,7 @@ library
exposed-modules:
Abacus
Abacus.App
Abacus.App.Events
Abacus.App.Types
Abacus.App.Widgets
Abacus.App.Widgets.Internal
@ -36,6 +37,7 @@ library
base >=4.7 && <5
, brick >=2.1.1 && <2.2
, microlens-platform >=0.4.3.5 && <0.5
, vty ==6.1.*
default-language: Haskell2010
executable abacus
@ -52,6 +54,7 @@ executable abacus
, base >=4.7 && <5
, brick >=2.1.1 && <2.2
, microlens-platform >=0.4.3.5 && <0.5
, vty ==6.1.*
default-language: Haskell2010
test-suite abacus-test
@ -74,4 +77,5 @@ test-suite abacus-test
, brick >=2.1.1 && <2.2
, hspec >=2.11.9 && <2.12
, microlens-platform >=0.4.3.5 && <0.5
, vty ==6.1.*
default-language: Haskell2010

View File

@ -22,6 +22,7 @@ dependencies:
- base >= 4.7 && < 5
- brick >= 2.1.1 && < 2.2
- microlens-platform >= 0.4.3.5 && < 0.5
- vty >= 6.1 && < 6.2
ghc-options:
- -Wall

View File

@ -28,16 +28,19 @@ module Abacus.App (mainApp) where
import Brick
( App (..)
, BrickEvent
, BrickEvent (VtyEvent)
, EventM
, Widget
, attrMap
, halt
, neverShowCursor
, style
)
import Brick.Keybindings (handleKey)
import Brick.Widgets.Center (center)
import Control.Monad (void)
import Graphics.Vty.Input.Events (Event (EvKey))
import Abacus.App.Events
import Abacus.App.Types
import Abacus.App.Widgets
@ -55,6 +58,8 @@ drawFunc :: AppState -> [Widget ()]
drawFunc s = [center $ abacusW s]
eventHandler :: BrickEvent () () -> EventM () AppState ()
eventHandler = const halt
eventHandler (VtyEvent (EvKey k m)) =
void $ handleKey appKeyDispatcher k m
eventHandler _ = return ()
--jl

76
src/Abacus/App/Events.hs Normal file
View File

@ -0,0 +1,76 @@
{-|
Module : Abacus.App.Events
Description : Application event handling
Copyright : (C) Jonathan Lamothe
License : AGPL-3.0-or-later
Maintainer : jonathan@jlamothe.net
Stability : experimental
Portability : POSIX
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Affero General Public License as
published by the Free Software Foundation, either version 3 of the
License, or (at your option) any later version.
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Affero General Public License for more details.
You should have received a copy of the GNU Affero General Public
License along with this program. If not, see
<https://www.gnu.org/licenses/>.
-}
{-# LANGUAGE OverloadedStrings #-}
module Abacus.App.Events (appKeyDispatcher) where
import Brick (EventM, halt)
import Brick.Keybindings
( Binding
, KeyConfig
, KeyDispatcher
, KeyEventHandler
, KeyEvents
, bind
, ctrl
, keyDispatcher
, keyEvents
, newKeyConfig
, onEvent
)
import Data.Either (fromRight)
import Abacus.App.Types
-- | Application keyboard configuration
appKeyDispatcher :: KeyDispatcher KeyEventID (EventM () AppState)
appKeyDispatcher = fromRight (error "can't build key dispatcher") $
keyDispatcher keyConfig eventBindings
-- | The key configuration
keyConfig :: KeyConfig KeyEventID
keyConfig = newKeyConfig appKeyEvents keyBindings []
-- | Binds a "KeyEventID" to its associated action
eventBindings :: [KeyEventHandler KeyEventID (EventM () AppState)]
eventBindings = [onEvent QuitE "Quits the program" halt]
-- | Names the individual key events
appKeyEvents :: KeyEvents KeyEventID
appKeyEvents = keyEvents [( "quit", QuitE )]
-- | Key bindings
keyBindings :: [(KeyEventID, [Binding])]
keyBindings =
[ ( QuitE
, [ ctrl 'c'
, bind 'q'
]
)
]
--jl

View File

@ -28,6 +28,7 @@ License along with this program. If not, see
module Abacus.App.Types (
AppState (..),
KeyEventID (..),
-- * Lenses
abacus,
rungNum,
@ -48,6 +49,9 @@ data AppState = AppState
-- ^ The selected rung number
} deriving (Eq, Show)
-- | Identifiers for various key events
data KeyEventID = QuitE deriving (Eq, Ord, Show)
makeLenses ''AppState
-- | Initial application state