{-# LANGUAGE ScopedTypeVariables #-}
module RetroClash.Video
    ( maskStart, maskEnd, maskSides
    , center
    , scale
    , withBorder
    ) where

import Clash.Prelude
import RetroClash.Utils
import Data.Maybe

maskStart
    :: forall k n dom. (KnownNat n, KnownNat k)
    => (HiddenClockResetEnable dom)
    => Signal dom (Maybe (Index (k + n)))
    -> Signal dom (Maybe (Index n))
maskStart :: Signal dom (Maybe (Index (k + n))) -> Signal dom (Maybe (Index n))
maskStart = SNat k
-> Signal dom (Maybe (Index ((k + n) + 0)))
-> Signal dom (Maybe (Index n))
forall (n :: Nat) (m :: Nat) (k :: Nat) (dom :: Domain).
(KnownNat n, KnownNat m, KnownNat k, HiddenClockResetEnable dom) =>
SNat k
-> Signal dom (Maybe (Index ((k + n) + m)))
-> Signal dom (Maybe (Index n))
maskSides (KnownNat k => SNat k
forall (n :: Nat). KnownNat n => SNat n
SNat @k)

maskEnd
    :: forall k n dom. (KnownNat n, KnownNat k)
    => (HiddenClockResetEnable dom)
    => Signal dom (Maybe (Index (n + k)))
    -> Signal dom (Maybe (Index n))
maskEnd :: Signal dom (Maybe (Index (n + k))) -> Signal dom (Maybe (Index n))
maskEnd = SNat 0
-> Signal dom (Maybe (Index ((0 + n) + k)))
-> Signal dom (Maybe (Index n))
forall (n :: Nat) (m :: Nat) (k :: Nat) (dom :: Domain).
(KnownNat n, KnownNat m, KnownNat k, HiddenClockResetEnable dom) =>
SNat k
-> Signal dom (Maybe (Index ((k + n) + m)))
-> Signal dom (Maybe (Index n))
maskSides (KnownNat 0 => SNat 0
forall (n :: Nat). KnownNat n => SNat n
SNat @0)

center
    :: forall n n0 k m dom. (KnownNat n, KnownNat n0, KnownNat k, KnownNat m)
    => (k ~ ((n0 - n) `Div` 2), n0 ~ (k + n + m))
    => (HiddenClockResetEnable dom)
    => Signal dom (Maybe (Index n0))
    -> Signal dom (Maybe (Index n))
center :: Signal dom (Maybe (Index n0)) -> Signal dom (Maybe (Index n))
center = SNat k
-> Signal dom (Maybe (Index ((k + n) + m)))
-> Signal dom (Maybe (Index n))
forall (n :: Nat) (m :: Nat) (k :: Nat) (dom :: Domain).
(KnownNat n, KnownNat m, KnownNat k, HiddenClockResetEnable dom) =>
SNat k
-> Signal dom (Maybe (Index ((k + n) + m)))
-> Signal dom (Maybe (Index n))
maskSides (KnownNat k => SNat k
forall (n :: Nat). KnownNat n => SNat n
SNat @k)

maskSides
    :: (KnownNat n, KnownNat m, KnownNat k)
    => (HiddenClockResetEnable dom)
    => SNat k
    -> Signal dom (Maybe (Index (k + n + m)))
    -> Signal dom (Maybe (Index n))
maskSides :: SNat k
-> Signal dom (Maybe (Index ((k + n) + m)))
-> Signal dom (Maybe (Index n))
maskSides SNat k
k Signal dom (Maybe (Index ((k + n) + m)))
raw = Signal dom (Maybe (Index n))
transformed
  where
    changed :: Signal dom Bool
changed = Maybe (Index ((k + n) + m))
-> Signal dom (Maybe (Index ((k + n) + m)))
-> Signal dom (Maybe (Index ((k + n) + m)))
forall (dom :: Domain) a.
(HiddenClockResetEnable dom, NFDataX a) =>
a -> Signal dom a -> Signal dom a
register Maybe (Index ((k + n) + m))
forall a. Maybe a
Nothing Signal dom (Maybe (Index ((k + n) + m)))
raw Signal dom (Maybe (Index ((k + n) + m)))
-> Signal dom (Maybe (Index ((k + n) + m))) -> Signal dom Bool
forall a (f :: Type -> Type).
(Eq a, Applicative f) =>
f a -> f a -> f Bool
./=. Signal dom (Maybe (Index ((k + n) + m)))
raw
    starting :: Signal dom Bool
starting = Signal dom (Maybe (Index ((k + n) + m)))
raw Signal dom (Maybe (Index ((k + n) + m)))
-> Maybe (Index ((k + n) + m)) -> Signal dom Bool
forall a (f :: Type -> Type).
(Eq a, Functor f) =>
f a -> a -> f Bool
.== Index ((k + n) + m) -> Maybe (Index ((k + n) + m))
forall a. a -> Maybe a
Just (SNat k -> Index ((k + n) + m)
forall a (n :: Nat). Num a => SNat n -> a
snatToNum SNat k
k)

    r :: Signal dom (Maybe (Index n))
r = Maybe (Index n)
-> Signal dom (Maybe (Index n)) -> Signal dom (Maybe (Index n))
forall (dom :: Domain) a.
(HiddenClockResetEnable dom, NFDataX a) =>
a -> Signal dom a -> Signal dom a
register Maybe (Index n)
forall a. Maybe a
Nothing Signal dom (Maybe (Index n))
transformed
    transformed :: Signal dom (Maybe (Index n))
transformed =
        Signal dom Bool
-> Signal dom (Maybe (Index n))
-> Signal dom (Maybe (Index n))
-> Signal dom (Maybe (Index n))
forall (f :: Type -> Type) a.
Applicative f =>
f Bool -> f a -> f a -> f a
mux (Bool -> Bool
not (Bool -> Bool) -> Signal dom Bool -> Signal dom Bool
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom Bool
changed) Signal dom (Maybe (Index n))
r (Signal dom (Maybe (Index n)) -> Signal dom (Maybe (Index n)))
-> Signal dom (Maybe (Index n)) -> Signal dom (Maybe (Index n))
forall a b. (a -> b) -> a -> b
$
        Signal dom Bool
-> Signal dom (Maybe (Index n))
-> Signal dom (Maybe (Index n))
-> Signal dom (Maybe (Index n))
forall (f :: Type -> Type) a.
Applicative f =>
f Bool -> f a -> f a -> f a
mux (Maybe (Index ((k + n) + m)) -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe (Index ((k + n) + m)) -> Bool)
-> Signal dom (Maybe (Index ((k + n) + m))) -> Signal dom Bool
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom (Maybe (Index ((k + n) + m)))
raw) (Maybe (Index n) -> Signal dom (Maybe (Index n))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Maybe (Index n)
forall a. Maybe a
Nothing) (Signal dom (Maybe (Index n)) -> Signal dom (Maybe (Index n)))
-> Signal dom (Maybe (Index n)) -> Signal dom (Maybe (Index n))
forall a b. (a -> b) -> a -> b
$
        Signal dom Bool
