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