1 {-# LANGUAGE MultiParamTypeClasses, ScopedTypeVariables, TupleSections #-}
5 import Control.Concurrent
6 import Data.ReactiveValue
9 import Graphics.UI.Gtk.Board.BoardLink
10 import Graphics.UI.Gtk.Layout.BackgroundContainer
13 import RMCA.Configuration
15 import RMCA.GUI.Buttons
16 import RMCA.GUI.LayerSettings
17 import RMCA.GUI.MainSettings
18 import RMCA.GUI.NoteSettings
19 import RMCA.Layer.Board
21 import RMCA.Translator.Jack
29 mainBox <- hBoxNew False 10
30 set window [ windowTitle := "Reactogon"
31 , containerChild := mainBox
32 , containerBorderWidth := 10
36 boardQueue <- newCBMVarRW mempty
37 chanRV <- newCBMVarRW 0
39 settingsBox <- vBoxNew False 0
40 boxPackEnd mainBox settingsBox PackNatural 0
41 (globalSettingsBox, tempoRV) <- globalSettings
42 boxPackStart settingsBox globalSettingsBox PackNatural 0
43 globalSep <- hSeparatorNew
44 boxPackStart settingsBox globalSep PackNatural 0
46 (layerSettingsVBox, layerRV, instrRV) <- layerSettings chanRV boardQueue
47 boxPackStart settingsBox layerSettingsVBox PackNatural 0
48 laySep <- hSeparatorNew
49 boxPackStart settingsBox laySep PackNatural 0
51 (buttonBox, playRV, stopRV, pauseRV, recordRV, confSaveRV, confLoadRV) <- getButtons
52 boxPackEnd settingsBox buttonBox PackNatural 0
55 boardCont <- backgroundContainerNew
57 guiBoard <- attachGameRules game
58 centerBoard <- alignmentNew 0.5 0.5 0 0
59 containerAdd centerBoard guiBoard
60 containerAdd boardCont centerBoard
61 boxPackStart mainBox boardCont PackNatural 0
62 --boxPackStart mainBox boardCont PackNatural 0
63 ------------------------------------------------------------------------------
65 layer <- reactiveValueRead layerRV
66 tempo <- reactiveValueRead tempoRV
67 (boardRV, pieceArrRV, phRV) <- initBoardRV guiBoard
70 fcs <- fileChooserDialogNew (Just "Save configuration") Nothing
71 FileChooserActionSave [("Cancel",ResponseCancel),("Ok",ResponseOk)]
72 --containerAdd fcsw fcs
73 reactFilt <- fileFilterNew
74 fileFilterAddPattern reactFilt "*.react"
75 fileFilterSetName reactFilt "RMCA conf files."
76 fileChooserAddFilter fcs reactFilt
79 fcl <- fileChooserDialogNew (Just "Load configuration") Nothing
80 FileChooserActionOpen [("Cancel",ResponseCancel),("Ok",ResponseOk)]
81 --containerAdd fclw fcl
82 fileChooserAddFilter fcl reactFilt
84 reactiveValueOnCanRead confSaveRV $ postGUIAsync $ do
86 let respHandle ResponseOk =
87 fileChooserGetFilename fcs >>= fromMaybeM_ .
88 fmap (\f -> saveConfiguration f tempoRV layerRV boardRV instrRV)
89 respHandle _ = return ()
91 onResponse fcs (\r -> respHandle r >> widgetHide fcs)
94 reactiveValueOnCanRead confLoadRV $ postGUIAsync $ do
96 let respHandle ResponseOk =
97 fileChooserGetFilename fcl >>= fromMaybeM_ .
98 fmap (\f -> loadConfiguration f tempoRV layerRV pieceArrRV instrRV)
99 respHandle _ = return ()
101 onResponse fcl (\r -> respHandle r >> widgetHide fcl)
104 boardRunRV <- newCBMVarRW BoardStop
105 reactiveValueOnCanRead playRV $ reactiveValueWrite boardRunRV BoardStart
106 reactiveValueOnCanRead stopRV $ reactiveValueWrite boardRunRV BoardStop
107 board <- reactiveValueRead boardRV
108 (inBoard, outBoard) <- yampaReactiveDual (board, layer, tempo, BoardStop) boardSF
109 let tempoRV' = liftR2 (\bool t -> t * fromEnum (not bool)) pauseRV tempoRV
111 boardRV layerRV tempoRV' boardRunRV
112 --let inRV = onTick clock inRV
114 reactiveValueOnCanRead outBoard $
115 reactiveValueRead (liftR (event mempty (,[]) <<< snd <<< splitE) outBoard) >>=
116 reactiveValueAppend boardQueue
117 -- This needs to be set last otherwise phRV is written to, so
118 -- inBoard is written to and the notes don't get played. There
119 -- supposedly is no guaranty of order but apparently there is…
120 fmap fst <^> outBoard >:> phRV
121 putStrLn "Board started."
123 forkIO $ jackSetup tempoRV chanRV boardQueue
125 pieceBox <- clickHandling pieceArrRV guiBoard =<< vBoxNew False 10
126 -- Piece characteristic
127 --pieceBox <- pieceButtons pieceArrRV guiBoard =<< vBoxNew False 10
128 ------------------------------------------------------------
130 boxPackStart settingsBox pieceBox PackNatural 10
131 onDestroy window mainQuit