module RetroClash.Keypad
    ( Matrix(..), KeyStates(..), KeyEvent(..), KeyEvents(..)
    , scanKeypad, keypadEvents
    , pressedKeys
    , firstJust2D
    , inputKeypad
    ) where

import Clash.Prelude
import RetroClash.Utils
import RetroClash.Clock
import Control.Monad (mplus)

type Matrix rows cols a = Vec rows (Vec cols a)

type KeyStates rows cols = Matrix rows cols Bool

data KeyEvent
    = Pressed
    | Released
    deriving (Int -> KeyEvent -> ShowS
[KeyEvent] -> ShowS
KeyEvent -> String
(Int -> KeyEvent -> ShowS)
-> (KeyEvent -> String) -> ([KeyEvent] -> ShowS) -> Show KeyEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> KeyEvent -> ShowS
showsPrec :: Int -> KeyEvent -> ShowS
$cshow :: KeyEvent -> String
show :: KeyEvent -> String
$cshowList :: [KeyEvent] -> ShowS
showList :: [KeyEvent] -> ShowS
Show, KeyEvent -> KeyEvent -> Bool
(KeyEvent -> KeyEvent -> Bool)
-> (KeyEvent -> KeyEvent -> Bool) -> Eq KeyEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: KeyEvent -> KeyEvent -> Bool
== :: KeyEvent -> KeyEvent -> Bool
$c/= :: KeyEvent -> KeyEvent -> Bool
/= :: KeyEvent -> KeyEvent -> Bool
Eq, (forall x. KeyEvent -> Rep KeyEvent x)
-> (forall x. Rep KeyEvent x -> KeyEvent) -> Generic KeyEvent
forall x. Rep KeyEvent x -> KeyEvent
forall x. KeyEvent -> Rep KeyEvent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. KeyEvent -> Rep KeyEvent x
from :: forall x. KeyEvent -> Rep KeyEvent x
$cto :: forall x. Rep KeyEvent x -> KeyEvent
to :: forall x. Rep KeyEvent x -> KeyEvent
Generic, HasCallStack => String -> KeyEvent
KeyEvent -> Bool
KeyEvent -> ()
KeyEvent -> KeyEvent
(HasCallStack => String -> KeyEvent)
-> (KeyEvent -> Bool)
-> (KeyEvent -> KeyEvent)
-> (KeyEvent -> ())
-> NFDataX KeyEvent
forall a.
(HasCallStack => String -> a)
-> (a -> Bool) -> (a -> a) -> (a -> ()) -> NFDataX a
$cdeepErrorX :: HasCallStack => String -> KeyEvent
deepErrorX :: HasCallStack => String -> KeyEvent
$chasUndefined :: KeyEvent -> Bool
hasUndefined :: KeyEvent -> Bool
$censureSpine :: KeyEvent -> KeyEvent
ensureSpine :: KeyEvent -> KeyEvent
$crnfX :: KeyEvent -> ()
rnfX :: KeyEvent -> ()
NFDataX)

type KeyEvents rows cols = Matrix rows cols (Maybe KeyEvent)

scanKeypad
    :: (KnownNat rows, KnownNat cols, IsActive rowAct, IsActive colAct, HiddenClockResetEnable dom)
    => Signal dom (Vec rows (Active rowAct))
    -> (Signal dom (Vec cols (Active colAct)), Signal dom (KeyStates rows cols))
scanKeypad :: forall (rows :: Nat) (cols :: Nat) (rowAct :: Polarity)
       (colAct :: Polarity) (dom :: Domain).
(KnownNat rows, KnownNat cols, IsActive rowAct, IsActive colAct,
 HiddenClockResetEnable dom) =>
Signal dom (Vec rows (Active rowAct))
-> (Signal dom (Vec cols (Active colAct)),
    Signal dom (KeyStates rows cols))
