1 {-# LANGUAGE ScopedTypeVariables #-}
5 import Control.Concurrent
6 import Data.ReactiveValue
9 import RMCA.Auxiliary.Concurrent
10 import RMCA.Auxiliary.RV
11 import RMCA.Global.Clock
12 import RMCA.Layer.Board
13 import RMCA.Layer.Layer
15 import RMCA.Translator.Jack
16 import RMCA.Translator.Message
17 import RMCA.Translator.Translator
22 boardRVIO = newCBMVarRW $
23 makeBoard [((0,0), mkCell (ChDir True na1 NE)),
24 ((1,1), mkCellRpt (ChDir False na1 NW) 3),
25 ((0,1), mkCell (ChDir False na1 S))]
26 {-makeBoard [((0,0), mkCell (ChDir True na1 N)),
27 ((0,2), mkCellRpt (ChDir False na2 SE) 3),
28 ((2,1), mkCell (ChDir False na1 SW)),
29 ((1,1), mkCellRpt (ChDir False na1 N) 0) {- Skipped! -},
30 ((0,4), mkCellRpt (ChDir True na1 N) (-1)) {- Rpt indef. -},
31 ((0, -6), mkCell (ChDir True na1 N)),
32 ((0, -2), mkCell (ChDir False na3 S) {- Silent -})]-}
37 naOrn = Ornaments Nothing [] NoSlide
43 naOrn = Ornaments Nothing [(10, MIDICVRnd)] SlideUp
49 naOrn = Ornaments Nothing [] NoSlide
56 newTempoRV :: IO (ReactiveFieldReadWrite IO Tempo)
57 newTempoRV = newCBMVarRW 200
61 layerRV <- getDefaultLayerRV
62 boardQueue <- newCBMVarRW []
64 layer <- reactiveValueRead layerRV
66 tempo <- reactiveValueRead tempoRV
68 board <- reactiveValueRead boardRV
69 (inBoard, outBoard) <- yampaReactiveDual (board, layer, tempo)
70 (boardSF $ startHeads board)
71 let inRV = liftRW2 (bijection (\(x,y,z) -> (x,(y,z)), \(x,(y,z)) -> (x,y,z)))
72 boardRV $ pairRW layerRV tempoRV
73 clock <- mkClockRV 100
76 --reactiveValueOnCanRead outBoard (reactiveValueRead outBoard >>= print . ("Board out " ++) . show)
77 reactiveValueOnCanRead outBoard $ do
78 bq <- reactiveValueRead boardQueue
79 ob <- reactiveValueRead $ liftR (event [] id) outBoard
80 reactiveValueWrite boardQueue (bq ++ ob)
82 --reactiveValueOnCanRead outBoard (reactiveValueRead outBoard >>= print)
83 putStrLn "Board started."
85 jackSetup tempoRV (constR 0) boardQueue