Reactogon/Layer/Board.hs

   1 {-# LANGUAGE Arrows #-}
   2
   3 module Reactogon.Layer.Board where
   4
   5 import FRP.Yampa
   6 import Reactogon.Layer.Layer
   7 import Reactogon.Semantics
   8
   9 -- The state of the board is described by the list of the playheads
  10 -- and the different actions onto the board.
  11 -- It can then be modified discretly when a beat is received or
  12 -- continuously when the user acts on it.
  13 boardAction :: Board
  14             -> SF (Layer, [PlayHead], Event BeatNo)
  15                   (Event ([PlayHead], [Note]))
  16 boardAction board = proc (Layer { relPitch    = rp
  17                                 , strength    = s
  18                                 , beatsPerBar = bpb
  19                                 }, pl, ebn) -> do
  20   ahSF <<^ arr propEvent -< (ebn, rp, s, pl)
  21   where
  22     uncurry4 :: (a -> b -> c -> d -> e) -> (a,b,c,d) -> e
  23     uncurry4 f (a,b,c,d) = f a b c d
  24     ahSF :: SF (Event (BeatNo, RelPitch, Strength, [PlayHead]))
  25                (Event ([PlayHead], [Note]))
  26     ahSF = arr $ fmap (uncurry4 $ advanceHeads board)
  27     propEvent (a,b,c,d) = if isEvent a then Event (fromEvent a,b,c,d) else NoEvent