module FRP.Moe.Combinators where
import Prelude hiding (cycle)
import FRP.Moe.Core
import Control.Arrow
import System.Random
sfConst :: a -> SF b a
sfConst x = arr (const x)
time :: SF () Double
time = sfConst 1 >>> integral
noise :: (Random a, RandomGen b) => b -> SF () a
noise g0 = proc () -> do rec let (x, g') = random g
g <- delay g0 -< g'
returnA -< x
noiseR :: (Random a, RandomGen b) => (a, a) -> b -> SF () a
noiseR lh g0 = proc () -> do rec let (x, g') = randomR lh g
g <- delay g0 -< g'
returnA -< x
rep :: Int -> SF a a -> SF a a
rep 0 sf = arr (\x -> x)
rep n sf = sf >>> rep (n 1) sf
cycle :: [a] -> SF () a
cycle [] = error "Cycle: list is empty."
cycle xs = proc () -> do rec let (y : ys) = zs
zs <- delay xs -< case ys of
[] -> xs
_ -> ys
returnA -< y
timedCycle :: [(DTime, a)] -> SF () a
timedCycle [] = error "TimedCycle: list is empty."
timedCycle txs = auxCycle txs where
auxCycle ((timeOut, x) : txs') = dswitch aux (\_ -> if null txs'
then auxCycle txs
else auxCycle txs') where
aux = proc () -> do t <- time -< ()
returnA -< (x, if t > timeOut
then Event ()
else NoEvent)
data MemOp a = Read | Write a
memory :: a -> SF (MemOp a) a
memory x0 = proc op -> do rec let y = case op of
Read -> z
Write y' -> y'
z <- delay x0 -< y
returnA -< y
stateful :: (a -> a) -> a -> SF () a
stateful f x0 = proc () -> do rec let z = f y
y <- delay x0 -< z
returnA -< y
stateful2 :: (a -> b -> a) -> a -> SF b a
stateful2 f x0 = proc i -> do rec let z = f y i
y <- delay x0 -< z
returnA -< y
integral :: SF Double Double
integral = proc x -> do dt <- dTime -< ()
rec let y = i + x * dt
i <- delay 0 -< y
returnA -< i
broadcast :: Functor col => col sf -> a -> col (a, sf)
broadcast sfs x = fmap ((,) x) sfs