implemented keyboard handler
This commit is contained in:
parent
052901ed27
commit
6a4a1fda82
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue
Block a user