{-# LANGUAGE RebindableSyntax #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE Rank2Types #-}
{- |
Convert MIDI events of a MIDI controller to a control signal.
-}
module Synthesizer.LLVM.MIDI (
   frequencyFromBendModulation,
   frequencyFromBendModulationPacked,
   Gen.applyModulation,
   ) where

import qualified Synthesizer.MIDI.Generic as Gen
import qualified Synthesizer.LLVM.MIDI.BendModulation as BM
import qualified Synthesizer.LLVM.Frame.SerialVector as SerialExp
import qualified Synthesizer.LLVM.Frame.SerialVector.Code as Serial

import qualified Synthesizer.LLVM.Causal.Functional as Func
import qualified Synthesizer.LLVM.Causal.Process as Causal
import qualified Synthesizer.LLVM.Generator.SignalPacked as SigPS
import qualified Synthesizer.LLVM.Generator.Signal as Sig
import qualified Synthesizer.LLVM.Wave as Wave
import Synthesizer.LLVM.Causal.Process (($>))

import LLVM.DSL.Expression (Exp)

import qualified LLVM.Extra.Multi.Value.Marshal as Marshal
import qualified LLVM.Extra.Multi.Value as MultiValue
import qualified LLVM.Extra.Multi.Vector as MultiVector
import qualified LLVM.Extra.Arithmetic as A
import qualified LLVM.Core as LLVM

import Control.Arrow (second, (<<<), (<<^))

import NumericPrelude.Numeric
import Prelude (($))


frequencyFromBendModulation ::
   (Marshal.C y, MultiValue.T y ~ ym,
    MultiValue.PseudoRing y, MultiValue.IntegerConstant y,
    MultiValue.Fraction y) =>
   Exp y -> Causal.T (BM.T ym) ym
frequencyFromBendModulation :: forall y ym.
(C y, T y ~ ym, PseudoRing y, IntegerConstant y, Fraction y) =>
Exp y -> T (T ym) ym
frequencyFromBendModulation Exp y
speed =
   ((forall r. ym -> CodeGenFunction r ym) -> Exp y -> Exp y -> T ym)
-> Exp y -> T (ym, ym) ym
forall y ym.
(Additive y, PseudoRing ym, IntegerConstant ym, Fraction ym) =>
((forall r. ym -> CodeGenFunction r ym) -> Exp y -> Exp y -> T ym)
-> Exp y -> T (ym, ym) ym
frequencyFromPair (forall r. ym -> CodeGenFunction r ym) -> Exp y -> Exp y -> T ym
(forall r. T y -> CodeGenFunction r ym) -> Exp y -> Exp y -> T ym
forall t y.
(Fraction t, C t) =>
(forall r. T t -> CodeGenFunction r y) -> Exp t -> Exp t -> T y
Sig.osci Exp y
speed
   T (ym, ym) ym -> (T ym -> (ym, ym)) -> T (T ym) ym
forall (a :: * -> * -> *) c d b.
Arrow a =>
a c d -> (b -> c) -> a b d
<<^
   (\(BM.Cons ym
b ym
m) -> (ym
b,ym
m))


frequencyFromBendModulationPacked ::
   (Marshal.Vector n a) =>
   (MultiVector.PseudoRing a, MultiVector.IntegerConstant a) =>
   (MultiVector.Fraction a) =>
   Exp a -> Causal.T (BM.T (MultiValue.T a)) (Serial.Value n a)
frequencyFromBendModulationPacked :: forall n a.
(Vector n a, PseudoRing a, IntegerConstant a, Fraction a) =>
Exp a -> T (T (T a)) (Value n a)
frequencyFromBendModulationPacked Exp a
speed =
   ((forall r. Value n a -> CodeGenFunction r (Value n a))
 -> Exp a -> Exp a -> T (Value n a))
-> Exp a -> T (Value n a, Value n a) (Value n a)
forall y ym.
(Additive y, PseudoRing ym, IntegerConstant ym, Fraction ym) =>
((forall r. ym -> CodeGenFunction r ym) -> Exp y -> Exp y -> T ym)
-> Exp y -> T (ym, ym) ym
frequencyFromPair (forall r. Value n a -> CodeGenFunction r (Value n a))
-> Exp a -> Exp a -> T (Value n a)
forall n t y.
(Vector n t, PseudoRing t, Fraction t, IntegerConstant t) =>
(forall r. Serial n t -> CodeGenFunction r y)
-> Exp t -> Exp t -> T y
SigPS.osci Exp a
speed
   T (Value n a, Value n a) (Value n a)
-> T (T (T a)) (Value n a, Value n a) -> T (T (T a)) (Value n a)
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<<
   (T (Exp a) -> (Exp (T n a), Exp (T n a)))
-> T (T (T a)) (Value n a, Value n a)
forall ae a be b.
(Aggregate ae a, Aggregate be b) =>
(ae -> be) -> T a b
Causal.map (\(BM.Cons Exp a
b Exp a
m) -> (Exp a -> Exp (T n a)
forall n a. (Positive n, C a) => Exp a -> Exp (T n a)
SerialExp.upsample Exp a
b, Exp a -> Exp (T n a)
forall n a. (Positive n, C a) => Exp a -> Exp (T n a)
SerialExp.upsample Exp a
m))

frequencyFromPair, _frequencyFromPair ::
   (MultiValue.Additive y,
    A.PseudoRing ym, A.IntegerConstant ym, A.Fraction ym) =>
   ((forall r. ym -> LLVM.CodeGenFunction r ym) ->
    Exp y -> Exp y -> Sig.T ym) ->
   Exp y -> Causal.T (ym,ym) ym
frequencyFromPair :: forall y ym.
(Additive y, PseudoRing ym, IntegerConstant ym, Fraction ym) =>
((forall r. ym -> CodeGenFunction r ym) -> Exp y -> Exp y -> T ym)
-> Exp y -> T (ym, ym) ym
frequencyFromPair (forall r. ym -> CodeGenFunction r ym) -> Exp y -> Exp y -> T ym
osci Exp y
speed =
   (Atom ym, Atom ym)
-> (GuidedArguments (T (ym, ym)) (Atom ym, Atom ym)
    -> T (ym, ym) ym)
-> T (ym, ym) ym
forall pat inp out.
(MakeGuidedArguments pat, PatternArguments pat ~ inp) =>
pat -> (GuidedArguments (T inp) pat -> T inp out) -> T inp out
Func.withGuidedArgs (Atom ym
forall a. Atom a
Func.atom, Atom ym
forall a. Atom a
Func.atom) ((GuidedArguments (T (ym, ym)) (Atom ym, Atom ym) -> T (ym, ym) ym)
 -> T (ym, ym) ym)
-> (GuidedArguments (T (ym, ym)) (Atom ym, Atom ym)
    -> T (ym, ym) ym)
-> T (ym, ym) ym
forall a b. (a -> b) -> a -> b
$ \(T (ym, ym) ym
b, T (ym, ym) ym
m) ->
      T (ym, ym) ym
b T (ym, ym) ym -> T (ym, ym) ym -> T (ym, ym) ym
forall a. C a => a -> a -> a
* (T (ym, ym) ym
1 T (ym, ym) ym -> T (ym, ym) ym -> T (ym, ym) ym
forall a. C a => a -> a -> a
+ T (ym, ym) ym
m T (ym, ym) ym -> T (ym, ym) ym -> T (ym, ym) ym
forall a. C a => a -> a -> a
* T ym -> T (ym, ym) ym
forall out inp. T out -> T inp out
Func.fromSignal ((forall r. ym -> CodeGenFunction r ym) -> Exp y -> Exp y -> T ym
osci ym -> CodeGenFunction r ym
forall r. ym -> CodeGenFunction r ym
forall a r.
(PseudoRing a, IntegerConstant a, Fraction a) =>
a -> CodeGenFunction r a
Wave.approxSine2 Exp y
forall a. C a => a
zero Exp y
speed))

_frequencyFromPair :: forall y ym.
(Additive y, PseudoRing ym, IntegerConstant ym, Fraction ym) =>
((forall r. ym -> CodeGenFunction r ym) -> Exp y -> Exp y -> T ym)
-> Exp y -> T (ym, ym) ym
_frequencyFromPair (forall r. ym -> CodeGenFunction r ym) -> Exp y -> Exp y -> T ym
osci Exp y
speed =
   T (ym, ym) ym
forall a. PseudoRing a => T (a, a) a
Causal.envelope
   T (ym, ym) ym -> T (ym, ym) (ym, ym) -> T (ym, ym) ym
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<<
   T ym ym -> T (ym, ym) (ym, ym)
forall b c d. T b c -> T (d, b) (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (T ym ym
1 T ym ym -> T ym ym -> T ym ym
forall a. C a => a -> a -> a
+ (T (ym, ym) ym
forall a. PseudoRing a => T (a, a) a
Causal.envelope T (ym, ym) ym -> SignalOf T ym -> T ym ym
forall (process :: * -> * -> *) a b c.
C process =>
process (a, b) c -> SignalOf process b -> process a c
$> (forall r. ym -> CodeGenFunction r ym) -> Exp y -> Exp y -> T ym
osci ym -> CodeGenFunction r ym
forall r. ym -> CodeGenFunction r ym
forall a r.
(PseudoRing a, IntegerConstant a, Fraction a) =>
a -> CodeGenFunction r a
Wave.approxSine2 Exp y
forall a. C a => a
zero Exp y
speed))