Commit 10b420a9 by Guerric Chupin

System producing notes but no sound.

parent f633d863
......@@ -513,7 +513,7 @@ runRMCA bd bpb mri tr st
\least 1 bar."
| otherwise = error "The number of beats per bar must be at least 1."
where
nss = runAux 1 []--(startHeads bd)
nss = runAux 1 (startHeads bd)
runAux bn phs = ns : runAux (nextBeatNo bpb bn) phs'
where
......
......@@ -26,7 +26,8 @@ boardAction ph = proc ((board, Layer { relPitch = rp
, strength = s
, beatsPerBar = bpb
}), ebno) -> do
e <- arr $ fmap (uncurry5 $ advanceHeads) -< ebno `tag` (board, fromEvent ebno, rp, s, ph)
e <- arr $ fmap (uncurry5 $ advanceHeads)
-< ebno `tag` (board, fromEvent ebno, rp, s, ph)
returnA -< traceShow e e
{-
boardSF :: SF (Board, Layer, Tempo) (Event [Note])
......@@ -39,13 +40,14 @@ boardSF = proc (board, l, t) -> do
boardSF'
-}
boardSF :: SF (Board, Layer, Tempo) (Event [Note])
boardSF = proc (board, l@Layer { relPitch = rp
, strength = s
}, t) -> do
-- We need the list of initial playheads
boardSF :: [PlayHead] -> SF (Board, Layer, Tempo) (Event [Note])
boardSF iph = proc (board, l@Layer { relPitch = rp
, strength = s
}, t) -> do
ebno <- layerMetronome -< (t,l)
--iph <- arr startHeads -< board
boardSF' [] -< ((board, l), ebno)
boardSF' iph -< ((board, l), ebno)
where
boardSF' :: [PlayHead] -> SF ((Board, Layer), Event BeatNo) (Event [Note])
boardSF' ph = switch (boardAction ph >>> arr splitE >>> arr swap)
......
......@@ -60,7 +60,7 @@ main = do
tempo <- reactiveValueRead tempoRV
boardRV <- boardRVIO
board <- reactiveValueRead boardRV
(inBoard, outBoard) <- yampaReactiveDual (board, layer, tempo) boardSF
(inBoard, outBoard) <- yampaReactiveDual (board, layer, tempo) (boardSF $ startHeads board)
let inRV = liftRW2 (bijection (\(x,y,z) -> (x,(y,z)), \(x,(y,z)) -> (x,y,z)))
boardRV $ pairRW layerRV tempoRV
clock <- mkClockRV 100
......
......@@ -443,7 +443,7 @@ startHeads bd =
-- later) and possibly a note to be played at *this* beat.
advanceHead :: Board -> BeatNo -> RelPitch -> Strength -> PlayHead
-> ([PlayHead], Maybe Note)
-> ([PlayHead], Maybe Note)
advanceHead bd bn tr st ph = ahAux (moveHead bd ph)
where
ahAux ph@PlayHead {phPos = p, phBTM = btm, phDir = d} =
......
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