show validity of hamming code

This commit is contained in:
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"