scanKeypad Signal dom (Vec rows (Active rowAct))
rows = ((Bool -> Active colAct)
-> Vec cols Bool -> Vec cols (Active colAct)
forall a b (n :: Nat). (a -> b) -> Vec n a -> Vec n b
map Bool -> Active colAct
forall (p :: Polarity). IsActive p => Bool -> Active p
toActive (Vec cols Bool -> Vec cols (Active colAct))
-> Signal dom (Vec cols Bool)
-> Signal dom (Vec cols (Active colAct))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom (Vec cols Bool)
forall {dom :: Domain} {n :: Nat}.
(KnownDomain dom, ?clock::Clock dom, ?reset::Reset dom,
 ?enable::Enable dom, KnownNat n) =>
Signal dom (Vec n Bool)
cols, Vec cols (Vec rows Bool) -> Vec rows (Vec cols Bool)
forall (n :: Nat) (m :: Nat) a.
KnownNat n =>
Vec m (Vec n a) -> Vec n (Vec m a)
transpose (Vec cols (Vec rows Bool) -> Vec rows (Vec cols Bool))
-> Signal dom (Vec cols (Vec rows Bool))
-> Signal dom (Vec rows (Vec cols Bool))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Unbundled dom (Vec cols (Vec rows Bool))
-> Signal dom (Vec cols (Vec rows Bool))
forall a (dom :: Domain).
Bundle a =>
Unbundled dom a -> Signal dom a
forall (dom :: Domain).
Unbundled dom (Vec cols (Vec rows Bool))
-> Signal dom (Vec cols (Vec rows Bool))
bundle Vec cols (Signal dom (Vec rows Bool))
Unbundled dom (Vec cols (Vec rows Bool))
state)
  where
    (Signal dom (Vec n Bool)
cols, Signal dom (Index n)
currentCol) = Signal dom Bool -> (Signal dom (Vec n Bool), Signal dom (Index n))
forall (n :: Nat) (dom :: Domain) a.
(KnownNat n, HiddenClockResetEnable dom) =>
Signal dom Bool -> (Signal dom (Vec n Bool), Signal dom (Index n))
roundRobin Signal dom Bool
forall {dom :: Domain}.
(KnownDomain dom, ?clock::Clock dom, ?reset::Reset dom,
 ?enable::Enable dom) =>
Signal dom Bool
nextCol
    nextCol :: Signal dom Bool
nextCol = SNat 1000 -> Signal dom Bool
forall (dom :: Domain) (n :: Nat).
HiddenClockResetEnable dom =>
SNat n -> Signal dom Bool
riseEvery (forall (n :: Nat). KnownNat n => SNat n
SNat @1000)

    state :: Vec cols (Signal dom (Vec rows Bool))
state = (Index cols -> Signal dom (Vec rows Bool))
-> Vec cols (Index cols) -> Vec cols (Signal dom (Vec rows Bool))
forall a b (n :: Nat). (a -> b) -> Vec n a -> Vec n b
map Index cols -> Signal dom (Vec rows Bool)
colState Vec cols (Index cols)
forall (n :: Nat). KnownNat n => Vec n (Index n)
indicesI
      where
        colState :: Index cols -> Signal dom (Vec rows Bool)
