1 {-# LANGUAGE Arrows #-}
3 module RMCA.Auxiliary.Yampa where
7 import RMCA.Auxiliary.Misc
11 countTo :: (Integral b) => b -> SF (Event a) (Event b)
12 countTo n = count >>^ filterE (> n)
14 -- | 'stepBack' contains its previous argument as its output. Because it's hard to define it at time 0, it's wrapped up in a 'Maybe'.
15 stepBack :: SF a (Maybe a)
16 stepBack = sscan f (Nothing, Nothing) >>^ snd
17 where f :: (Maybe a, Maybe a) -> a -> (Maybe a, Maybe a)
18 f (Nothing,_) x' = (Just x', Nothing)
19 f (Just x, _) x' = (Just x', Just x)
21 -- | Like 'stepBack' but the output value is always defined and is equal to the input at time 0.
23 stepBack' = proc x -> do
25 returnA -< fromMaybe x x'
27 -- | Throws an 'Event' when the incoming signal change. The 'Event' is tagged with the new value.
28 onChange :: (Eq a) => SF a (Event a)
29 onChange = proc x -> do
32 | isNothing x' = NoEvent
33 | otherwise = let x'' = fromJust x' in
34 if x'' == x then NoEvent else Event x
35 returnA -< makeEvent x x'
37 -- | Similar to 'onChange' but contains its initial value in the first
39 onChange' :: (Eq a) => SF a (Event a)
40 onChange' = proc x -> do
42 -- If it's the first value, throw an Event, else behave like onChange.
44 | isNothing x' = Event x
45 | otherwise = let x'' = fromJust x' in
46 if x'' == x then NoEvent else Event x
47 returnA -< makeEvent x x'
49 -- | Integrates some variable modulo something.
50 integralMod :: (Real a, VectorSpace a s) => a -> SF a a
51 integralMod x = intMod' 0
52 where intMod' x0 = switch (intMod'' x0) (\y -> intMod' (y - x))
53 intMod'' x0 = proc t -> do
54 it <- (+ x0) ^<< integral -< t
55 es <- edgeBy (\_ y -> maybeIf (y > x) $> y) 0 -< it
60 -- | Generates a sine function whose period is given as a varying input.
61 varFreqSine :: SF DTime Double
62 varFreqSine = sin ^<< (2*pi*) ^<< integralMod 1 <<^ (1/)
64 -- | Generates an 'Event' with a regular period, which is given as an input to the signal function.
65 repeatedlyS :: a -> SF DTime (Event a)
66 repeatedlyS x = edgeBy (\a b -> maybeIf (a * b < 0) $> x) 0
67 <<< varFreqSine <<^ (2*)
70 -- = Curry and uncurry functions