move cursor in edit mode

This commit is contained in:
Jonathan Lamothe 2024-08-01 19:26:22 -04:00
parent d2371e956b
commit 2a46e085d5
5 changed files with 194 additions and 2 deletions

View File

@ -23,6 +23,7 @@ library
exposed-modules:
Hamming
Hamming.App
Hamming.App.Actions
Hamming.App.Draw
Hamming.App.Events
Hamming.App.Types
@ -68,6 +69,7 @@ test-suite hamming-test
type: exitcode-stdio-1.0
main-is: Spec.hs
other-modules:
Hamming.App.ActionsSpec
Hamming.App.UtilSpec
Hamming.App.Widgets.InternalSpec
Hamming.App.WidgetsSpec

View File

@ -0,0 +1,66 @@
{-|
Module : Hamming.App.Actions
Description : Utilities for working with Hamming codes
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/>.
|-}
module Hamming.App.Actions (
moveUp,
moveDown,
moveLeft,
moveRight
) where
import Lens.Micro ((%~))
import Hamming.App.Types
moveUp :: EditState -> EditState
moveUp = rowNum %~
( \n -> if n > 0
then pred n
else 0
)
moveDown :: EditState -> EditState
moveDown = rowNum %~
( \n -> if n < 3
then succ n
else 3
)
moveLeft :: EditState -> EditState
moveLeft = colNum %~
( \n -> if n > 0
then pred n
else 0
)
moveRight :: EditState -> EditState
moveRight = colNum %~
( \n -> if n < 3
then succ n
else 3
)
--jl

View File

@ -32,11 +32,12 @@ import Brick.Main (halt)
import Brick.Types (BrickEvent (VtyEvent), gets, modify)
import Graphics.Vty.Input.Events
( Event (EvKey)
, Key (KChar, KEsc)
, Key (..)
, Modifier (MCtrl)
)
import Lens.Micro ((^.), (.~))
import Lens.Micro ((^.), (.~), (%~))
import Hamming.App.Actions
import Hamming.App.Types
-- | Handles an event
@ -55,6 +56,22 @@ displayHandler _ = return ()
editHandler :: Handler
editHandler (VtyEvent (EvKey KEsc [])) =
modify $ appMode .~ DisplayMode
editHandler (VtyEvent (EvKey KUp [])) =
modify $ appMode.editState %~ moveUp
editHandler (VtyEvent (EvKey (KChar 'k') [])) =
modify $ appMode.editState %~ moveUp
editHandler (VtyEvent (EvKey KDown [])) =
modify $ appMode.editState %~ moveDown
editHandler (VtyEvent (EvKey (KChar 'j') [])) =
modify $ appMode.editState %~ moveDown
editHandler (VtyEvent (EvKey KLeft [])) =
modify $ appMode.editState %~ moveLeft
editHandler (VtyEvent (EvKey (KChar 'h') [])) =
modify $ appMode.editState %~ moveLeft
editHandler (VtyEvent (EvKey KRight [])) =
modify $ appMode.editState %~ moveRight
editHandler (VtyEvent (EvKey (KChar 'l') [])) =
modify $ appMode.editState %~ moveRight
editHandler _ = return ()
--jl

View File

@ -0,0 +1,105 @@
{-
hamming
Copyright (C) Jonathan Lamothe <jonathan@jlamothe.net>
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/>.
-}
module Hamming.App.ActionsSpec (spec) where
import Lens.Micro ((&), (.~))
import Test.Hspec (Spec, context, describe, it, shouldBe)
import Hamming.App.Actions
import Hamming.App.Types
spec :: Spec
spec = describe "Actions" $ do
moveUpSpec
moveDownSpec
moveLeftSpec
moveRightSpec
moveUpSpec :: Spec
moveUpSpec = describe "moveUp" $ mapM_
( \(desc, state, expected) -> context desc $ let
actual = moveUp state
in it ("should be " ++ show expected) $
actual `shouldBe` expected
)
[ ( "at the top", atTop, atTop )
, ( "elsewhere", elsewhere, movedUp )
] where
atTop = initialEditor & colNum .~ 1
elsewhere = atTop & rowNum .~ 2
movedUp = atTop & rowNum .~ 1
moveDownSpec :: Spec
moveDownSpec = describe "moveDown" $ mapM_
( \(desc, state, expected) -> context desc $ let
actual = moveDown state
in it ("should be " ++ show expected) $
actual `shouldBe` expected
)
[ ( "at the bottom", atBottom, atBottom )
, ( "elsewhere", elsewhere, movedDown )
] where
atBottom = initialEditor
& colNum .~ 1
& rowNum .~ 3
elsewhere = initialEditor
& colNum .~ 1
& rowNum .~ 1
movedDown = initialEditor
& colNum .~ 1
& rowNum .~ 2
moveLeftSpec :: Spec
moveLeftSpec = describe "moveLeft" $ mapM_
( \(desc, state, expected) -> context desc $ let
actual = moveLeft state
in it ("should be " ++ show expected) $
actual `shouldBe` expected
)
[ ( "at left", atLeft, atLeft )
, ( "elsewhere", elsewhere, movedLeft )
] where
atLeft = initialEditor & rowNum .~ 1
elsewhere = atLeft & colNum .~ 2
movedLeft = atLeft & colNum .~ 1
moveRightSpec :: Spec
moveRightSpec = describe "moveRight" $ mapM_
( \(desc, state, expected) -> context desc $ let
actual = moveRight state
in it ("should be " ++ show expected) $
actual `shouldBe` expected
)
[ ( "at right", atRight, atRight )
, ( "elsewhere", elsewhere, movedRight )
] where
atRight = initialEditor
& rowNum .~ 1
& colNum .~ 3
elsewhere = initialEditor
& rowNum .~ 1
& colNum .~ 1
movedRight = initialEditor
& rowNum .~ 1
& colNum .~ 2
--jl

View File

@ -23,11 +23,13 @@ module Hamming.AppSpec (spec) where
import Test.Hspec (Spec, describe)
import qualified Hamming.App.ActionsSpec as Actions
import qualified Hamming.App.UtilSpec as Util
import qualified Hamming.App.WidgetsSpec as Widgets
spec :: Spec
spec = describe "App" $ do
Actions.spec
Util.spec
Widgets.spec