src/RMCA/Auxiliary/Yampa.hs

   1 {-# LANGUAGE Arrows #-}
   2
   3 module RMCA.Auxiliary.Yampa where
   4
   5 import FRP.Yampa
   6 import Data.Maybe
   7 import RMCA.Auxiliary.Misc
   8
   9 -- | = Yampa
  10
  11 countTo :: (Integral b) => b -> SF (Event a) (Event b)
  12 countTo n = count >>^ filterE (== n)
  13
  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)
  20
  21 -- | Like 'stepBack' but the output value is always defined and is equal to the input at time 0.
  22 stepBack' :: SF a a
  23 stepBack' = proc x -> do
  24   x' <- stepBack -< x
  25   returnA -< fromMaybe x x'
  26
  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
  30   x' <- stepBack -< x
  31   let makeEvent x x'
  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'
  36
  37 -- | Similar to 'onChange' but contains its initial value in the first
  38 -- event.
  39 onChange' :: (Eq a) => SF a (Event a)
  40 onChange' = proc x -> do
  41   x' <- stepBack -< x
  42   -- If it's the first value, throw an Event, else behave like onChange.
  43   let makeEvent x x'
  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'
  48
  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
  56           returnA -< (it,es)
  57
  58
  59
  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/)
  63
  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*)
  68
  69 repeatedlyS' :: a -> SF DTime (Event a)
  70 repeatedlyS' x = (repeatedlyS x &&& now x) >>> arr (uncurry lMerge)
  71
  72 -- |
  73 -- = Curry and uncurry functions