diff --git a/src/Hamming/App/Actions.hs b/src/Hamming/App/Actions.hs index 9265926..fc75819 100644 --- a/src/Hamming/App/Actions.hs +++ b/src/Hamming/App/Actions.hs @@ -1,7 +1,7 @@ {-| Module : Hamming.App.Actions -Description : Utilities for working with Hamming codes +Description : Functions that transform the application state Copyright : (C) Jonathan Lamothe License : AGPL-3.0-or-later Maintainer : jonathan@jlamothe.net @@ -25,15 +25,20 @@ License along with this program. If not, see |-} module Hamming.App.Actions ( + -- * Cursor Movement moveUp, moveDown, moveLeft, - moveRight + moveRight, + -- * Other Edits + flipBit, ) where -import Lens.Micro ((%~)) +import Data.Bits (xor) +import Lens.Micro ((^.), (&), (%~)) import Hamming.App.Types +import Hamming.App.Util moveUp :: EditState -> EditState moveUp = rowNum %~ @@ -63,4 +68,9 @@ moveRight = colNum %~ else 3 ) +flipBit :: AppState -> AppState +flipBit s = case s^.appMode of + EditMode es -> s & hammingCode %~ xor (bitmask es) + _ -> s + --jl diff --git a/src/Hamming/App/Events.hs b/src/Hamming/App/Events.hs index b226fc7..59fe2b3 100644 --- a/src/Hamming/App/Events.hs +++ b/src/Hamming/App/Events.hs @@ -1,7 +1,7 @@ {-| Module : Hamming.App.Events -Description : Utilities for working with Hamming codes +Description : Main event handler functions Copyright : (C) Jonathan Lamothe License : AGPL-3.0-or-later Maintainer : jonathan@jlamothe.net @@ -72,6 +72,8 @@ editHandler (VtyEvent (EvKey KRight [])) = modify $ appMode.editState %~ moveRight editHandler (VtyEvent (EvKey (KChar 'l') [])) = modify $ appMode.editState %~ moveRight +editHandler (VtyEvent (EvKey (KChar 'f') [])) = + modify flipBit editHandler _ = return () --jl diff --git a/src/Hamming/App/Util.hs b/src/Hamming/App/Util.hs index 66f94fc..45d27ac 100644 --- a/src/Hamming/App/Util.hs +++ b/src/Hamming/App/Util.hs @@ -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 Data.Bits (shiftL) +import Data.Word (Word16) import Lens.Micro ((^.)) 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) getLocation :: AppState -> Maybe Location getLocation s = case s^.appMode of diff --git a/test/Hamming/App/ActionsSpec.hs b/test/Hamming/App/ActionsSpec.hs index 7887ce5..6e06e73 100644 --- a/test/Hamming/App/ActionsSpec.hs +++ b/test/Hamming/App/ActionsSpec.hs @@ -33,6 +33,7 @@ spec = describe "Actions" $ do moveDownSpec moveLeftSpec moveRightSpec + flipBitSpec moveUpSpec :: Spec moveUpSpec = describe "moveUp" $ mapM_ @@ -102,4 +103,23 @@ moveRightSpec = describe "moveRight" $ mapM_ & rowNum .~ 1 & 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 diff --git a/test/Hamming/App/UtilSpec.hs b/test/Hamming/App/UtilSpec.hs index b6d17c4..99c676f 100644 --- a/test/Hamming/App/UtilSpec.hs +++ b/test/Hamming/App/UtilSpec.hs @@ -29,8 +29,9 @@ import Hamming.App.Types import Hamming.App.Util spec :: Spec -spec = describe "Util" +spec = describe "Util" $ do getLocationSpec + bitmaskSpec getLocationSpec :: Spec getLocationSpec = describe "getLocation" $ mapM_ @@ -50,4 +51,14 @@ getLocationSpec = describe "getLocation" $ mapM_ ) 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