module FRP.Timeless.Prefab.Discrete
(
occursFor
, impulse
, oneShot
, snapOnce
, inhibitsAfterPeriods
, runAndHold
, rising
, falling
, edge
, latch
, latchS
, latchR
)
where
import Control.Arrow
import Control.Applicative
import Data.Monoid
import Control.Monad
import Control.Monad.IO.Class
import FRP.Timeless.Signal
import FRP.Timeless.Prefab.Primitive
occursFor :: (Monad m) => b
-> Int
-> Signal s m a b
occursFor b n = mkConst (Just b) >>> inhibitsAfterPeriods n
impulse :: (Monad m) => b -> Signal s m a b
impulse b = b `occursFor` 1
oneShot :: (Monad m) => b -> Signal s m a b
oneShot = impulse
snapOnce :: (Monad m) => Signal s m a a
snapOnce = SGen $ \_ ma -> return (ma, SConst ma)
inhibitsAfterPeriods :: Int -> Signal s m a a
inhibitsAfterPeriods n
| n == 0 = mkEmpty
| n > 0 = mkPureN $ \a -> (Just a, inhibitsAfterPeriods $ n1)
| otherwise = error "[ERROR] inhibitsAfter: Nothing will inhibit in the past!"
runAndHold :: (Monad m) =>
Signal s m a b
-> Signal s m a b
runAndHold sig = inhibitsAfterPeriods 1 >>> sig >>> snapOnce
rising :: (Monad m) =>
Bool
-> Signal s m Bool Bool
rising b0 = mkSFN $ f b0
where
f False b = (b, rising b)
f True b = (False, rising b)
falling :: (Monad m) =>
Bool
-> Signal s m Bool Bool
falling b0 = mkSFN $ f b0
where
f False b = (False, rising b)
f True b = (not b, rising b)
edge :: (Monad m) =>
Bool
-> Signal s m Bool Bool
edge b0 = proc b -> do
b'1 <- rising b0 -< b
b'2 <- falling b0 -< b
returnA -< b'1 || b'2
latch :: (Monad m) =>
Bool
-> Signal s m (Bool, Bool) Bool
latch b0 = mkSFN $ f b0
where
f False (True, False) = (True, latch True)
f True (False, True) = (False, latch False)
f b0 (_, _) = (b0, latch b0)
latchS :: (Monad m) => Signal s m Bool Bool
latchS = proc s -> do
returnA <<< latch False -< (s, False)
latchR :: (Monad m) => Signal s m Bool Bool
latchR = proc s -> do
returnA <<< latch True -< (False, s)