style hamming code widget

This commit is contained in:
Jonathan Lamothe 2024-07-23 16:45:55 -04:00
parent 120d60bc32
commit d0afc52c35
5 changed files with 24 additions and 22 deletions

View File

@ -41,6 +41,7 @@ library
, microlens >=0.4.13.1 && <0.5
, microlens-th >=0.4.3.15 && <0.5
, mtl >=2.3.1 && <2.4
, vty ==6.1.*
default-language: Haskell2010
executable hamming
@ -59,6 +60,7 @@ executable hamming
, microlens >=0.4.13.1 && <0.5
, microlens-th >=0.4.3.15 && <0.5
, mtl >=2.3.1 && <2.4
, vty ==6.1.*
default-language: Haskell2010
test-suite hamming-test
@ -84,4 +86,5 @@ test-suite hamming-test
, microlens >=0.4.13.1 && <0.5
, microlens-th >=0.4.3.15 && <0.5
, mtl >=2.3.1 && <2.4
, vty ==6.1.*
default-language: Haskell2010

View File

@ -24,6 +24,7 @@ dependencies:
- microlens >= 0.4.13.1 && < 0.5
- microlens-th >= 0.4.3.15 && < 0.5
- mtl >= 2.3.1 && < 2.4
- vty >= 6.1 && < 6.2
ghc-options:
- -Wall

View File

@ -26,13 +26,16 @@ License along with this program. If not, see
module Hamming.App (mainApp, initialState) where
import Brick.AttrMap (forceAttrMap)
import Brick.AttrMap (attrMap)
import Brick.Main (App (..), neverShowCursor)
import Brick.Util (style)
import Brick.Util (fg, style)
import Graphics.Vty.Attributes (bold)
import Graphics.Vty.Attributes.Color (green, red)
import Hamming.App.Draw
import Hamming.App.Events
import Hamming.App.Types
import Hamming.App.Widgets
mainApp :: App AppState () ResName
mainApp = App
@ -40,7 +43,11 @@ mainApp = App
, appChooseCursor = neverShowCursor
, appHandleEvent = eventHandler
, appStartEvent = return ()
, appAttrMap = const $ forceAttrMap $ style 0
, appAttrMap = const $ attrMap (style 0)
[ ( marginAttr, fg green )
, ( checkAttr, style bold )
, ( zeroAttr, fg red )
]
}
--jl

View File

@ -29,12 +29,11 @@ module Hamming.App.Widgets (
hammingW,
-- ** Attribute Names
hammingAttr,
hammingMarginAttr,
hammingCheckAttr,
hammingZeroAttr,
marginAttr,
checkAttr,
zeroAttr,
) where
import Brick.AttrMap (AttrName, attrName)
import Brick.Types (Widget)
import Brick.Widgets.Core (hBox, str, vBox, withAttr)
@ -45,21 +44,9 @@ import Hamming.App.Widgets.Internal
hammingW
:: AppState
-> Widget ResName
hammingW = withAttr (attrName "hamming")
hammingW = withAttr hammingAttr
. vBox
. map (hBox . map (\(a, w) -> withAttr a $ str [w]))
. hammingW'
hammingAttr :: AttrName
hammingAttr = attrName "hamming"
hammingMarginAttr :: AttrName
hammingMarginAttr = hammingAttr <> marginAttr
hammingCheckAttr :: AttrName
hammingCheckAttr = hammingAttr <> checkAttr
hammingZeroAttr :: AttrName
hammingZeroAttr = hammingAttr <> zeroAttr
--jl

View File

@ -33,6 +33,7 @@ module Hamming.App.Widgets.Internal (
-- * Hamming Code Widget
hammingW',
-- ** Attribute Names
hammingAttr,
marginAttr,
checkAttr,
zeroAttr,
@ -54,11 +55,14 @@ hammingW' state = let
['0'..'3']
body
hammingAttr :: AttrName
hammingAttr = attrName "hamming"
marginAttr :: AttrName
marginAttr = attrName "margin"
marginAttr = hammingAttr <> attrName "margin"
checkAttr :: AttrName
checkAttr = attrName "check"
checkAttr = hammingAttr <> attrName "check"
zeroAttr :: AttrName
zeroAttr = checkAttr <> attrName "zero"