colState Index cols
thisCol = Vec rows Bool
-> Signal dom Bool
-> Signal dom (Vec rows Bool)
-> Signal dom (Vec rows Bool)
forall (dom :: Domain) a.
(HiddenClockResetEnable dom, NFDataX a) =>
a -> Signal dom Bool -> Signal dom a -> Signal dom a
regEn (Bool -> Vec rows Bool
forall (n :: Nat) a. KnownNat n => a -> Vec n a
repeat Bool
False) (Signal dom Bool
forall {dom :: Domain}.
(KnownDomain dom, ?clock::Clock dom, ?reset::Reset dom,
 ?enable::Enable dom) =>
Signal dom Bool
stable Signal dom Bool -> Signal dom Bool -> Signal dom Bool
forall (f :: Type -> Type).
Applicative f =>
f Bool -> f Bool -> f Bool
.&&. Signal dom (Index cols)
forall {dom :: Domain} {n :: Nat}.
(KnownDomain dom, ?clock::Clock dom, ?reset::Reset dom,
 ?enable::Enable dom, KnownNat n) =>
Signal dom (Index n)
currentCol Signal dom (Index cols) -> Index cols -> Signal dom Bool
forall a (f :: Type -> Type).
(Eq a, Functor f) =>
f a -> a -> f Bool
.== Index cols
thisCol) (Signal dom (Vec rows Bool) -> Signal dom (Vec rows Bool))
-> Signal dom (Vec rows Bool) -> Signal dom (Vec rows Bool)
forall a b. (a -> b) -> a -> b
$ (Active rowAct -> Bool)
-> Vec rows (Active rowAct) -> Vec rows Bool
forall a b (n :: Nat). (a -> b) -> Vec n a -> Vec n b
map Active rowAct -> Bool
forall (p :: Polarity). IsActive p => Active p -> Bool
fromActive (Vec rows (Active rowAct) -> Vec rows Bool)
-> Signal dom (Vec rows (Active rowAct))
-> Signal dom (Vec rows Bool)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom (Vec rows (Active rowAct))
rows

        stable :: Signal dom Bool
stable = Signal dom (Index 10)
forall {dom :: Domain}.
(KnownDomain dom, ?clock::Clock dom, ?reset::Reset dom,
 ?enable::Enable dom) =>
Signal dom (Index 10)
cnt Signal dom (Index 10) -> Index 10 -> Signal dom Bool
forall a (f :: Type -> Type).
(Eq a, Functor f) =>
f a -> a -> f Bool
.== Index 10
forall a. Bounded a => a
maxBound
        cnt :: Signal dom (Index 10)
cnt = Index 10 -> Signal dom (Index 10) -> Signal dom (Index 10)
forall (dom :: Domain) a.
(HiddenClockResetEnable dom, NFDataX a) =>
a -> Signal dom a -> Signal dom a
register (Index 10
0 :: Index 10) (Signal dom (Index 10) -> Signal dom (Index 10))
-> Signal dom (Index 10) -> Signal dom (Index 10)
forall a b. (a -> b) -> a -> b
$ Signal dom Bool
-> Signal dom (Index 10)
-> Signal dom (Index 10)
-> Signal dom (Index 10)
forall (f :: Type -> Type) a.
Applicative f =>
f Bool -> f a -> f a -> f a
mux Signal dom Bool
forall {dom :: Domain}.
(KnownDomain dom, ?clock::Clock dom, ?reset::Reset dom,
 ?enable::Enable dom) =>
Signal dom Bool
nextCol Signal dom (Index 10)
0 (Index 10 -> Index 10
forall a. (Eq a, Enum a, Bounded a) => a -> a
moreIdx (Index 10 -> Index 10)
-> Signal dom (Index 10) -> Signal dom (Index 10)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom (Index 10)
cnt)

keypadEvents
    :: (KnownNat rows, KnownNat cols, HiddenClockResetEnable dom)
    => Signal dom (KeyStates rows cols)
    -> Signal dom (KeyEvents rows cols)
keypadEvents :: forall (rows :: Nat) (cols :: Nat) (dom :: Domain).
(KnownNat rows, KnownNat cols, HiddenClockResetEnable dom) =>
Signal dom (KeyStates rows cols)
-> Signal dom (KeyEvents rows cols)
keypadEvents Signal dom (Vec rows (Vec cols Bool))
states = (Vec cols Bool -> Vec cols Bool -> Vec cols (Maybe KeyEvent))
-> Vec rows (Vec cols Bool)
-> Vec rows (Vec cols Bool)
-> Vec rows (Vec cols (Maybe KeyEvent))
forall a b c (n :: Nat).
(a -> b -> c) -> Vec n a -> Vec n b -> Vec n c
zipWith ((Bool -> Bool -> Maybe KeyEvent)
-> Vec cols Bool -> Vec cols Bool -> Vec cols (Maybe KeyEvent)
forall a b c (n :: Nat).
(a -> b -> c) -> Vec n a -> Vec n b -> Vec n c
zipWith Bool -> Bool -> Maybe KeyEvent
event) (Vec rows (Vec cols Bool)
 -> Vec rows (Vec cols Bool)
 -> Vec rows (Vec cols (Maybe KeyEvent)))
