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.Global.Clock
  11 import RCMA.Layer.Board
  12 import RCMA.Layer.Layer
  13 import RCMA.Semantics
  14 import RCMA.Translator.Jack
  15 import RCMA.Translator.Message
  16 import RCMA.Translator.Translator
  17
  18 import Control.Monad
  19 import Data.Ratio
  20
  21 board =
  22     makeBoard [((0,0),  mkCell (ChDir False na1 N)),
  23                ((0,1),  mkCell (ChDir False na1 SE)),
  24                ((1,1),  mkCell (Split na1)),
  25                ((1,-1), mkCell (Split na1)),
  26                ((-1,0), mkCell (ChDir False na2 NE))]
  27
  28 na1 = NoteAttr {
  29           naArt = Accent13,
  30           naDur = 1 % 4,
  31           naOrn = Ornaments Nothing [] NoSlide
  32       }
  33
  34 na2 = NoteAttr {
  35           naArt = NoAccent,
  36           naDur = 1 % 16,
  37           naOrn = Ornaments Nothing [(10, MIDICVRnd)] SlideUp
  38       }
  39
  40 na3 = NoteAttr {
  41           naArt = Accent13,
  42           naDur = 0,
  43           naOrn = Ornaments Nothing [] NoSlide
  44       }
  45
  46
  47 bpb :: Int
  48 bpb = 4
  49
  50 tempoRV :: ReactiveFieldReadWrite IO Tempo
  51 tempoRV = ReactiveFieldReadWrite (\_ -> return ()) (return 96) (\_ -> return ())
  52
  53 main :: IO ()
  54 main = do
  55   layerRV <- getDefaultLayerRV
  56   boardInRV <- boardSetup board tempoRV layerRV
  57   jackT <- forkChild $ jackSetup (liftR2 (\t n -> (t, 0, n)) tempoRV boardInRV)
  58   return ()