jlamothe/hamming
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

show validity of hamming code

This commit is contained in:
Jonathan Lamothe 2024-08-01 18:33:33 -04:00
parent 09c8953728
commit d2371e956b
4 changed files with 61 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/Hamming/App.hs
View File

@ -29,7 +29,7 @@ module Hamming.App (mainApp, initialState) where
import Brick.AttrMap (attrMap)
import Brick.Main (App (..), showFirstCursor)
import Brick.Util (fg, style)
import Graphics.Vty.Attributes (bold)
import Graphics.Vty.Attributes (Attr (..), MaybeDefault (..), bold)
import Graphics.Vty.Attributes.Color (green, red)
import Hamming.App.Draw
@ -47,6 +47,12 @@ mainApp = App
[ ( marginAttr, fg green )
, ( checkAttr, style bold )
, ( zeroAttr, fg red )
, ( validAttr
, (style bold) { attrForeColor = SetTo green }
)
, ( invalidAttr
, (style bold) { attrForeColor = SetTo red }
)
]
}

2
src/Hamming/App/Widgets.hs
View File

@ -30,6 +30,8 @@ module Hamming.App.Widgets (
-- ** Attribute Names
hammingAttr,
marginAttr,
validAttr,
invalidAttr,
bodyAttr,
checkAttr,
zeroAttr,

14
src/Hamming/App/Widgets/Internal.hs
View File

@ -35,6 +35,8 @@ module Hamming.App.Widgets.Internal (
-- ** Attribute Names
hammingAttr,
marginAttr,
validAttr,
invalidAttr,
bodyAttr,
checkAttr,
zeroAttr,
@ -46,12 +48,16 @@ import Lens.Micro (_2, (^.), (%~))
import Brick.AttrMap (AttrName, attrName)
import Brick.Types (Location)
import Hamming
import Hamming.App.Types
import Hamming.App.Util
hammingW' :: AppState -> ([[(AttrName, Char)]], Maybe Location)
hammingW' state = let
header = (hammingAttr, ' ') : map (marginAttr,) ['0'..'3']
valid = if isValid (state^.hammingCode)
then (validAttr, '✓')
else (invalidAttr, 'X')
header = valid : map (marginAttr,) ['0'..'3']
body = hammingBody state
widget = header : zipWith
(\n row -> (marginAttr, n) : row)
@ -65,6 +71,12 @@ hammingAttr = attrName "hamming"
marginAttr :: AttrName
marginAttr = hammingAttr <> attrName "margin"
validAttr :: AttrName
validAttr = marginAttr <> attrName "valid"
invalidAttr :: AttrName
invalidAttr = marginAttr <> attrName "invalid"
bodyAttr :: AttrName
bodyAttr = hammingAttr <> attrName "body"

39
test/Hamming/App/Widgets/InternalSpec.hs
View File

@ -65,13 +65,14 @@ hammingW'Spec = describe "hammingW'" $ mapM_
[ ( "all zero", mkState 0, allZero, Nothing )
, ( "all one", mkState 0xffff, allOne, Nothing )
, ( "arbitrary", mkState 0x3c5a, arbitrary, Nothing )
, ( "invalid", mkState 0x3c5b, invalid, Nothing )
, ( "edit", es, allZero, Just eLoc )
] where
mkState c = initialState & hammingCode .~ c
es = mkState 0 & appMode .~ EditMode initialEditor
eLoc = Location (1, 1)
allZero =
[ [ ( hammingAttr, ' ' )
[ [ ( validAttr, '✓' )
, ( marginAttr, '0' )
, ( marginAttr, '1' )
, ( marginAttr, '2' )
@ -103,7 +104,7 @@ hammingW'Spec = describe "hammingW'" $ mapM_
]
]
allOne =
[ [ ( hammingAttr, ' ' )
[ [ ( validAttr, '✓' )
, ( marginAttr, '0' )
, ( marginAttr, '1' )
, ( marginAttr, '2' )
@ -135,7 +136,7 @@ hammingW'Spec = describe "hammingW'" $ mapM_
]
]
arbitrary =
[ [ ( hammingAttr, ' ' )
[ [ ( validAttr, '✓' )
, ( marginAttr, '0' )
, ( marginAttr, '1' )
, ( marginAttr, '2' )
@ -166,5 +167,37 @@ hammingW'Spec = describe "hammingW'" $ mapM_
, ( bodyAttr, '0' )
]
]
invalid =
[ [ ( invalidAttr, 'X' )
, ( marginAttr, '0' )
, ( marginAttr, '1' )
, ( marginAttr, '2' )
, ( marginAttr, '3' )
]
, [ ( marginAttr, '0' )
, ( zeroAttr, '1' )
, ( checkAttr, '1' )
, ( checkAttr, '0' )
, ( bodyAttr, '1' )
]
, [ ( marginAttr, '1' )
, ( checkAttr, '1' )
, ( bodyAttr, '0' )
, ( bodyAttr, '1' )
, ( bodyAttr, '0' )
]
, [ ( marginAttr, '2' )
, ( checkAttr, '0' )
, ( bodyAttr, '0' )
, ( bodyAttr, '1' )
, ( bodyAttr, '1' )
]
, [ ( marginAttr, '3' )
, ( bodyAttr, '1' )
, ( bodyAttr, '1' )
, ( bodyAttr, '0' )
, ( bodyAttr, '0' )
]
]
--jl