-> Signal dom (Vec rows (Vec cols Bool))
-> Signal
     dom
     (Vec rows (Vec cols Bool) -> Vec rows (Vec cols (Maybe KeyEvent)))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom (Vec rows (Vec cols Bool))
delayed Signal
  dom
  (Vec rows (Vec cols Bool) -> Vec rows (Vec cols (Maybe KeyEvent)))
-> Signal dom (Vec rows (Vec cols Bool))
-> Signal dom (Vec rows (Vec cols (Maybe KeyEvent)))
forall a b. Signal dom (a -> b) -> Signal dom a -> Signal dom b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Signal dom (Vec rows (Vec cols Bool))
states
  where
    delayed :: Signal dom (Vec rows (Vec cols Bool))
delayed = Vec rows (Vec cols Bool)
-> Signal dom (Vec rows (Vec cols Bool))
-> Signal dom (Vec rows (Vec cols Bool))
forall (dom :: Domain) a.
(HiddenClockResetEnable dom, NFDataX a) =>
a -> Signal dom a -> Signal dom a
register (Vec cols Bool -> Vec rows (Vec cols Bool)
forall (n :: Nat) a. KnownNat n => a -> Vec n a
repeat (Vec cols Bool -> Vec rows (Vec cols Bool))
-> Vec cols Bool -> Vec rows (Vec cols Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Vec cols Bool
forall (n :: Nat) a. KnownNat n => a -> Vec n a
repeat Bool
False) Signal dom (Vec rows (Vec cols Bool))
states

    event :: Bool -> Bool -> Maybe KeyEvent
event Bool
False Bool
True = KeyEvent -> Maybe KeyEvent
forall a. a -> Maybe a
Just KeyEvent
Pressed
    event Bool
True Bool
False = KeyEvent -> Maybe KeyEvent
forall a. a -> Maybe a
Just KeyEvent
Released
    event Bool
_ Bool
_ = Maybe KeyEvent
forall a. Maybe a
Nothing

pressedKeys :: Matrix rows cols a -> KeyEvents rows cols  -> Matrix rows cols (Maybe a)
pressedKeys :: forall (rows :: Nat) (cols :: Nat) a.
Matrix rows cols a
-> KeyEvents rows cols -> Matrix rows cols (Maybe a)
pressedKeys = (Vec cols a -> Vec cols (Maybe KeyEvent) -> Vec cols (Maybe a))
-> Vec rows (Vec cols a)
-> Vec rows (Vec cols (Maybe KeyEvent))
-> Vec rows (Vec cols (Maybe a))
forall a b c (n :: Nat).
(a -> b -> c) -> Vec n a -> Vec n b -> Vec n c
zipWith ((a -> Maybe KeyEvent -> Maybe a)
-> Vec cols a -> Vec cols (Maybe KeyEvent) -> Vec cols (Maybe a)
forall a b c (n :: Nat).
(a -> b -> c) -> Vec n a -> Vec n b -> Vec n c
zipWith a -> Maybe KeyEvent -> Maybe a
forall {a}. a -> Maybe KeyEvent -> Maybe a
decode)
  where
    decode :: a -> Maybe KeyEvent -> Maybe a
decode a
mapping (Just KeyEvent
Pressed) = a -> Maybe a
forall a. a -> Maybe a
Just a
mapping
    decode a
_ Maybe KeyEvent
_ = Maybe a
forall a. Maybe a
Nothing

firstJust2D :: (KnownNat rows, KnownNat cols) => Matrix (rows + 1) (cols + 1) (Maybe a) -> Maybe a
firstJust2D :: forall (rows :: Nat) (cols :: Nat) a.
(KnownNat rows, KnownNat cols) =>
Matrix (rows + 1) (cols + 1) (Maybe a) -> Maybe a
firstJust2D = (Maybe a -> Maybe a -> Maybe a)
-> Vec (rows + 1) (Maybe a) -> Maybe a
forall (n :: Nat) a. (a -> a -> a) -> Vec (n + 1) a -> a
fold Maybe a -> Maybe a -> Maybe a
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: Type -> Type) a. MonadPlus m => m a -> m a -> m a
mplus (Vec (rows + 1) (Maybe a) -> Maybe a)
-> (Vec (rows + 1) (Vec (cols + 1) (Maybe a))
    -> Vec (rows + 1) (Maybe a))
