implemented bit flipping

This commit is contained in:
Jonathan Lamothe 2024-08-01 20:31:25 -04:00
parent 2a46e085d5
commit 14867b54b0
5 changed files with 55 additions and 6 deletions

View File

@ -1,7 +1,7 @@
{-| {-|
Module : Hamming.App.Actions Module : Hamming.App.Actions
Description : Utilities for working with Hamming codes Description : Functions that transform the application state
Copyright : (C) Jonathan Lamothe Copyright : (C) Jonathan Lamothe
License : AGPL-3.0-or-later License : AGPL-3.0-or-later
Maintainer : jonathan@jlamothe.net Maintainer : jonathan@jlamothe.net
@ -25,15 +25,20 @@ License along with this program. If not, see
|-} |-}
module Hamming.App.Actions ( module Hamming.App.Actions (
-- * Cursor Movement
moveUp, moveUp,
moveDown, moveDown,
moveLeft, moveLeft,
moveRight moveRight,
-- * Other Edits
flipBit,
) where ) where
import Lens.Micro ((%~)) import Data.Bits (xor)
import Lens.Micro ((^.), (&), (%~))
import Hamming.App.Types import Hamming.App.Types
import Hamming.App.Util
moveUp :: EditState -> EditState moveUp :: EditState -> EditState
moveUp = rowNum %~ moveUp = rowNum %~
@ -63,4 +68,9 @@ moveRight = colNum %~
else 3 else 3
) )
flipBit :: AppState -> AppState
flipBit s = case s^.appMode of
EditMode es -> s & hammingCode %~ xor (bitmask es)
_ -> s
--jl --jl

View File

@ -1,7 +1,7 @@
{-| {-|
Module : Hamming.App.Events Module : Hamming.App.Events
Description : Utilities for working with Hamming codes Description : Main event handler functions
Copyright : (C) Jonathan Lamothe Copyright : (C) Jonathan Lamothe
License : AGPL-3.0-or-later License : AGPL-3.0-or-later
Maintainer : jonathan@jlamothe.net Maintainer : jonathan@jlamothe.net
@ -72,6 +72,8 @@ editHandler (VtyEvent (EvKey KRight [])) =
modify $ appMode.editState %~ moveRight modify $ appMode.editState %~ moveRight
editHandler (VtyEvent (EvKey (KChar 'l') [])) = editHandler (VtyEvent (EvKey (KChar 'l') [])) =
modify $ appMode.editState %~ moveRight modify $ appMode.editState %~ moveRight
editHandler (VtyEvent (EvKey (KChar 'f') [])) =
modify flipBit
editHandler _ = return () editHandler _ = return ()
--jl --jl

View File

@ -27,13 +27,19 @@ considered subject to change at any time.
|-} |-}
module Hamming.App.Util (getLocation) where module Hamming.App.Util (bitmask, getLocation) where
import Brick.Types (Location (..)) import Brick.Types (Location (..))
import Data.Bits (shiftL)
import Data.Word (Word16)
import Lens.Micro ((^.)) import Lens.Micro ((^.))
import Hamming.App.Types import Hamming.App.Types
-- | Returns the mask for the currently selected bit
bitmask :: EditState -> Word16
bitmask s = shiftL 1 $ s^.rowNum * 4 + s^.colNum
-- | Gets the location of the edit cursor (if available) -- | Gets the location of the edit cursor (if available)
getLocation :: AppState -> Maybe Location getLocation :: AppState -> Maybe Location
getLocation s = case s^.appMode of getLocation s = case s^.appMode of

View File

@ -33,6 +33,7 @@ spec = describe "Actions" $ do
moveDownSpec moveDownSpec
moveLeftSpec moveLeftSpec
moveRightSpec moveRightSpec
flipBitSpec
moveUpSpec :: Spec moveUpSpec :: Spec
moveUpSpec = describe "moveUp" $ mapM_ moveUpSpec = describe "moveUp" $ mapM_
@ -102,4 +103,23 @@ moveRightSpec = describe "moveRight" $ mapM_
& rowNum .~ 1 & rowNum .~ 1
& colNum .~ 2 & colNum .~ 2
flipBitSpec :: Spec
flipBitSpec = describe "flipBit" $ mapM_
( \(desc, state, expected) -> context desc $ let
actual = flipBit state
in it ("should be " ++ show expected) $
actual `shouldBe` expected
)
[ ( "turn on", unflipped, flipped )
, ( "turn off", flipped, unflipped )
, ( "non-edit mode", nonEdit, nonEdit )
] where
nonEdit = initialState & hammingCode .~ 0x3c5a
unflipped = nonEdit & appMode .~ EditMode
( initialEditor
& rowNum .~ 1
& colNum .~ 3
)
flipped = unflipped & hammingCode .~ 0x3cda
--jl --jl

View File

@ -29,8 +29,9 @@ import Hamming.App.Types
import Hamming.App.Util import Hamming.App.Util
spec :: Spec spec :: Spec
spec = describe "Util" spec = describe "Util" $ do
getLocationSpec getLocationSpec
bitmaskSpec
getLocationSpec :: Spec getLocationSpec :: Spec
getLocationSpec = describe "getLocation" $ mapM_ getLocationSpec = describe "getLocation" $ mapM_
@ -50,4 +51,14 @@ getLocationSpec = describe "getLocation" $ mapM_
) )
l = Location (4, 3) l = Location (4, 3)
bitmaskSpec :: Spec
bitmaskSpec = describe "bitmask" $ let
s = initialEditor
& rowNum .~ 1
& colNum .~ 2
actual = bitmask s
expected = 0x0040
in it ("should be " ++ show expected) $
actual `shouldBe` expected
--jl --jl