RCMA/Main.hs

   1 {-# LANGUAGE ScopedTypeVariables #-}
   2
   3 module Main where
   4
   5 import Control.Concurrent
   6 import Data.ReactiveValue
   7 import FRP.Yampa
   8 import Hails.Yampa
   9 import RCMA.Auxiliary.Concurrent
  10 import RCMA.Auxiliary.RV
  11 import RCMA.Global.Clock
  12 import RCMA.Layer.Board
  13 import RCMA.Layer.Layer
  14 import RCMA.Semantics
  15 import RCMA.Translator.Jack
  16 import RCMA.Translator.Message
  17 import RCMA.Translator.Translator
  18
  19 import Control.Monad
  20 import Data.Ratio
  21
  22 board =
  23     makeBoard [((0,0),  mkCell (ChDir False na1 N)),
  24                ((0,1),  mkCell (ChDir False na1 SE)),
  25                ((1,1),  mkCell (Split na1)),
  26                ((1,-1), mkCell (Split na1)),
  27                ((-1,0), mkCell (ChDir False na2 NE))]
  28
  29 na1 = NoteAttr {
  30           naArt = Accent13,
  31           naDur = 1 % 4,
  32           naOrn = Ornaments Nothing [] NoSlide
  33       }
  34
  35 na2 = NoteAttr {
  36           naArt = NoAccent,
  37           naDur = 1 % 16,
  38           naOrn = Ornaments Nothing [(10, MIDICVRnd)] SlideUp
  39       }
  40
  41 na3 = NoteAttr {
  42           naArt = Accent13,
  43           naDur = 0,
  44           naOrn = Ornaments Nothing [] NoSlide
  45       }
  46
  47
  48 bpb :: Int
  49 bpb = 4
  50
  51 tempoRV :: ReactiveFieldReadWrite IO Tempo
  52 tempoRV = ReactiveFieldReadWrite (\_ -> return ()) (return 96) (\_ -> return ())
  53
  54 main :: IO ()
  55 main = do
  56   layerRV <- getDefaultLayerRV
  57   boardOutRV <- newCBMVarRW []
  58   boardSetup board tempoRV layerRV boardOutRV
  59   boardI <- reactiveValueRead boardOutRV
  60   print boardI
  61   jackT <- forkChild $ jackSetup (liftR2 (\t n -> (t, 0, n)) tempoRV boardOutRV)
  62   return ()