-> Vec (rows + 1) (Vec (cols + 1) (Maybe a))
-> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vec (cols + 1) (Maybe a) -> Maybe a)
-> Vec (rows + 1) (Vec (cols + 1) (Maybe a))
-> Vec (rows + 1) (Maybe a)
forall a b (n :: Nat). (a -> b) -> Vec n a -> Vec n b
map ((Maybe a -> Maybe a -> Maybe a)
-> Vec (cols + 1) (Maybe a) -> Maybe a
forall (n :: Nat) a. (a -> a -> a) -> Vec (n + 1) a -> a
fold Maybe a -> Maybe a -> Maybe a
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: Type -> Type) a. MonadPlus m => m a -> m a -> m a
mplus)

inputKeypad
    :: (KnownNat rows, KnownNat cols, IsActive rowAct, IsActive colAct)
    => (HiddenClockResetEnable dom, KnownNat (ClockDivider dom (Milliseconds 5)))
    => Matrix (rows + 1) (cols + 1) a
    -> Signal dom (Vec (rows + 1) (Active rowAct))
    -> (Signal dom (Vec (cols + 1) (Active colAct)), Signal dom (Maybe a))
inputKeypad :: forall (rows :: Nat) (cols :: Nat) (rowAct :: Polarity)
       (colAct :: Polarity) (dom :: Domain) a.
(KnownNat rows, KnownNat cols, IsActive rowAct, IsActive colAct,
 HiddenClockResetEnable dom,
 KnownNat (ClockDivider dom (Milliseconds 5))) =>
Matrix (rows + 1) (cols + 1) a
-> Signal dom (Vec (rows + 1) (Active rowAct))
-> (Signal dom (Vec (cols + 1) (Active colAct)),
    Signal dom (Maybe a))
inputKeypad Matrix (rows + 1) (cols + 1) a
keymap Signal dom (Vec (rows + 1) (Active rowAct))
rows = (Signal dom (Vec (cols + 1) (Active colAct))
cols, Signal dom (Maybe a)
pressedKey)
  where
    (Signal dom (Vec (cols + 1) (Active colAct))
cols, Signal dom (KeyStates (rows + 1) (cols + 1))
keyState) = Signal dom (Vec (rows + 1) (Active rowAct))
-> (Signal dom (Vec (cols + 1) (Active colAct)),
    Signal dom (KeyStates (rows + 1) (cols + 1)))
forall (rows :: Nat) (cols :: Nat) (rowAct :: Polarity)
       (colAct :: Polarity) (dom :: Domain).
(KnownNat rows, KnownNat cols, IsActive rowAct, IsActive colAct,
 HiddenClockResetEnable dom) =>
Signal dom (Vec rows (Active rowAct))
-> (Signal dom (Vec cols (Active colAct)),
    Signal dom (KeyStates rows cols))
scanKeypad Signal dom (Vec (rows + 1) (Active rowAct))
rows
    events :: Signal dom (KeyEvents (rows + 1) (cols + 1))