-> Signal dom (Maybe (Index n))
-> Signal dom (Maybe (Index n))
-> Signal dom (Maybe (Index n))
forall (f :: Type -> Type) a.
Applicative f =>
f Bool -> f a -> f a -> f a
mux Signal dom Bool
starting (Maybe (Index n) -> Signal dom (Maybe (Index n))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Maybe (Index n) -> Signal dom (Maybe (Index n)))
-> Maybe (Index n) -> Signal dom (Maybe (Index n))
forall a b. (a -> b) -> a -> b
$ Index n -> Maybe (Index n)
forall a. a -> Maybe a
Just Index n
0) (Signal dom (Maybe (Index n)) -> Signal dom (Maybe (Index n)))
-> Signal dom (Maybe (Index n)) -> Signal dom (Maybe (Index n))
forall a b. (a -> b) -> a -> b
$
        (Index n -> Maybe (Index n)
forall a. (Eq a, Enum a, Bounded a) => a -> Maybe a
succIdx (Index n -> Maybe (Index n)) -> Maybe (Index n) -> Maybe (Index n)
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (Maybe (Index n) -> Maybe (Index n))
-> Signal dom (Maybe (Index n)) -> Signal dom (Maybe (Index n))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom (Maybe (Index n))
r

scale
    :: forall n k dom. (KnownNat n, KnownNat k, 1 <= k)
    => (HiddenClockResetEnable dom)
    => SNat k
    -> Signal dom (Maybe (Index (n * k)))
    -> (Signal dom (Maybe (Index n)), Signal dom (Maybe (Index k)))
scale :: SNat k
-> Signal dom (Maybe (Index (n * k)))
-> (Signal dom (Maybe (Index n)), Signal dom (Maybe (Index k)))
scale SNat k
k Signal dom (Maybe (Index (n * k)))
raw = (Signal dom (Maybe (Index n))
scaledNext, Signal dom Bool
-> Signal dom (Index k) -> Signal dom (Maybe (Index k))
forall (f :: Type -> Type) a.
Applicative f =>
f Bool -> f a -> f (Maybe a)
enable (Maybe (Index n) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (Index n) -> Bool)
-> Signal dom (Maybe (Index n)) -> Signal dom Bool
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom (Maybe (Index n))
scaledNext) Signal dom (Index k)
counterNext)
  where
    prev :: Signal dom (Maybe (Index (n * k)))
