RMCA/Auxiliary/Auxiliary.hs

   1 {-# LANGUAGE Arrows #-}
   2
   3 module RMCA.Auxiliary.Auxiliary where
   4
   5 import Data.Maybe
   6 import FRP.Yampa
   7
   8 -- stepBack contains its previous argument as its output. Because it's
   9 -- hard to define it at time 0, it's wrapped up in a Maybe.
  10 stepBack :: SF a (Maybe a)
  11 stepBack = sscan f (Nothing, Nothing) >>^ snd
  12   where f :: (Maybe a, Maybe a) -> a -> (Maybe a, Maybe a)
  13         f (Nothing,Nothing) x' = (Just x', Nothing)
  14         f (Just x, _) x' = (Just x', Just x)
  15
  16 -- Just like stepBack but the output value is always defined and is
  17 -- equal to the input at time 0.
  18 stepBack' :: SF a a
  19 stepBack' = proc x -> do
  20   x' <- stepBack -< x
  21   returnA -< fromMaybe x x'
  22
  23 -- Throws an Event when the incoming signal change. The Event is
  24 -- tagged with the new value.
  25 onChange :: (Eq a) => SF a (Event a)
  26 onChange = proc x -> do
  27   x' <- stepBack -< x
  28   let makeEvent x x'
  29         | isNothing x' = NoEvent
  30         | isJust x' = let x'' = fromJust x' in
  31             if x'' == x then NoEvent else Event x
  32   returnA -< makeEvent x x'
  33
  34 -- Similar to onChange but contains its initial value in the first
  35 -- event.
  36 onChange' :: (Eq a) => SF a (Event a)
  37 onChange' = proc x -> do
  38   x' <- stepBack -< x
  39   -- If it's the first value, throw an Event, else behave like onChange.
  40   let makeEvent x x'
  41         | isNothing x' = Event x
  42         | isJust x' = let x'' = fromJust x' in
  43             if x'' == x then NoEvent else Event x
  44   returnA -< makeEvent x x'
  45
  46 discard :: a -> ()
  47 discard _ = ()
  48
  49 bound :: (Ord a) => (a, a) -> a -> a
  50 bound (min, max) x
  51   | x < min = min
  52   | x > max = max
  53   | otherwise = x