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

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
@ -44,9 +44,15 @@ mainApp = App
, appHandleEvent = eventHandler
, appStartEvent = return ()
, appAttrMap = const $ attrMap (style 0)
[ ( marginAttr, fg green )
, ( checkAttr, style bold )
, ( zeroAttr, fg red )
[ ( marginAttr, fg green )
, ( checkAttr, style bold )
, ( zeroAttr, fg red )
, ( validAttr
, (style bold) { attrForeColor = SetTo green }
)
, ( invalidAttr
, (style bold) { attrForeColor = SetTo red }
)
]
}

View File

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

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"

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