module Hardware.KansasLava.SevenSegment
( Active(..)
, SevenSegment(..)
, encodeHexSS
, showSS
, driveSS
, driveSS_
) where
import Language.KansasLava
import Language.KansasLava.Signal.Utils
import Data.Sized.Matrix as Matrix
import Data.Sized.Unsigned as Unsigned
import Data.Maybe (isJust, fromMaybe)
import Control.Applicative
data Active = ActiveHigh | ActiveLow
data SevenSegment clk (active :: Active) n = SevenSegment
{ ssAnodes :: Matrix n (Signal clk Bool)
, ssSegments :: Matrix X7 (Signal clk Bool)
, ssDecimalPoint :: Signal clk Bool
}
encodeHexSS :: Unsigned X4 -> Matrix X7 Bool
encodeHexSS n = matrix $ case n of
0x0 -> [ True, True, True, True, True, True, False ]
0x1 -> [ False, True, True, False, False, False, False ]
0x2 -> [ True, True, False, True, True, False, True ]
0x3 -> [ True, True, True, True, False, False, True ]
0x4 -> [ False, True, True, False, False, True, True ]
0x5 -> [ True, False, True, True, False, True, True ]
0x6 -> [ True, False, True, True, True, True, True ]
0x7 -> [ True, True, True, False, False, False, False ]
0x8 -> [ True, True, True, True, True, True, True ]
0x9 -> [ True, True, True, True, False, True, True ]
0xa -> [ True, True, True, False, True, True, True ]
0xb -> [ False, False, True, True, True, True, True ]
0xc -> [ True, False, False, True, True, True, False ]
0xd -> [ False, True, True, True, True, False, True ]
0xe -> [ True, False, False, True, True, True, True ]
0xf -> [ True, False, False, False, True, True, True ]
showSS :: Matrix X7 Bool -> String
showSS (toList -> [a, b, c, d, e, f, g])
= unlines
[ vpad ++ horiz a ++ vpad
, vert f ++ hpad ++ vert b
, vert f ++ hpad ++ vert b
, vpad ++ horiz g ++ vpad
, vert e ++ hpad ++ vert c
, vert e ++ hpad ++ vert c
, vpad ++ horiz d ++ vpad
]
where
vpad = replicate 1 ' '
hpad = replicate 3 ' '
horiz b = replicate 3 $ if b then '#' else ' '
vert b = replicate 1 $ if b then '#' else ' '
driveSS_ :: forall clk sig n. (Clock clk, sig ~ Signal clk, Size n, Rep n, Num n, Integral n)
=> Matrix n (Maybe (Matrix X7 (sig Bool)))
-> SevenSegment clk ActiveLow n
driveSS_ segss = driveSS mask segss'
where
mask = fmap (pureS . isJust) segss
segss' = fmap (fromMaybe noSegs) segss
noSegs :: Matrix X7 (sig Bool)
noSegs = matrix $ replicate 7 low
driveSS :: forall clk sig n. (Clock clk, sig ~ Signal clk, Size n, Rep n, Num n, Integral n)
=> Matrix n (sig Bool)
-> Matrix n (Matrix X7 (sig Bool))
-> SevenSegment clk ActiveLow n
driveSS mask segss = SevenSegment (bitNot <$> anodes') (bitNot <$> segs) high
where
clkAnode :: sig Bool
clkAnode = divideClk (Witness :: Witness X4)
selector :: sig n
selector = counter clkAnode
segss' :: Matrix X7 (Matrix n (sig Bool))
segss' = columns . joinRows $ segss
segs :: Matrix X7 (sig Bool)
segs = fmap (nary selector) segss'
anodes :: Matrix n (sig Bool)
anodes = fmap (.&&. clkAnode) $ rotatorL clkAnode
anodes' :: Matrix n (sig Bool)
anodes' = Matrix.zipWith (.&&.) mask anodes