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
20 import RMCA.Translator.Jack
24 ------------------------------------------------------------------------------
26 ------------------------------------------------------------------------------
30 mainBox <- hBoxNew False 10
31 set window [ windowTitle := "Reactogon"
32 , containerChild := mainBox
33 , containerBorderWidth := 10
37 settingsBox <- vBoxNew False 0
38 boxPackEnd mainBox settingsBox PackNatural 0
39 (globalSettingsBox, tempoRV) <- globalSettings
40 boxPackStart settingsBox globalSettingsBox PackNatural 0
41 globalSep <- hSeparatorNew
42 boxPackStart settingsBox globalSep PackNatural 0
44 boardQueue <- newCBMVarRW mempty
45 chanRV <- newCBMVarRW 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
56 guiBoard <- attachGameRules =<< initGame
57 centerBoard <- alignmentNew 0.5 0.5 0 0
58 containerAdd centerBoard guiBoard
59 containerAdd boardCont centerBoard
60 boxPackStart mainBox boardCont PackNatural 0
61 ------------------------------------------------------------------------------
63 layer <- reactiveValueRead layerRV
64 tempo <- reactiveValueRead tempoRV
65 (boardRV, pieceArrRV, phRV) <- initBoardRV guiBoard
67 handleSaveLoad tempoRV boardRV layerRV instrRV pieceArrRV confSaveRV confLoadRV
69 boardRunRV <- newCBMVarRW BoardStop
70 reactiveValueOnCanRead playRV $ reactiveValueWrite boardRunRV BoardStart
71 reactiveValueOnCanRead stopRV $ reactiveValueWrite boardRunRV BoardStop
72 board <- reactiveValueRead boardRV
73 (inBoard, outBoard) <- yampaReactiveDual (board, layer, tempo, BoardStop) boardSF
74 let tempoRV' = liftR2 (\bool t -> t * fromEnum (not bool)) pauseRV tempoRV
76 boardRV layerRV tempoRV' boardRunRV
77 --let inRV = onTick clock inRV
79 reactiveValueOnCanRead outBoard $
80 reactiveValueRead (liftR (event mempty (,[]) <<< snd <<< splitE) outBoard) >>=
81 reactiveValueAppend boardQueue
82 -- This needs to be set last otherwise phRV is written to, so
83 -- inBoard is written to and the notes don't get played. There
84 -- supposedly is no guaranty of order but apparently there is…
85 fmap fst <^> outBoard >:> phRV
86 putStrLn "Board started."
88 forkIO $ jackSetup tempoRV chanRV boardQueue
90 pieceBox <- clickHandling pieceArrRV guiBoard =<< vBoxNew False 10
91 ------------------------------------------------------------
93 boxPackStart settingsBox pieceBox PackNatural 10
94 onDestroy window mainQuit