module Synthesizer.MIDI.CausalIO.ControllerSelection (
   fromChannel,
   filter,
   T(Cons),

   controllerLinear,
   controllerExponential,
   pitchBend,
   channelPressure,
   ) where

import qualified Synthesizer.CausalIO.Process as PIO
import qualified Synthesizer.MIDI.CausalIO.Process as MIO

import qualified Synthesizer.MIDI.PiecewiseConstant.ControllerSet as PCS
import qualified Synthesizer.MIDI.EventList as MIDIEv
import qualified Synthesizer.MIDI.Value as MV

import qualified Sound.MIDI.Message.Class.Check as Check

import qualified Data.EventList.Relative.TimeTime  as EventListTT

import qualified Algebra.Transcendental as Trans
import qualified Algebra.Field          as Field

import qualified Data.Map as Map
import qualified Data.Maybe as Maybe
import Data.Tuple.HT (mapSnd, )

import Control.Arrow (Arrow, )

import NumericPrelude.Numeric
import NumericPrelude.Base hiding ((.), filter, )
import Prelude ()



fromChannel ::
   (Check.C event, Arrow arrow) =>
   MIDIEv.Channel ->
   arrow
      (EventListTT.T MIDIEv.StrictTime [event])
      (EventListTT.T MIDIEv.StrictTime [(PCS.Controller, Int)])
fromChannel :: forall event (arrow :: * -> * -> *).
(C event, Arrow arrow) =>
Channel
-> arrow (T StrictTime [event]) (T StrictTime [(Controller, Int)])
fromChannel Channel
chan =
   forall (arrow :: * -> * -> *) (f :: * -> *) a b.
(Arrow arrow, Functor f) =>
(a -> Maybe b) -> arrow (f [a]) (f [b])
MIO.mapMaybe forall a b. (a -> b) -> a -> b
$ forall event.
C event =>
Channel -> event -> Maybe (Controller, Int)
PCS.maybeController Channel
chan


-- see PCS.mapInsertMany
mapInsertMany ::
   (Ord key) =>
   [(key,a)] -> Map.Map key a -> Map.Map key a
mapInsertMany :: forall key a. Ord key => [(key, a)] -> Map key a -> Map key a
mapInsertMany [(key, a)]
assignments Map key a
inits =
   forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert)) Map key a
inits [(key, a)]
assignments



data T a =
   Cons PCS.Controller (Int -> a) a

filter ::
   [T a] ->
   PIO.T
      (EventListTT.T MIDIEv.StrictTime [(PCS.Controller, Int)])
      (PCS.T Int a)
filter :: forall a. [T a] -> T (T StrictTime [(Controller, Int)]) (T Int a)
filter [T a]
mapping =
   let dict :: Map Controller (Int, Int -> a)
dict =
          forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$
          forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
n (Cons Controller
cc Int -> a
f a
_init) -> (Controller
cc, (Int
n, Int -> a
f)))
             [Int
0 ..] [T a]
mapping
   in  forall a state b. (a -> state -> (b, state)) -> state -> T a b
PIO.mapAccum
          (\T StrictTime [(Controller, Int)]
evs Map Int a
curMap ->
             let ctrlEvs :: T StrictTime [(Int, a)]
ctrlEvs =
                    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe (\(Controller
cc, Int
val) ->
                       forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (forall a b. (a -> b) -> a -> b
$ Int
val)) forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Controller
cc Map Controller (Int, Int -> a)
dict)) T StrictTime [(Controller, Int)]
evs
             in  (forall key a. Map key a -> T StrictTime [(key, a)] -> T key a
PCS.Cons Map Int a
curMap T StrictTime [(Int, a)]
ctrlEvs,
                  forall key a. Ord key => [(key, a)] -> Map key a -> Map key a
mapInsertMany
                     (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall time body. T time body -> [body]
EventListTT.getBodies T StrictTime [(Int, a)]
ctrlEvs)
                     Map Int a
curMap))
          (forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] forall a b. (a -> b) -> a -> b
$
           forall a b. (a -> b) -> [a] -> [b]
map (\(Cons Controller
_cc Int -> a
_f a
initVal) -> a
initVal) [T a]
mapping)


controllerLinear ::
   (Field.C y) =>
   MIDIEv.Controller ->
   (y,y) -> y ->
   T y
controllerLinear :: forall y. C y => Controller -> (y, y) -> y -> T y
controllerLinear Controller
ctrl (y, y)
bnd y
initial =
   forall a. Controller -> (Int -> a) -> a -> T a
Cons (Controller -> Controller
PCS.Controller Controller
ctrl) (forall y. C y => (y, y) -> Int -> y
MV.controllerLinear (y, y)
bnd) y
initial

controllerExponential ::
   (Trans.C y) =>
   MIDIEv.Controller ->
   (y,y) -> y ->
   T y
controllerExponential :: forall y. C y => Controller -> (y, y) -> y -> T y
controllerExponential Controller
ctrl (y, y)
bnd y
initial =
   forall a. Controller -> (Int -> a) -> a -> T a
Cons (Controller -> Controller
PCS.Controller Controller
ctrl) (forall y. C y => (y, y) -> Int -> y
MV.controllerExponential (y, y)
bnd) y
initial

pitchBend ::
   (Trans.C y) =>
   y -> y ->
   T y
pitchBend :: forall y. C y => y -> y -> T y
pitchBend y
range y
center =
   forall a. Controller -> (Int -> a) -> a -> T a
Cons Controller
PCS.PitchBend (forall y. C y => y -> y -> Int -> y
MV.pitchBend y
range y
center) y
center

channelPressure ::
   (Trans.C y) =>
   y -> y ->
   T y
channelPressure :: forall y. C y => y -> y -> T y
channelPressure y
maxVal y
initial =
   forall a. Controller -> (Int -> a) -> a -> T a
Cons Controller
PCS.Pressure (forall y. C y => (y, y) -> Int -> y
MV.controllerLinear (forall a. C a => a
zero,y
maxVal)) y
initial