add cursor location widget

This commit is contained in:
Jonathan Lamothe 2024-08-01 16:04:37 -04:00
parent 417a8691e8
commit 0c74a4ba61
7 changed files with 117 additions and 10 deletions

View File

@ -26,6 +26,7 @@ library
Hamming.App.Draw
Hamming.App.Events
Hamming.App.Types
Hamming.App.Util
Hamming.App.Widgets
Hamming.App.Widgets.Internal
other-modules:
@ -67,6 +68,7 @@ test-suite hamming-test
type: exitcode-stdio-1.0
main-is: Spec.hs
other-modules:
Hamming.App.UtilSpec
Hamming.App.Widgets.InternalSpec
Hamming.App.WidgetsSpec
Hamming.AppSpec

43
src/Hamming/App/Util.hs Normal file
View File

@ -0,0 +1,43 @@
{-|
Module : Hamming.App.Util
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/>.
**IMPORTANT NOTE:** This module is for internal use *only* and should be
considered subject to change at any time.
|-}
module Hamming.App.Util (getLocation) where
import Brick.Types (Location (..))
import Lens.Micro ((^.))
import Hamming.App.Types
-- | Gets the location of the edit cursor (if available)
getLocation :: AppState -> Maybe Location
getLocation s = case s^.appMode of
EditMode es -> Just $ Location (es^.colNum + 1, es^.rowNum + 1)
_ -> Nothing
--jl

View File

@ -36,7 +36,7 @@ module Hamming.App.Widgets (
) where
import Brick.Types (Widget)
import Brick.Widgets.Core (hBox, str, vBox, withAttr)
import Brick.Widgets.Core (hBox, showCursor, str, vBox, withAttr)
import Hamming.App.Types
import Hamming.App.Widgets.Internal
@ -45,9 +45,13 @@ import Hamming.App.Widgets.Internal
hammingW
:: AppState
-> Widget ResName
hammingW = withAttr hammingAttr
. vBox
. map (hBox . map (\(a, w) -> withAttr a $ str [w]))
. hammingW'
hammingW s = let
(wData, mLoc) = hammingW' s
widget = vBox $ map
(hBox . map (\(a, w) -> withAttr a $ str [w]))
wData
in case mLoc of
Just loc -> showCursor () loc widget
Nothing -> widget
--jl

View File

@ -44,17 +44,20 @@ import Data.Bits ((.&.))
import Lens.Micro (_2, (^.), (%~))
import Brick.AttrMap (AttrName, attrName)
import Brick.Types (Location)
import Hamming.App.Types
import Hamming.App.Util
hammingW' :: AppState -> [[(AttrName, Char)]]
hammingW' :: AppState -> ([[(AttrName, Char)]], Maybe Location)
hammingW' state = let
header = (hammingAttr, ' ') : map (marginAttr,) ['0'..'3']
body = hammingBody state
in header : zipWith
widget = header : zipWith
(\n row -> (marginAttr, n) : row)
['0'..'3']
body
in (widget, getLocation state)
hammingAttr :: AttrName
hammingAttr = attrName "hamming"

View File

@ -0,0 +1,53 @@
{-
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.UtilSpec (spec) where
import Brick.Types (Location (..))
import Lens.Micro ((&), (.~))
import Test.Hspec (Spec, context, describe, it, shouldBe)
import Hamming.App.Types
import Hamming.App.Util
spec :: Spec
spec = describe "Util"
getLocationSpec
getLocationSpec :: Spec
getLocationSpec = describe "getLocation" $ mapM_
( \(desc, state, expected) -> context desc $ let
actual = getLocation state
in it ("should be " ++ show expected) $
actual `shouldBe` expected
)
[ ( "display mode", initialState, Nothing )
, ( "edit mode", es, Just l )
]
where
es = initialState & appMode .~ EditMode
( initialEditor
& rowNum .~ 2
& colNum .~ 3
)
l = Location (4, 3)
--jl

View File

@ -37,9 +37,9 @@ hammingW'Spec :: Spec
hammingW'Spec = describe "hammingW'" $ mapM_
( \(desc, state, expRes) -> context desc $ do
let
actRes = hammingW' state
numActRows = length actRes
numExpRows = length expRes
(actRes, _) = hammingW' state
numActRows = length actRes
numExpRows = length expRes
context "number of rows" $
it ("should be " ++ show numExpRows) $
numActRows `shouldBe` numExpRows

View File

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