Commit 19870ddd authored by Guerric Chupin's avatar Guerric Chupin

Note settings correctly display layer-wise.

parent e94934e9
......@@ -24,7 +24,7 @@ import RMCA.Semantics
data GUICell = GUICell { cellAction :: Action
, repeatCount :: Int
, asPh :: Bool
} deriving(Show)
} deriving(Show,Eq)
newtype GUIBoard = GUIBoard { toGS :: GameState Int Tile Player GUICell }
......
......@@ -2,7 +2,6 @@
module RMCA.GUI.MultiBoard where
import Control.Arrow
import Control.Concurrent.MVar
import Control.Monad
import Control.Monad.IO.Class
......@@ -79,18 +78,22 @@ createNotebook addLayerRV rmLayerRV layerMCBMVar guiCellMCBMVar = do
mstate <- tryTakeMVar state
when (fPos `elem` validArea && isJust mp) $ do
let piece = snd $ fromJust mp
when (button == RightButton && maybe False (== fPos) mstate) $
boardSetPiece fPos (second rotateGUICell (Player,piece)) ioBoard
when (button == RightButton && maybe False (== fPos) mstate) $ do
let nCell = rotateGUICell piece
--boardSetPiece fPos nPiece ioBoard
reactiveValueWrite guiCellMCBMVar nCell
nmp <- boardGetPiece fPos ioBoard
when (button == LeftButton && isJust nmp) $ do
let nCell = snd $ fromJust nmp
reactiveValueWrite guiCellMCBMVar nCell
mOHid <- tryTakeMVar guiCellHidMVar
when (isJust mOHid) $
when (isJust mOHid) $ do
print "Removing."
removeCallbackMCBMVar guiCellMCBMVar $ fromJust mOHid
reactiveValueWrite guiCellMCBMVar nCell
nHid <- installCallbackMCBMVar guiCellMCBMVar $ do
cp <- reactiveValueRead curChanRV
guiVal <- reactiveValueRead guiCellMCBMVar
print guiVal
mChanRV <- M.lookup cp <$> reactiveValueRead chanMapRV
when (isNothing mChanRV) $ error "Can't get piece array!"
let (_,pieceArrRV,_) = fromJust mChanRV
......@@ -199,16 +202,7 @@ createNotebook addLayerRV rmLayerRV layerMCBMVar guiCellMCBMVar = do
putMVar layerHidMVar
return ()
------------------------------------------------------------------------------
-- Handle clicks
------------------------------------------------------------------------------
------------------------------------------------------------------------------
-- For good measure
------------------------------------------------------------------------------
return (n, chanMapRV, curPageRV)
--return ()
......@@ -131,7 +131,7 @@ noteSettingsBox = do
-- Side RV
-- Carries the index of the tile to display and what to display.
setRV <- newCBMVarRW inertCell
setRV <- newMCBMVar inertCell
reactiveValueOnCanRead noteDurRV $ do
nDur <- reactiveValueRead noteDurRV
......@@ -143,7 +143,7 @@ noteSettingsBox = do
then oCell { cellAction =
setNAttr (fromJust nCa) (cellAction oCell) }
else oCell
reactiveValueWrite setRV nCell
reactiveValueWriteOnNotEq setRV nCell
fromMaybeM_ $ reactiveValueWrite noteDurLabelRV <$> lookup nDur symbolString
......@@ -195,7 +195,14 @@ noteSettingsBox = do
Absorb -> hideNa
_ -> showNa
reactiveValueOnCanRead setRV $ reactiveValueRead setRV >>= updateNaBox
reactiveValueOnCanRead setRV $ do
nCell <- reactiveValueRead setRV
fromMaybeM_ (reactiveValueWriteOnNotEq artComboRV <$> naArt <$> getNAttr (cellAction nCell))
fromMaybeM_ (reactiveValueWriteOnNotEq slideComboRV <$> ornSlide <$> naOrn <$> getNAttr (cellAction nCell))
reactiveValueWriteOnNotEq rCountRV $ repeatCount nCell
fromMaybeM_ (reactiveValueWriteOnNotEq noteDurRV <$> naDur <$> getNAttr (cellAction nCell))
updateNaBox nCell
{-
state <- newEmptyMVar
boardOnPress board
......@@ -234,6 +241,8 @@ noteSettingsBox = do
widgetShow naBox
-}
setMCBMVar <- newMCBMVar =<< reactiveValueRead setRV
setMCBMVar =:= setRV
return (pieceBox,setMCBMVar)
--setMCBMVar <- newMCBMVar =<< reactiveValueRead setRV
--setMCBMVar =:= setRV
widgetShow pieceBox
widgetShow naBox
return (pieceBox,setRV)
......@@ -237,7 +237,7 @@ data Ornaments = Ornaments {
ornPC :: Maybe MIDIPN,
ornCC :: [(MIDICN, MIDICVRnd)],
ornSlide :: SlideType
} deriving (Show,Read)
} deriving (Show,Read,Eq)
data SlideType = NoSlide | SlideUp | SlideDn deriving (Eq, Show, Enum, Read)
......@@ -257,7 +257,7 @@ data NoteAttr = NoteAttr {
naArt :: Articulation,
naDur :: Duration,
naOrn :: Ornaments
} deriving (Show,Read)
} deriving (Show,Read,Eq)
-- High level note representation emitted form a layer
......@@ -266,7 +266,7 @@ data Note = Note {
noteStr :: Strength,
noteDur :: Duration,
noteOrn :: Ornaments
} deriving Show
} deriving (Show,Eq)
------------------------------------------------------------------------------
......@@ -332,7 +332,7 @@ data Action = Inert -- No action, play heads move through.
| Stop NoteAttr -- Play note then remove play head.
| ChDir Bool NoteAttr Dir -- Play note then change direction.
| Split NoteAttr -- Play note then split head into five.
deriving (Show,Read)
deriving (Show,Read,Eq)
-- Cells
......
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