]> Git — Sourcephile - tmp/julm/arpeggigon.git/blob - src/RMCA/Auxiliary/Auxiliary.hs
Deleted 'Unknown' directory.
[tmp/julm/arpeggigon.git] / src / 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,_) 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 returnA -< makeEvent x x'
29
30 -- Similar to onChange but contains its initial value in the first
31 -- event.
32 onChange' :: (Eq a) => SF a (Event a)
33 onChange' = proc x -> do
34 x' <- stepBack -< x
35 returnA -< makeEvent x x'
36
37 makeEvent :: (Eq a) => a -> Maybe a -> Event a
38 makeEvent x x'
39 | isNothing x' = Event x
40 | otherwise = let x'' = fromJust x' in
41 if x'' == x then NoEvent else Event x
42
43 discard :: a -> ()
44 discard _ = ()
45
46 bound :: (Ord a) => (a, a) -> a -> a
47 bound (min, max) x
48 | x < min = min
49 | x > max = max
50 | otherwise = x