Commit 1b1d1a97 by Guerric Chupin

Changed maybeIf/eventIf with guard.

parent bef57335
......@@ -25,33 +25,25 @@ fromMaybeM_ :: (Monad m) => Maybe (m ()) -> m ()
fromMaybeM_ = fromMaybe (return ())
safeHead :: [a] -> Maybe a
safeHead [] = Nothing
safeHead [] = Nothing
safeHead (x:_) = Just x
safeTail :: [a] -> [a]
safeTail [] = []
safeTail [] = []
safeTail (_:xs) = xs
maybeToEvent :: Maybe a -> Event a
maybeToEvent Nothing = NoEvent
maybeToEvent Nothing = NoEvent
maybeToEvent (Just x) = Event x
eventToMaybe :: Event a -> Maybe a
eventToMaybe NoEvent = Nothing
eventToMaybe NoEvent = Nothing
eventToMaybe (Event x) = Just x
eventToList :: Event [a] -> [a]
eventToList NoEvent = []
eventToList NoEvent = []
eventToList (Event x) = x
-- | Generates an 'Event' if the given condition is 'True'.
eventIf :: Bool -> Event ()
eventIf b = if b then Event () else NoEvent
-- | Generates a 'Just' value if the given condition is 'True'.
maybeIf :: Bool -> Maybe ()
maybeIf b = if b then Just () else Nothing
curry3 :: ((a,b,c) -> d) -> a -> b -> c -> d
curry3 f a b c = f (a,b,c)
......
......@@ -5,6 +5,7 @@ module RMCA.Auxiliary.Yampa where
import FRP.Yampa
import Data.Maybe
import RMCA.Auxiliary.Misc
import Control.Monad
-- | = Yampa
......@@ -81,7 +82,7 @@ integralMod x = intMod' 0
where intMod' x0 = switch (intMod'' x0) (\y -> intMod' (y - x))
intMod'' x0 = proc t -> do
it <- (+ x0) ^<< integral -< t
es <- edgeBy (\_ y -> maybeIf (y > x) $> y) 0 -< it
es <- edgeBy (\_ y -> guard (y > x) $> y) 0 -< it
returnA -< (it,es)
......@@ -92,7 +93,7 @@ varFreqSine = sin ^<< (2*pi*) ^<< integralMod 1 <<^ (1/)
-- | Generates an 'Event' with a regular period, which is given as an input to the signal function.
repeatedlyS :: a -> SF DTime (Event a)
repeatedlyS x = edgeBy (\a b -> maybeIf (a * b < 0) $> x) 0
repeatedlyS x = edgeBy (\a b -> guard (a * b < 0) $> x) 0
<<< varFreqSine <<^ (2*)
repeatedlyS' :: a -> SF DTime (Event a)
......
......@@ -2,6 +2,7 @@
module RMCA.Layer.Board where
import Control.Monad
import qualified Data.IntMap as M
import Data.List ((\\))
import FRP.Yampa
......@@ -21,8 +22,8 @@ layerMetronome StaticLayerConf { beatsPerBar = bpb
ewbno <- accumFilter (\_ (ab,r) -> ((),selectBeat (ab,r))) () -< (,r) <$> eb
accumBy (flip nextBeatNo) 0 -< ewbno `tag` bpb
where selectBeat (absBeat, layBeat) =
maybeIf ((absBeat - 1) `mod`
floor (fromIntegral maxAbsBeat * layBeat) == 0)
guard ((absBeat - 1) `mod`
floor (fromIntegral maxAbsBeat * layBeat) == 0)
automaton :: [PlayHead]
-> SF (Board, DynLayerConf, Event BeatNo)
......@@ -60,7 +61,7 @@ layer = layerStopped
enphs@(_,phs) <- automaton iphs -< (b, dlc, ebno)
r <- (case repeatCount slc of
Nothing -> never
Just n -> countTo (1 + n * beatsPerBar slc)) -< ebno
Just n -> countTo (1 + n * beatsPerBar slc)) -< ebno
erun <- waitForEvent -< (filterE (== Running) ers,ebno)
estop <- arr $ filterE (/= Running) -< ers
let ers' = erun `lMerge` estop
......@@ -81,9 +82,9 @@ layers imap = proc (t,erun,map) -> do
newMetronome Stopped = never
erun' <- accumFilter (\oRS nRS ->
case (oRS,nRS) of
(Stopped,_) -> (nRS,Just nRS)
(Stopped,_) -> (nRS,Just nRS)
(Running, Stopped) -> (Stopped,Just Stopped)
_ -> (oRS,Nothing)) Stopped -< erun
_ -> (oRS,Nothing)) Stopped -< erun
eabs <- rSwitch metronome -< (t, newMetronome <$> erun')
rpSwitch routing (imap $> layer) -< ((eabs,erun,map),e)
where routing (eabs,erun,map) sfs = M.intersectionWith (,)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment