Commit f62dc879 authored by Guerric Chupin's avatar Guerric Chupin

Playheads and notes are correct.

parent 948d6fea
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
......@@ -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
......
......@@ -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
......
......@@ -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
......
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