Commit 7db99307 authored by Guerric Chupin's avatar Guerric Chupin

Made pause button working.

parent 54f18767
-- Contains button name definition
{-# LANGUAGE OverloadedStrings #-}
module RMCA.GUI.Buttons where
import Data.ReactiveValue
import Graphics.UI.Gtk
import Graphics.UI.Gtk.Reactive
import System.Glib
gtkMediaPlay :: DefaultGlibString
......@@ -14,3 +18,47 @@ gtkMediaPause = stringToGlib "gtk-media-pause"
gtkMediaRecord :: DefaultGlibString
gtkMediaRecord = stringToGlib "gtk-media-record"
toggleButtonNewFromStock :: StockId -> IO ToggleButton
toggleButtonNewFromStock s = do
button <- toggleButtonNew
buttonBox <- hBoxNew False 0
buttonImg <- imageNewFromStock s IconSizeButton
stockTxt <- stockLookupItem s
buttonLabel <- labelNew (siLabel <$> stockTxt)
labelSetUseUnderline buttonLabel True
containerAdd button buttonBox
boxPackStart buttonBox buttonImg PackNatural 0
boxPackStart buttonBox buttonLabel PackNatural 0
return button
getButtons :: IO ( HBox
, ReactiveFieldRead IO ()
, ReactiveFieldRead IO ()
, ReactiveFieldRead IO Bool
, ReactiveFieldRead IO Bool
)
getButtons = do
buttonBox <- hBoxNew True 10
buttonPlay <- buttonNewFromStock gtkMediaPlay
let playRV = buttonActivateField buttonPlay
boxPackStart buttonBox buttonPlay PackRepel 0
buttonPause <- toggleButtonNewFromStock gtkMediaPause
let pauseRV = readOnly $ toggleButtonActiveReactive buttonPause
boxPackStart buttonBox buttonPause PackRepel 0
buttonStop <- buttonNewFromStock gtkMediaStop
let stopRV = buttonActivateField buttonStop
boxPackStart buttonBox buttonStop PackRepel 0
buttonRecord <- toggleButtonNewFromStock gtkMediaRecord
let recordRV = readOnly $ toggleButtonActiveReactive buttonRecord
boxPackStart buttonBox buttonRecord PackRepel 0
return ( buttonBox
, playRV
, stopRV
, pauseRV
, recordRV
)
......@@ -173,10 +173,10 @@ clickHandling pieceArrRV board pieceBox = do
reactiveValueWrite (pieceArrRV ! i) nCell
reactiveValueOnCanRead artComboRV $ do
--nArt <- reactiveValueRead artComboRV
nArt <- reactiveValueRead artComboRV
(i,oCell) <- reactiveValueRead setRV
let nCa :: Maybe NoteAttr
nCa = getNAttr $ cellAction oCell
nCa = (\na -> na { naArt = nArt }) <$> getNAttr (cellAction oCell)
nCell :: GUICell
nCell = if isJust nCa
then oCell { cellAction =
......
......@@ -97,18 +97,8 @@ main = do
layerRV =
liftRW4 (bijection (f1,f2)) layTempoRV layPitchRV strengthRV bpbRV
buttonBox <- hBoxNew True 10
(buttonBox, playRV, stopRV, pauseRV, recordRV) <- getButtons
boxPackEnd settingsBox buttonBox PackNatural 0
buttonPlay <- buttonNewFromStock gtkMediaPlay
let playRV = buttonActivateField buttonPlay
boxPackStart buttonBox buttonPlay PackRepel 0
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
-- Board
boardCont <- backgroundContainerNew
......@@ -131,8 +121,9 @@ main = do
board <- reactiveValueRead boardRV
ph <- reactiveValueRead phRV
(inBoard, outBoard) <- yampaReactiveDual (board, layer, ph, tempo) boardSF
let inRV = liftR4 id
boardRV layerRV phRV tempoRV
let tempoRV' = liftR2 (\bool t -> t * fromEnum (not bool)) pauseRV tempoRV
inRV = liftR4 id
boardRV layerRV phRV tempoRV'
--let inRV = onTick clock inRV
inRV =:> inBoard
reactiveValueOnCanRead outBoard $ do
......
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