prev = Maybe (Index (n * k))
-> Signal dom (Maybe (Index (n * k)))
-> Signal dom (Maybe (Index (n * k)))
forall (dom :: Domain) a.
(HiddenClockResetEnable dom, NFDataX a) =>
a -> Signal dom a -> Signal dom a
register Maybe (Index (n * k))
forall a. Maybe a
Nothing Signal dom (Maybe (Index (n * k)))
raw
    changed :: Signal dom Bool
changed = Signal dom (Maybe (Index (n * k)))
raw Signal dom (Maybe (Index (n * k)))
-> Signal dom (Maybe (Index (n * k))) -> Signal dom Bool
forall a (f :: Type -> Type).
(Eq a, Applicative f) =>
f a -> f a -> f Bool
./=. Signal dom (Maybe (Index (n * k)))
prev

    counter :: Signal dom (Index k)
counter = Index k -> Signal dom (Index k) -> Signal dom (Index k)
forall (dom :: Domain) a.
(HiddenClockResetEnable dom, NFDataX a) =>
a -> Signal dom a -> Signal dom a
register (Index k
0 :: Index k) Signal dom (Index k)
counterNext
    counterNext :: Signal dom (Index k)
counterNext =
        Signal dom Bool
-> Signal dom (Index k)
-> Signal dom (Index k)
-> Signal dom (Index k)
forall (f :: Type -> Type) a.
Applicative f =>
f Bool -> f a -> f a -> f a
mux (Bool -> Bool
not (Bool -> Bool) -> Signal dom Bool -> Signal dom Bool
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom Bool
changed) Signal dom (Index k)
counter (Signal dom (Index k) -> Signal dom (Index k))
-> Signal dom (Index k) -> Signal dom (Index k)
forall a b. (a -> b) -> a -> b
$
        Signal dom Bool
-> Signal dom (Index k)
-> Signal dom (Index k)
-> Signal dom (Index k)
forall (f :: Type -> Type) a.
Applicative f =>
f Bool -> f a -> f a -> f a
mux (Maybe (Index (n * k)) -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe (Index (n * k)) -> Bool)
-> Signal dom (Maybe (Index (n * k))) -> Signal dom Bool
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom (Maybe (Index (n * k)))
prev) (Index k -> Signal dom (Index k)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Index k
0) (Signal dom (Index k) -> Signal dom (Index k))
-> Signal dom (Index k) -> Signal dom (Index k)
forall a b. (a -> b) -> a -> b
$
        Index k -> Index k
forall a. (Eq a, Enum a, Bounded a) => a -> a
nextIdx (Index k -> Index k)
-> Signal dom (Index k) -> Signal dom (Index k)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom (Index k)
counter

    scaled :: Signal dom (Maybe (Index n))
scaled = Maybe (Index n)
-> Signal dom (Maybe (Index n)) -> Signal dom (Maybe (Index n))
forall (dom :: Domain) a.
(HiddenClockResetEnable dom, NFDataX a) =>
a -> Signal dom a -> Signal dom a
register Maybe (Index n)
forall a. Maybe a
Nothing Signal dom (Maybe (Index n))
scaledNext
    scaledNext :: Signal dom (Maybe (Index n))
scaledNext =
        Signal dom Bool
-> Signal dom (Maybe (Index n))
-> Signal dom (Maybe (Index n))
-> Signal dom (Maybe (Index n))
forall (f :: Type -> Type) a.
Applicative f =>
f Bool -> f a -> f a -> f a
mux (Bool -> Bool
not (Bool -> Bool) -> Signal dom Bool -> Signal dom Bool
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom Bool
changed) Signal dom (Maybe (Index n))
scaled (Signal dom (Maybe (Index n)) -> Signal dom (Maybe (Index n)))
-> Signal dom (Maybe (Index n)) -> Signal dom (Maybe (Index n))
forall a b. (a -> b) -> a -> b
$
        Signal dom Bool
-> Signal dom (Maybe (Index n))
-> Signal dom (Maybe (Index n))
-> Signal dom (Maybe (Index n))
forall (f :: Type -> Type) a.
Applicative f =>
f Bool -> f a -> f a -> f a
mux (Signal dom (Index k)
counterNext Signal dom (Index k) -> Index k -> Signal dom Bool
forall a (f :: Type -> Type).
(Eq a, Functor f) =>
f a -> a -> f Bool
.== Index k
0) (Maybe (Index n)
-> (Index n -> Maybe (Index n))
-> Maybe (Index n)
-> Maybe (Index n)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Index n -> Maybe (Index n)
forall a. a -> Maybe a
Just Index n
0) Index n -> Maybe (Index n)
forall a. (Eq a, Enum a, Bounded a) => a -> Maybe a
succIdx (Maybe (Index n) -> Maybe (Index n))
-> Signal dom (Maybe (Index n)) -> Signal dom (Maybe (Index n))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom (Maybe (Index n))
scaled) (Signal dom (Maybe (Index n)) -> Signal dom (Maybe (Index n)))
-> Signal dom (Maybe (Index n)) -> Signal dom (Maybe (Index n))
forall a b. (a -> b) -> a -> b
$
        Signal dom (Maybe (Index n))
scaled

withBorder
    :: (BitPack a, BitPack a', BitSize a' ~ BitSize a)
    => a
    -> (x -> y -> a')
    -> Maybe x -> Maybe y -> a
withBorder :: a -> (x -> y -> a') -> Maybe x -> Maybe y -> a
withBorder a
border x -> y -> a'
draw Maybe x
x Maybe y
y = case (Maybe x
x, Maybe y
y) of
    (Just x
x, Just y
y) -> a' -> a
forall a b. (BitPack a, BitPack b, BitSize a ~ BitSize b) => a -> b
bitCoerce (a' -> a) -> a' -> a
forall a b. (a -> b) -> a -> b
$ x -> y -> a'
draw x
x y
y
    (Maybe x, Maybe y)
_ -> a
border