{-# 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