diff --git a/abacus.cabal b/abacus.cabal index c832721..010172d 100644 --- a/abacus.cabal +++ b/abacus.cabal @@ -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 diff --git a/package.yaml b/package.yaml index cc8ae38..7a1b60e 100644 --- a/package.yaml +++ b/package.yaml @@ -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 diff --git a/src/Abacus/App.hs b/src/Abacus/App.hs index 9d66ff5..eb32d32 100644 --- a/src/Abacus/App.hs +++ b/src/Abacus/App.hs @@ -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 diff --git a/src/Abacus/App/Events.hs b/src/Abacus/App/Events.hs new file mode 100644 index 0000000..51778b6 --- /dev/null +++ b/src/Abacus/App/Events.hs @@ -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 +. + +-} + +{-# 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 diff --git a/src/Abacus/App/Types.hs b/src/Abacus/App/Types.hs index 52c0dfd..470bc91 100644 --- a/src/Abacus/App/Types.hs +++ b/src/Abacus/App/Types.hs @@ -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