Commit 3a527871 authored by Guerric Chupin's avatar Guerric Chupin

Beginning of a reactive board and work on metronomes.

Changed the way layer metronomes work (they know produce Event
BeatNo), this takes into account the change induced by the layer. The
board is now able to produce notes event but work needs to be done to
be able to interface it properly with the rest of the system.
parent cf0a9356
module Reactogon.Global.Clock where
module Reactogon.Global.Clock ( tempo
, metronome
, tempoToDTime
) where
import Reactogon.Auxiliary.Auxiliary
import Reactogon.Semantics
......@@ -11,15 +14,14 @@ tempo = constant
-- The initial value is arbitrary but never appears because the switch
-- is immediate.
metronome :: SF () Tempo -> SF () (Event Beat)
metronome tempo = switch ((repeatedly (tempoToDTime 60) ())
&&&
(discard ^>> tempo >>> onChange')) (metronome' tempo)
where metronome' :: SF () Tempo -> Tempo -> SF () (Event Beat)
metronome' tempo t = (switch ((repeatedly (tempoToDTime t) ())
&&&
(discard ^>> tempo >>> onChange))
(metronome' tempo))
metronome :: SF Tempo (Event Beat)
metronome = switch ((repeatedly (tempoToDTime 60) ())
&&&
(onChange')) (metronome')
where metronome' :: Tempo -> SF Tempo (Event Beat)
metronome' t = (switch ((repeatedly (tempoToDTime t) ())
&&&
onChange) (metronome'))
tempoToDTime :: Tempo -> DTime
tempoToDTime = (60/) . fromIntegral
{-# LANGUAGE Arrows #-}
module Reactogon.Layer.Board where
import FRP.Yampa
import Reactogon.Layer.Layer
import Reactogon.Semantics
-- The state of the board is described by the list of the playheads
-- and the different actions onto the board.
-- It can then be modified discretly when a beat is received or
-- continuously when the user acts on it.
boardAction :: Board
-> SF (Layer, [PlayHead], Event BeatNo)
(Event ([PlayHead], [Note]))
boardAction board = proc (Layer { relPitch = rp
, strength = s
, beatsPerBar = bpb
}, pl, ebn) -> do
ahSF <<^ arr propEvent -< (ebn, rp, s, pl)
where
uncurry4 :: (a -> b -> c -> d -> e) -> (a,b,c,d) -> e
uncurry4 f (a,b,c,d) = f a b c d
ahSF :: SF (Event (BeatNo, RelPitch, Strength, [PlayHead]))
(Event ([PlayHead], [Note]))
ahSF = arr $ fmap (uncurry4 $ advanceHeads board)
propEvent (a,b,c,d) = if isEvent a then Event (fromEvent a,b,c,d) else NoEvent
{-# LANGUAGE Arrows #-}
{-# LANGUAGE Arrows, TupleSections #-}
module Reactogon.Layer.Layer where
import Reactogon.Beat
import Reactogon.Semantics
import Reactogon.Global.Clock
import FRP.Yampa
-- Data representing the state of a layer. It is updated continuously.
data Layer = Layer { relTempo :: Double
, strength :: Strength
data Layer = Layer { relTempo :: Double
, relPitch :: RelPitch
, strength :: Strength
, beatsPerBar :: BeatsPerBar
, beatCounter :: BeatNo
}
layerTempo :: SF () Tempo -> SF Layer Tempo
layerTempo globalTempo = proc Layer { relTempo = r } -> do
t <- tempo -< ()
layerTempo :: SF (Tempo, Layer) Tempo
layerTempo = proc (t, Layer { relTempo = r }) -> do
returnA -< floor $ r * fromIntegral t
layerMetronome :: SF () Tempo -> SF () (Event Beat)
layerMetronome tempo = layerTempo tempo >>> metronome
-- The layer is modified after the beat as been
layerMetronome :: SF (Tempo, Layer) (Event (BeatNo, Layer))
layerMetronome = proc (t, l@Layer { beatCounter = b , beatsPerBar = bpb}) -> do
eb <- metronome <<< layerTempo -< (t, l)
returnA -< eb `tag` let nb = nextBeatNo b bpb in (nb, l { beatCounter = nb })
-- A layer is a producer of events triggered by the system beat clock.
layer :: SF () (Event Beat) -> SF Layer (Event Note)
......
......@@ -469,7 +469,7 @@ advanceHeads bd bn tr st phs =
-- note received for the layer (derived from its MIDI velocity).
runRMCA :: Board -> BeatsPerBar -> RelPitch -> Strength -> [PlayHead]
-> [[Note]]
-> [[Note]]
runRMCA _ _ _ _ [] = []
runRMCA bd bpb tr st phs = runAux 1 phs
where
......
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