{-# LANGUAGE PartialTypeSignatures, RecordWildCards, ApplicativeDo #-}
{-# OPTIONS_GHC -Wno-partial-type-signatures #-}
module RetroClash.SevenSegment
    ( SevenSegment(..)
    , encodeHexSS
    , showSS
    , showSSs
    , muxRR
    , driveSS
    , sevenSegmentPort
    -- , bytesSS
    ) where

import Clash.Prelude
import qualified Data.List as L
import RetroClash.Utils
import RetroClash.Clock

data SevenSegment n anodes segments dp = SevenSegment
    { SevenSegment n anodes segments dp -> "AN" ::: Vec n (Active anodes)
anodes :: "AN" ::: Vec n (Active anodes)
    , SevenSegment n anodes segments dp
-> "SEG" ::: Vec 7 (Active segments)
segments :: "SEG" ::: Vec 7 (Active segments)
    , SevenSegment n anodes segments dp -> "DP" ::: Active dp
dp :: "DP" ::: Active dp
    }
    deriving ((forall x.
 SevenSegment n anodes segments dp
 -> Rep (SevenSegment n anodes segments dp) x)
-> (forall x.
    Rep (SevenSegment n anodes segments dp) x
    -> SevenSegment n anodes segments dp)
-> Generic (SevenSegment n anodes segments dp)
forall x.
Rep (SevenSegment n anodes segments dp) x
-> SevenSegment n anodes segments dp
forall x.
SevenSegment n anodes segments dp
-> Rep (SevenSegment n anodes segments dp) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (n :: Nat) (anodes :: Polarity) (segments :: Polarity)
       (dp :: Polarity) x.
Rep (SevenSegment n anodes segments dp) x
-> SevenSegment n anodes segments dp
forall (n :: Nat) (anodes :: Polarity) (segments :: Polarity)
       (dp :: Polarity) x.
SevenSegment n anodes segments dp
-> Rep (SevenSegment n anodes segments dp) x
$cto :: forall (n :: Nat) (anodes :: Polarity) (segments :: Polarity)
       (dp :: Polarity) x.
Rep (SevenSegment n anodes segments dp) x
-> SevenSegment n anodes segments dp
$cfrom :: forall (n :: Nat) (anodes :: Polarity) (segments :: Polarity)
       (dp :: Polarity) x.
SevenSegment n anodes segments dp
-> Rep (SevenSegment n anodes segments dp) x
Generic)

muxRR
    :: (KnownNat n, HiddenClockResetEnable dom)
    => Signal dom Bool
    -> Signal dom (Vec n a)
    -> (Signal dom (Vec n Bool), Signal dom a)
muxRR :: Signal dom Bool
-> Signal dom (Vec n a) -> (Signal dom (Vec n Bool), Signal dom a)
muxRR Signal dom Bool
tick Signal dom (Vec n a)
xs = (Signal dom (Vec n Bool)
selector, Signal dom a
current)
  where
    (Signal dom (Vec n Bool)
selector, Signal dom (Index n)
i) = Signal dom Bool -> (Signal dom (Vec n Bool), Signal dom (Index n))
forall k (n :: Nat) (dom :: Symbol) (a :: k).
(KnownNat n, HiddenClockResetEnable dom) =>
Signal dom Bool -> (Signal dom (Vec n Bool), Signal dom (Index n))
roundRobin Signal dom Bool
tick
    current :: Signal dom a
current = Vec n a -> Index n -> a
forall (n :: Nat) i a. (KnownNat n, Enum i) => Vec n a -> i -> a
(!!) (Vec n a -> Index n -> a)
-> Signal dom (Vec n a) -> Signal dom (Index n -> a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom (Vec n a)
xs Signal dom (Index n -> a) -> Signal dom (Index n) -> Signal dom a
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Signal dom (Index n)
i

driveSS
    :: (KnownNat n, HiddenClockResetEnable dom, _)
    => (a -> (Vec 7 Bool, Bool))
    -> Signal dom (Vec n (Maybe a))
    -> Signal dom (SevenSegment n anodes segments dp)
driveSS :: (a -> (Vec 7 Bool, Bool))
-> Signal dom (Vec n (Maybe a))
-> Signal dom (SevenSegment n anodes segments dp)
driveSS a -> (Vec 7 Bool, Bool)
draw Signal dom (Vec n (Maybe a))
digits = do
    Vec n (Active anodes)
anodes <- (Bool -> Active anodes) -> Vec n Bool -> Vec n (Active anodes)
forall a b (n :: Nat). (a -> b) -> Vec n a -> Vec n b
map Bool -> Active anodes
forall (p :: Polarity). IsActive p => Bool -> Active p
toActive (Vec n Bool -> Vec n (Active anodes))
-> Signal dom (Vec n Bool) -> Signal dom (Vec n (Active anodes))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom (Vec n Bool)
anodes
    Vec 7 (Active segments)
segments <- (Bool -> Active segments) -> Vec 7 Bool -> Vec 7 (Active segments)
forall a b (n :: Nat). (a -> b) -> Vec n a -> Vec n b
map Bool -> Active segments
forall (p :: Polarity). IsActive p => Bool -> Active p
toActive (Vec 7 Bool -> Vec 7 (Active segments))
-> Signal dom (Vec 7 Bool) -> Signal dom (Vec 7 (Active segments))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom (Vec 7 Bool)
segments
    Active dp
dp <- Bool -> Active dp
forall (p :: Polarity). IsActive p => Bool -> Active p
toActive (Bool -> Active dp) -> Signal dom Bool -> Signal dom (Active dp)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom Bool
dp
    pure SevenSegment :: forall (n :: Nat) (anodes :: Polarity) (segments :: Polarity)
       (dp :: Polarity).
("AN" ::: Vec n (Active anodes))
-> ("SEG" ::: Vec 7 (Active segments))
-> ("DP" ::: Active dp)
-> SevenSegment n anodes segments dp
SevenSegment{Vec n (Active anodes)
Vec 7 (Active segments)
Active dp
dp :: Active dp
segments :: Vec 7 (Active segments)
anodes :: Vec n (Active anodes)
dp :: Active dp
segments :: Vec 7 (Active segments)
anodes :: Vec n (Active anodes)
..}
  where
    (Signal dom (Vec n Bool)
anodes, Signal dom (Maybe a)
digit) = Signal dom Bool
-> Signal dom (Vec n (Maybe a))
-> (Signal dom (Vec n Bool), Signal dom (Maybe a))
forall (n :: Nat) (dom :: Symbol) a.
(KnownNat n, HiddenClockResetEnable dom) =>
Signal dom Bool
-> Signal dom (Vec n a) -> (Signal dom (Vec n Bool), Signal dom a)
muxRR (SNat (Picoseconds 1000000000) -> Signal dom Bool
forall (ps :: Nat) (dom :: Symbol).
(HiddenClockResetEnable dom, KnownNat ps,
 KnownNat (DomainConfigurationPeriod (KnownConf dom)),
 (1 <=? DomainConfigurationPeriod (KnownConf dom)) ~ 'True) =>
SNat ps -> Signal dom Bool
risePeriod (KnownNat (Milliseconds 1) => SNat (Milliseconds 1)
forall (n :: Nat). KnownNat n => SNat n
SNat @(Milliseconds 1))) Signal dom (Vec n (Maybe a))
digits
    (Signal dom (Vec 7 Bool)
segments, Signal dom Bool
dp) = Signal dom (Vec 7 Bool, Bool) -> Unbundled dom (Vec 7 Bool, Bool)
forall a (dom :: Symbol).
Bundle a =>
Signal dom a -> Unbundled dom a
unbundle (Signal dom (Vec 7 Bool, Bool) -> Unbundled dom (Vec 7 Bool, Bool))
-> Signal dom (Vec 7 Bool, Bool)
-> Unbundled dom (Vec 7 Bool, Bool)
forall a b. (a -> b) -> a -> b
$ (Vec 7 Bool, Bool)
-> (a -> (Vec 7 Bool, Bool)) -> Maybe a -> (Vec 7 Bool, Bool)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Bool -> Vec 7 Bool
forall (n :: Nat) a. KnownNat n => a -> Vec n a
repeat Bool
False, Bool
False) a -> (Vec 7 Bool, Bool)
draw (Maybe a -> (Vec 7 Bool, Bool))
-> Signal dom (Maybe a) -> Signal dom (Vec 7 Bool, Bool)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom (Maybe a)
digit

sevenSegmentPort :: PortName
sevenSegmentPort :: PortName
sevenSegmentPort = String -> [PortName] -> PortName
PortProduct String
"SS" ([PortName] -> PortName) -> [PortName] -> PortName
forall a b. (a -> b) -> a -> b
$ String -> PortName
PortName (String -> PortName) -> [String] -> [PortName]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> [String
"AN", String
"SEG", String
"DP"]

bytesSS
    :: forall n div dom clk sync. (KnownNat n, KnownNat div, HiddenClockResetEnable dom)
    => Unsigned div
    -> Signal dom (Vec n (Maybe (Unsigned 8)))
    -> (Signal dom (Vec (n * 2) Bool), Signal dom (Vec 7 Bool))
bytesSS :: Unsigned div
-> Signal dom (Vec n (Maybe (Unsigned 8)))
-> (Signal dom (Vec (n * 2) Bool), Signal dom (Vec 7 Bool))
bytesSS Unsigned div
div Signal dom (Vec n (Maybe (Unsigned 8)))
bytes = (Signal dom (Vec (n * 2) Bool)
shownDigit, Signal dom (Vec 7 Bool)
segments)
  where
    digit :: Signal dom (Index (n * 2))
digit = Index (n * 2)
-> Signal dom Bool
-> Signal dom (Index (n * 2))
-> Signal dom (Index (n * 2))
forall (dom :: Symbol) a.
(HiddenClockResetEnable dom, NFDataX a) =>
a -> Signal dom Bool -> Signal dom a -> Signal dom a
regEn (Index (n * 2)
0 :: Index (n * 2)) Signal dom Bool
timer (Signal dom (Index (n * 2)) -> Signal dom (Index (n * 2)))
-> Signal dom (Index (n * 2)) -> Signal dom (Index (n * 2))
forall a b. (a -> b) -> a -> b
$ Index (n * 2) -> Index (n * 2)
forall a. (Eq a, Enum a, Bounded a) => a -> a
nextIdx (Index (n * 2) -> Index (n * 2))
-> Signal dom (Index (n * 2)) -> Signal dom (Index (n * 2))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom (Index (n * 2))
digit
      where
        counter :: Signal dom (Unsigned div)
counter = Unsigned div
-> Unsigned div -> Signal dom Bool -> Signal dom (Unsigned div)
forall a (dom :: Symbol).
(Eq a, Enum a, NFDataX a, HiddenClockResetEnable dom) =>
a -> a -> Signal dom Bool -> Signal dom a
countFromTo Unsigned div
0 Unsigned div
div (Bool -> Signal dom Bool
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Bool
True)
        timer :: Signal dom Bool
timer = Signal dom (Unsigned div)
counter Signal dom (Unsigned div)
-> Signal dom (Unsigned div) -> Signal dom Bool
forall a (f :: Type -> Type).
(Eq a, Applicative f) =>
f a -> f a -> f Bool
.==. Unsigned div -> Signal dom (Unsigned div)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Unsigned div
0

    shownDigit :: Signal dom (Vec (n * 2) Bool)
shownDigit = Index (n * 2) -> Vec (n * 2) Bool
forall (n :: Nat). KnownNat n => Index n -> Vec n Bool
oneHot (Index (n * 2) -> Vec (n * 2) Bool)
-> Signal dom (Index (n * 2)) -> Signal dom (Vec (n * 2) Bool)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom (Index (n * 2))
digit
    segments :: Signal dom (Vec 7 Bool)
segments = Vec 7 Bool
-> (Unsigned 4 -> Vec 7 Bool) -> Maybe (Unsigned 4) -> Vec 7 Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Bool -> Vec 7 Bool
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Bool
False) Unsigned 4 -> Vec 7 Bool
encodeHexSS (Maybe (Unsigned 4) -> Vec 7 Bool)
-> Signal dom (Maybe (Unsigned 4)) -> Signal dom (Vec 7 Bool)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom (Maybe (Unsigned 4))
nibble

    nibble :: Signal dom (Maybe (Unsigned 4))
nibble = Vec (n * 2) (Maybe (Unsigned 4))
-> Index (n * 2) -> Maybe (Unsigned 4)
forall (n :: Nat) i a. (KnownNat n, Enum i) => Vec n a -> i -> a
(!!) (Vec (n * 2) (Maybe (Unsigned 4))
 -> Index (n * 2) -> Maybe (Unsigned 4))
-> Signal dom (Vec (n * 2) (Maybe (Unsigned 4)))
-> Signal dom (Index (n * 2) -> Maybe (Unsigned 4))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom (Vec (n * 2) (Maybe (Unsigned 4)))
nibbles Signal dom (Index (n * 2) -> Maybe (Unsigned 4))
-> Signal dom (Index (n * 2)) -> Signal dom (Maybe (Unsigned 4))
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Signal dom (Index (n * 2))
digit

    nibbles :: Signal dom (Vec (n * 2) (Maybe (Unsigned 4)))
nibbles = (Maybe (Unsigned 8) -> Vec 2 (Maybe (Unsigned 4)))
-> Vec n (Maybe (Unsigned 8)) -> Vec (n * 2) (Maybe (Unsigned 4))
forall a (m :: Nat) b (n :: Nat).
(a -> Vec m b) -> Vec n a -> Vec (n * m) b
concatMap ((Unsigned 8 -> Vec 2 (Unsigned 4))
-> Maybe (Unsigned 8) -> Vec 2 (Maybe (Unsigned 4))
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Unsigned 8 -> Vec 2 (Unsigned 4)
splitByte) (Vec n (Maybe (Unsigned 8)) -> Vec (n * 2) (Maybe (Unsigned 4)))
-> Signal dom (Vec n (Maybe (Unsigned 8)))
-> Signal dom (Vec (n * 2) (Maybe (Unsigned 4)))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom (Vec n (Maybe (Unsigned 8)))
bytes

    splitByte :: Unsigned 8 -> Vec 2 (Unsigned 4)
    splitByte :: Unsigned 8 -> Vec 2 (Unsigned 4)
splitByte Unsigned 8
byte = Unsigned 4
hi Unsigned 4 -> Vec 1 (Unsigned 4) -> Vec (1 + 1) (Unsigned 4)
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Unsigned 4
lo Unsigned 4 -> Vec 0 (Unsigned 4) -> Vec (0 + 1) (Unsigned 4)
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Vec 0 (Unsigned 4)
forall b. Vec 0 b
Nil
      where
        (Unsigned 4
hi, Unsigned 4
lo) = Unsigned 8 -> (Unsigned 4, Unsigned 4)
forall a b. (BitPack a, BitPack b, BitSize a ~ BitSize b) => a -> b
bitCoerce Unsigned 8
byte

encodeHexSS :: Unsigned 4 -> Vec 7 Bool
encodeHexSS :: Unsigned 4 -> Vec 7 Bool
encodeHexSS Unsigned 4
n = case Unsigned 4
n of
    --       a        b        c        d        e        f        g
    Unsigned 4
0x0 ->  Bool
True  Bool -> Vec 6 Bool -> Vec (6 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 5 Bool -> Vec (5 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 4 Bool -> Vec (4 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 3 Bool -> Vec (3 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 2 Bool -> Vec (2 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 1 Bool -> Vec (1 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
False Bool -> Vec 0 Bool -> Vec (0 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Vec 0 Bool
forall b. Vec 0 b
Nil
    Unsigned 4
0x1 ->  Bool
False Bool -> Vec 6 Bool -> Vec (6 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 5 Bool -> Vec (5 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 4 Bool -> Vec (4 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
False Bool -> Vec 3 Bool -> Vec (3 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
False Bool -> Vec 2 Bool -> Vec (2 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
False Bool -> Vec 1 Bool -> Vec (1 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
False Bool -> Vec 0 Bool -> Vec (0 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Vec 0 Bool
forall b. Vec 0 b
Nil
    Unsigned 4
0x2 ->  Bool
True  Bool -> Vec 6 Bool -> Vec (6 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 5 Bool -> Vec (5 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
False Bool -> Vec 4 Bool -> Vec (4 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 3 Bool -> Vec (3 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 2 Bool -> Vec (2 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
False Bool -> Vec 1 Bool -> Vec (1 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 0 Bool -> Vec (0 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Vec 0 Bool
forall b. Vec 0 b
Nil
    Unsigned 4
0x3 ->  Bool
True  Bool -> Vec 6 Bool -> Vec (6 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 5 Bool -> Vec (5 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 4 Bool -> Vec (4 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 3 Bool -> Vec (3 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
False Bool -> Vec 2 Bool -> Vec (2 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
False Bool -> Vec 1 Bool -> Vec (1 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 0 Bool -> Vec (0 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Vec 0 Bool
forall b. Vec 0 b
Nil
    Unsigned 4
0x4 ->  Bool
False Bool -> Vec 6 Bool -> Vec (6 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 5 Bool -> Vec (5 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 4 Bool -> Vec (4 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
False Bool -> Vec 3 Bool -> Vec (3 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
False Bool -> Vec 2 Bool -> Vec (2 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 1 Bool -> Vec (1 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 0 Bool -> Vec (0 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Vec 0 Bool
forall b. Vec 0 b
Nil
    Unsigned 4
0x5 ->  Bool
True  Bool -> Vec 6 Bool -> Vec (6 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
False Bool -> Vec 5 Bool -> Vec (5 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 4 Bool -> Vec (4 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 3 Bool -> Vec (3 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
False Bool -> Vec 2 Bool -> Vec (2 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 1 Bool -> Vec (1 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 0 Bool -> Vec (0 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Vec 0 Bool
forall b. Vec 0 b
Nil
    Unsigned 4
0x6 ->  Bool
True  Bool -> Vec 6 Bool -> Vec (6 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
False Bool -> Vec 5 Bool -> Vec (5 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 4 Bool -> Vec (4 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 3 Bool -> Vec (3 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 2 Bool -> Vec (2 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 1 Bool -> Vec (1 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 0 Bool -> Vec (0 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Vec 0 Bool
forall b. Vec 0 b
Nil
    Unsigned 4
0x7 ->  Bool
True  Bool -> Vec 6 Bool -> Vec (6 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 5 Bool -> Vec (5 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 4 Bool -> Vec (4 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
False Bool -> Vec 3 Bool -> Vec (3 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
False Bool -> Vec 2 Bool -> Vec (2 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
False Bool -> Vec 1 Bool -> Vec (1 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
False Bool -> Vec 0 Bool -> Vec (0 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Vec 0 Bool
forall b. Vec 0 b
Nil
    Unsigned 4
0x8 ->  Bool
True  Bool -> Vec 6 Bool -> Vec (6 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 5 Bool -> Vec (5 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 4 Bool -> Vec (4 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 3 Bool -> Vec (3 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 2 Bool -> Vec (2 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 1 Bool -> Vec (1 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 0 Bool -> Vec (0 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Vec 0 Bool
forall b. Vec 0 b
Nil
    Unsigned 4
0x9 ->  Bool
True  Bool -> Vec 6 Bool -> Vec (6 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 5 Bool -> Vec (5 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 4 Bool -> Vec (4 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 3 Bool -> Vec (3 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
False Bool -> Vec 2 Bool -> Vec (2 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 1 Bool -> Vec (1 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 0 Bool -> Vec (0 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Vec 0 Bool
forall b. Vec 0 b
Nil
    Unsigned 4
0xa ->  Bool
True  Bool -> Vec 6 Bool -> Vec (6 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 5 Bool -> Vec (5 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 4 Bool -> Vec (4 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
False Bool -> Vec 3 Bool -> Vec (3 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 2 Bool -> Vec (2 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 1 Bool -> Vec (1 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 0 Bool -> Vec (0 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Vec 0 Bool
forall b. Vec 0 b
Nil
    Unsigned 4
0xb ->  Bool
False Bool -> Vec 6 Bool -> Vec (6 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
False Bool -> Vec 5 Bool -> Vec (5 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 4 Bool -> Vec (4 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 3 Bool -> Vec (3 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 2 Bool -> Vec (2 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 1 Bool -> Vec (1 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 0 Bool -> Vec (0 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Vec 0 Bool
forall b. Vec 0 b
Nil
    Unsigned 4
0xc ->  Bool
True  Bool -> Vec 6 Bool -> Vec (6 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
False Bool -> Vec 5 Bool -> Vec (5 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
False Bool -> Vec 4 Bool -> Vec (4 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 3 Bool -> Vec (3 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 2 Bool -> Vec (2 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 1 Bool -> Vec (1 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
False Bool -> Vec 0 Bool -> Vec (0 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Vec 0 Bool
forall b. Vec 0 b
Nil
    Unsigned 4
0xd ->  Bool
False Bool -> Vec 6 Bool -> Vec (6 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 5 Bool -> Vec (5 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 4 Bool -> Vec (4 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 3 Bool -> Vec (3 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 2 Bool -> Vec (2 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
False Bool -> Vec 1 Bool -> Vec (1 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 0 Bool -> Vec (0 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Vec 0 Bool
forall b. Vec 0 b
Nil
    Unsigned 4
0xe ->  Bool
True  Bool -> Vec 6 Bool -> Vec (6 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
False Bool -> Vec 5 Bool -> Vec (5 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
False Bool -> Vec 4 Bool -> Vec (4 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 3 Bool -> Vec (3 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 2 Bool -> Vec (2 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 1 Bool -> Vec (1 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 0 Bool -> Vec (0 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Vec 0 Bool
forall b. Vec 0 b
Nil
    Unsigned 4
0xf ->  Bool
True  Bool -> Vec 6 Bool -> Vec (6 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
False Bool -> Vec 5 Bool -> Vec (5 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
False Bool -> Vec 4 Bool -> Vec (4 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
False Bool -> Vec 3 Bool -> Vec (3 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 2 Bool -> Vec (2 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 1 Bool -> Vec (1 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Bool
True  Bool -> Vec 0 Bool -> Vec (0 + 1) Bool
forall a (n :: Nat). a -> Vec n a -> Vec (n + 1) a
:> Vec 0 Bool
forall b. Vec 0 b
Nil

showSS :: Vec 7 Bool -> String
showSS :: Vec 7 Bool -> String
showSS (a :> b :> c :> d :> e :> f :> g :> Nil) = [String] -> String
unlines ([String] -> String)
-> ([[String]] -> [String]) -> [[String]] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[String]] -> [String]
forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
L.concat ([[String]] -> String) -> [[String]] -> String
forall a b. (a -> b) -> a -> b
$
    [ Int -> String -> [String]
forall a. Int -> a -> [a]
L.replicate Int
1 (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ Bool -> String
horiz   Bool
a
    , Int -> String -> [String]
forall a. Int -> a -> [a]
L.replicate Int
3 (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> String
vert  Bool
f   Bool
b
    , Int -> String -> [String]
forall a. Int -> a -> [a]
L.replicate Int
1 (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ Bool -> String
horiz   Bool
g
    , Int -> String -> [String]
forall a. Int -> a -> [a]
L.replicate Int
3 (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> String
vert  Bool
e   Bool
c
    , Int -> String -> [String]
forall a. Int -> a -> [a]
L.replicate Int
1 (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ Bool -> String
horiz   Bool
d
    ]
  where
    horiz :: Bool -> String
horiz Bool
True  = String
" ###### "
    horiz Bool
False = String
" ...... "

    vert :: Bool -> Bool -> String
vert Bool
b1 Bool
b2 = Bool -> String
part Bool
b1 String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"      " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Bool -> String
part Bool
b2
      where
        part :: Bool -> String
part Bool
True  = String
"#"
        part Bool
False = String
"."

showSSs :: [Vec 7 Bool] -> String
showSSs :: [Vec 7 Bool] -> String
showSSs = [String] -> String
unlines ([String] -> String)
-> ([Vec 7 Bool] -> [String]) -> [Vec 7 Bool] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> String) -> [[String]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
L.map (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
L.intercalate String
"  ") ([[String]] -> [String])
-> ([Vec 7 Bool] -> [[String]]) -> [Vec 7 Bool] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[String]] -> [[String]]
forall a. [[a]] -> [[a]]
L.transpose ([[String]] -> [[String]])
-> ([Vec 7 Bool] -> [[String]]) -> [Vec 7 Bool] -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vec 7 Bool -> [String]) -> [Vec 7 Bool] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
L.map (String -> [String]
lines (String -> [String])
-> (Vec 7 Bool -> String) -> Vec 7 Bool -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vec 7 Bool -> String
showSS)