events = Signal dom (KeyStates (rows + 1) (cols + 1))
-> Signal dom (KeyEvents (rows + 1) (cols + 1))
forall (rows :: Nat) (cols :: Nat) (dom :: Domain).
(KnownNat rows, KnownNat cols, HiddenClockResetEnable dom) =>
Signal dom (KeyStates rows cols)
-> Signal dom (KeyEvents rows cols)
keypadEvents (Signal dom (KeyStates (rows + 1) (cols + 1))
 -> Signal dom (KeyEvents (rows + 1) (cols + 1)))
-> (Signal dom (KeyStates (rows + 1) (cols + 1))
    -> Signal dom (KeyStates (rows + 1) (cols + 1)))
-> Signal dom (KeyStates (rows + 1) (cols + 1))
-> Signal dom (KeyEvents (rows + 1) (cols + 1))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SNat (Picoseconds 5000000000)
-> KeyStates (rows + 1) (cols + 1)
-> Signal dom (KeyStates (rows + 1) (cols + 1))
-> Signal dom (KeyStates (rows + 1) (cols + 1))
forall (ps :: Nat) a (dom :: Domain).
(Eq a, NFDataX a, HiddenClockResetEnable dom,
 KnownNat (ClockDivider dom ps)) =>
SNat ps -> a -> Signal dom a -> Signal dom a
debounce (forall (n :: Nat). KnownNat n => SNat n
SNat @(Milliseconds 5)) (Vec (cols + 1) Bool -> KeyStates (rows + 1) (cols + 1)
forall (n :: Nat) a. KnownNat n => a -> Vec n a
repeat (Vec (cols + 1) Bool -> KeyStates (rows + 1) (cols + 1))
-> (Bool -> Vec (cols + 1) Bool)
-> Bool
-> KeyStates (rows + 1) (cols + 1)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Vec (cols + 1) Bool
forall (n :: Nat) a. KnownNat n => a -> Vec n a
repeat (Bool -> KeyStates (rows + 1) (cols + 1))
-> Bool -> KeyStates (rows + 1) (cols + 1)
forall a b. (a -> b) -> a -> b
$ Bool
False) (Signal dom (KeyStates (rows + 1) (cols + 1))
 -> Signal dom (KeyEvents (rows + 1) (cols + 1)))
-> Signal dom (KeyStates (rows + 1) (cols + 1))
-> Signal dom (KeyEvents (rows + 1) (cols + 1))
forall a b. (a -> b) -> a -> b
$ Signal dom (KeyStates (rows + 1) (cols + 1))
keyState
    pressedKey :: Signal dom (Maybe a)
pressedKey = Matrix (rows + 1) (cols + 1) (Maybe a) -> Maybe a
forall (rows :: Nat) (cols :: Nat) a.
(KnownNat rows, KnownNat cols) =>
Matrix (rows + 1) (cols + 1) (Maybe a) -> Maybe a
firstJust2D (Matrix (rows + 1) (cols + 1) (Maybe a) -> Maybe a)
-> (KeyEvents (rows + 1) (cols + 1)
    -> Matrix (rows + 1) (cols + 1) (Maybe a))
-> KeyEvents (rows + 1) (cols + 1)
-> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Matrix (rows + 1) (cols + 1) a
-> KeyEvents (rows + 1) (cols + 1)
-> Matrix (rows + 1) (cols + 1) (Maybe a)
forall (rows :: Nat) (cols :: Nat) a.
Matrix rows cols a
-> KeyEvents rows cols -> Matrix rows cols (Maybe a)
pressedKeys Matrix (rows + 1) (cols + 1) a
keymap (KeyEvents (rows + 1) (cols + 1) -> Maybe a)
-> Signal dom (KeyEvents (rows + 1) (cols + 1))
-> Signal dom (Maybe a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal dom (KeyEvents (rows + 1) (cols + 1))
events