Playheads and notes are correct.

diff --git a/CLOC.md b/CLOC.md
index e35a774462156a1ddb92138dd03056d1104ac415..76709f847d7727209786ab302db4d10eb986c274 100644 (file)
--- a/CLOC.md
+++ b/CLOC.md
@@ -1,9 +1,9 @@
 
-cloc|https://github.com/AlDanial/cloc v 1.66  T=0.07 s (375.7 files/s, 27369.1 lines/s)
+cloc|https://github.com/AlDanial/cloc v 1.66  T=0.06 s (404.7 files/s, 32964.5 lines/s)
 --- | ---
 
 Language|files|blank|comment|code
 :-------|-------:|-------:|-------:|-------:
-Haskell|25|299|393|1129
+Haskell|26|335|430|1353
 --------|--------|--------|--------|--------
-SUM:|25|299|393|1129
+SUM:|26|335|430|1353

diff --git a/RMCA/GUI/Board.hs b/RMCA/GUI/Board.hs
index dad3c76a0912efeba3e3fb93cbc071685fa83c72..c9cf0297a605b78eef14afb4cba1569b872f9ba0 100644 (file)
--- a/RMCA/GUI/Board.hs
+++ b/RMCA/GUI/Board.hs
@@ -184,11 +184,11 @@ initBoardRV board@BIO.Board { boardPieces = gBoard@(GameBoard array) } = do
 
       setterP :: [PlayHead] -> IO ()
       setterP lph = do
-        let phPosS = map phPos lph
         readCBMVar phMVar >>= writeCBMVar oldphMVar
-        oph <- readCBMVar oldphMVar
         writeCBMVar phMVar lph
-        let offPh :: PlayHead -> IO ()
+        oph <- readCBMVar oldphMVar
+        let phPosS = map phPos lph
+            offPh :: PlayHead -> IO ()
             offPh ph = do
               let pos = toGUICoords $ phPos ph
               piece <- boardGetPiece pos board
@@ -203,9 +203,7 @@ initBoardRV board@BIO.Board { boardPieces = gBoard@(GameBoard array) } = do
                 let (_,c) = fromJust piece
                 boardSetPiece pos (Player, c { asPh = True }) board
         mapM_ offPh oph
-        print oph
         mapM_ onPh lph
-        print lph
 
       notifierP :: IO () -> IO ()
       notifierP = installCallbackCBMVar phMVar

diff --git a/RMCA/Layer/Board.hs b/RMCA/Layer/Board.hs
index 5a3e8259cd60209f65b70955abc5f0e477b3bb5a..7cc8c26d38feb2d2c15660ff297ccbdf301774f0 100644 (file)
--- a/RMCA/Layer/Board.hs
+++ b/RMCA/Layer/Board.hs
@@ -19,7 +19,8 @@ import Debug.Trace
 
 -- The state of the board is described by the list of the playheads
 -- and the different actions onto the board.
-boardAction :: SF ((Board, Layer, [PlayHead]), Event BeatNo) (Event ([PlayHead], [Note]))
+boardAction :: SF ((Board, Layer, [PlayHead]), Event BeatNo)
+               (Event ([PlayHead], [Note]))
 boardAction = proc ((board, Layer { relPitch    = rp
                                   , strength    = s
                                   , beatsPerBar = bpb

diff --git a/RMCA/Main.hs b/RMCA/Main.hs
index 208f95bb21b67d2dfeee131dfd7d155e6fe8526d..1310ad43b1a0b454cb8d58bcb500c10599fe6cb3 100644 (file)
--- a/RMCA/Main.hs
+++ b/RMCA/Main.hs
@@ -159,6 +159,7 @@ main = do
   buttonPause <- buttonNewFromStock gtkMediaPause
   boxPackStart buttonBox buttonPause PackRepel 0
   buttonStop <- buttonNewFromStock gtkMediaStop
+  let stopRV = buttonActivateField buttonStop
   boxPackStart buttonBox buttonStop PackRepel 0
   buttonRecord <- buttonNewFromStock gtkMediaRecord
   boxPackStart buttonBox buttonRecord PackRepel 0
@@ -180,11 +181,10 @@ main = do
   (boardRV, phRV) <- initBoardRV guiBoard
   reactiveValueOnCanRead playRV
     (reactiveValueRead boardRV >>= reactiveValueWrite phRV . startHeads)
+  reactiveValueOnCanRead stopRV $ reactiveValueWrite phRV []
   board <- reactiveValueRead boardRV
   ph <- reactiveValueRead phRV
   (inBoard, outBoard) <- yampaReactiveDual (board, layer, ph, tempo) boardSF
-  (splitE >>> fst) <^> outBoard >:> phRV
-  --reactiveValueOnCanRead phRV $ boardRefresh guiBoard
   let inRV = liftR4 id
              boardRV layerRV phRV tempoRV
   clock <- mkClockRV 100
@@ -194,10 +194,10 @@ main = do
     bq <- reactiveValueRead boardQueue
     ob <- reactiveValueRead $ liftR (event [] id <<< snd <<< splitE) outBoard
     reactiveValueWrite boardQueue (bq ++ ob)
-  -- /!\ To be removed.
-  --reactiveValueOnCanRead inRV (reactiveValueRead inRV >>= print . \(_,_,ph,_) -> ph)
-  --reactiveValueOnCanRead outBoard (reactiveValueRead outBoard >>= print)
-  reactiveValueOnCanRead phRV (reactiveValueRead phRV >>= print)
+  -- This needs to be set last otherwise phRV is written to, so
+  -- inBoard is written to and the notes don't get played. There
+  -- supposedly is no guaranty of order but apparently there is…
+  (fst <$>) <^> outBoard >:> phRV
   putStrLn "Board started."
   -- Jack setup
   forkIO $ jackSetup tempoRV (constR 0) boardQueue