{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE EmptyDataDecls #-}
module Synthesizer.LLVM.Server.Common (
   Real,
   SampleRate(SampleRate), expSampleRate,
   Instrument,
   ($+),
   constant, ($++),
   frequency, time, noiseReference, number,
   Quantity(..), Arg(..), Frequency, Time, Number,
   Input(..), InputArg(..), Parameter, Control, Signal,
   ArgTuple(..),
   Wrapped(..),
   amplitudeFromVelocity,
   ($/),

   piecewiseConstant,
   transposeModulation,

   pioApply,
   pioApplyCont,
   pioApplyToLazyTime,

   controllerAttack, controllerDetune, controllerTimbre0, controllerTimbre1,
   controllerFilterCutoff, controllerFilterResonance,
   controllerVolume,
   ) where

import qualified Synthesizer.LLVM.Generator.Render as Render
import qualified Synthesizer.LLVM.Generator.Signal as Sig
import Synthesizer.LLVM.Causal.Process (($*))

import qualified Synthesizer.LLVM.MIDI.BendModulation as BM
import qualified Synthesizer.LLVM.ConstantPiece as Const
import qualified Synthesizer.MIDI.Storable as MidiSt
import qualified Synthesizer.MIDI.EventList as Ev
import qualified Synthesizer.PiecewiseConstant.Signal as PC
import qualified Synthesizer.CausalIO.Process as PIO
import qualified Synthesizer.Generic.Signal as SigG

import qualified Sound.MIDI.Controller as Ctrl
import qualified Sound.MIDI.Message.Channel.Voice as VoiceMsg

import qualified LLVM.DSL.Expression as Expr
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.Memory as Memory

import qualified Data.StorableVector.Lazy as SVL
import qualified Data.StorableVector as SV
import Foreign.Storable (Storable)

import qualified Numeric.NonNegative.Chunky as NonNegChunky
import qualified Numeric.NonNegative.Wrapper as NonNegW

import Control.Applicative (Applicative, liftA2, pure, (<*>), (<$>))

import qualified Data.Traversable as Trav
import qualified Data.Foldable as Fold

import qualified System.Unsafe as Unsafe

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

import NumericPrelude.Numeric
import NumericPrelude.Base
import Prelude ()



type Real = Float

type Instrument a sig = SampleRate a -> MidiSt.Instrument a sig


newtype SampleRate a = SampleRate a
   deriving (Int -> SampleRate a -> ShowS
[SampleRate a] -> ShowS
SampleRate a -> String
(Int -> SampleRate a -> ShowS)
-> (SampleRate a -> String)
-> ([SampleRate a] -> ShowS)
-> Show (SampleRate a)
forall a. Show a => Int -> SampleRate a -> ShowS
forall a. Show a => [SampleRate a] -> ShowS
forall a. Show a => SampleRate a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> SampleRate a -> ShowS
showsPrec :: Int -> SampleRate a -> ShowS
$cshow :: forall a. Show a => SampleRate a -> String
show :: SampleRate a -> String
$cshowList :: forall a. Show a => [SampleRate a] -> ShowS
showList :: [SampleRate a] -> ShowS
Show)

instance Functor SampleRate where
   fmap :: forall a b. (a -> b) -> SampleRate a -> SampleRate b
fmap a -> b
f (SampleRate a
sr) = b -> SampleRate b
forall a. a -> SampleRate a
SampleRate (a -> b
f a
sr)

instance Fold.Foldable SampleRate where
   foldMap :: forall m a. Monoid m => (a -> m) -> SampleRate a -> m
foldMap a -> m
f (SampleRate a
sr) = a -> m
f a
sr

instance Trav.Traversable SampleRate where
   traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SampleRate a -> f (SampleRate b)
traverse a -> f b
f (SampleRate a
sr) = b -> SampleRate b
forall a. a -> SampleRate a
SampleRate (b -> SampleRate b) -> f b -> f (SampleRate b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
sr

instance Applicative SampleRate where
   pure :: forall a. a -> SampleRate a
pure = a -> SampleRate a
forall a. a -> SampleRate a
SampleRate
   SampleRate a -> b
f <*> :: forall a b. SampleRate (a -> b) -> SampleRate a -> SampleRate b
<*> SampleRate a
sr = b -> SampleRate b
forall a. a -> SampleRate a
SampleRate (b -> SampleRate b) -> b -> SampleRate b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
sr


instance (Render.RunArg a) => Render.RunArg (SampleRate a) where
   type DSLArg (SampleRate a) = SampleRate (Render.DSLArg a)
   buildArg :: BuildArg (SampleRate a)
buildArg =
      case BuildArg a
forall a. RunArg a => BuildArg a
Render.buildArg of
         Render.BuildArg Exp al -> DSLArg a
pass a -> IO (al, IO ())
create ->
            (Exp al -> DSLArg (SampleRate a))
-> (SampleRate a -> IO (al, IO ())) -> BuildArg (SampleRate a)
forall a al.
C al =>
(Exp al -> DSLArg a) -> (a -> IO (al, IO ())) -> BuildArg a
Render.BuildArg
               (DSLArg a -> SampleRate (DSLArg a)
forall a. a -> SampleRate a
SampleRate (DSLArg a -> SampleRate (DSLArg a))
-> (Exp al -> DSLArg a) -> Exp al -> SampleRate (DSLArg a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp al -> DSLArg a
pass)
               (\(SampleRate a
sr) -> a -> IO (al, IO ())
create a
sr)

instance (MultiValue.C a) => MultiValue.C (SampleRate a) where
   type Repr (SampleRate a) = MultiValue.Repr a
   cons :: SampleRate a -> T (SampleRate a)
cons = SampleRate (T a) -> T (SampleRate a)
forall a. SampleRate (T a) -> T (SampleRate a)
multiValueSampleRate (SampleRate (T a) -> T (SampleRate a))
-> (SampleRate a -> SampleRate (T a))
-> SampleRate a
-> T (SampleRate a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> T a) -> SampleRate a -> SampleRate (T a)
forall a b. (a -> b) -> SampleRate a -> SampleRate b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> T a
forall a. C a => a -> T a
MultiValue.cons
   undef :: T (SampleRate a)
undef = SampleRate (T a) -> T (SampleRate a)
forall a. SampleRate (T a) -> T (SampleRate a)
multiValueSampleRate (SampleRate (T a) -> T (SampleRate a))
-> SampleRate (T a) -> T (SampleRate a)
forall a b. (a -> b) -> a -> b
$ T a -> SampleRate (T a)
forall a. a -> SampleRate a
forall (f :: * -> *) a. Applicative f => a -> f a
pure T a
forall a. C a => T a
MultiValue.undef
   zero :: T (SampleRate a)
zero = SampleRate (T a) -> T (SampleRate a)
forall a. SampleRate (T a) -> T (SampleRate a)
multiValueSampleRate (SampleRate (T a) -> T (SampleRate a))
-> SampleRate (T a) -> T (SampleRate a)
forall a b. (a -> b) -> a -> b
$ T a -> SampleRate (T a)
forall a. a -> SampleRate a
forall (f :: * -> *) a. Applicative f => a -> f a
pure T a
forall a. C a => T a
MultiValue.zero
   phi :: forall r.
BasicBlock
-> T (SampleRate a) -> CodeGenFunction r (T (SampleRate a))
phi BasicBlock
bb =
      (SampleRate (T a) -> T (SampleRate a))
-> CodeGenFunction r (SampleRate (T a))
-> CodeGenFunction r (T (SampleRate a))
forall a b. (a -> b) -> CodeGenFunction r a -> CodeGenFunction r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SampleRate (T a) -> T (SampleRate a)
forall a. SampleRate (T a) -> T (SampleRate a)
multiValueSampleRate (CodeGenFunction r (SampleRate (T a))
 -> CodeGenFunction r (T (SampleRate a)))
-> (T (SampleRate a) -> CodeGenFunction r (SampleRate (T a)))
-> T (SampleRate a)
-> CodeGenFunction r (T (SampleRate a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      (T a -> CodeGenFunction r (T a))
-> SampleRate (T a) -> CodeGenFunction r (SampleRate (T a))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SampleRate a -> f (SampleRate b)
Trav.traverse (BasicBlock -> T a -> CodeGenFunction r (T a)
forall a r. C a => BasicBlock -> T a -> CodeGenFunction r (T a)
forall r. BasicBlock -> T a -> CodeGenFunction r (T a)
MultiValue.phi BasicBlock
bb) (SampleRate (T a) -> CodeGenFunction r (SampleRate (T a)))
-> (T (SampleRate a) -> SampleRate (T a))
-> T (SampleRate a)
-> CodeGenFunction r (SampleRate (T a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T (SampleRate a) -> SampleRate (T a)
forall a. T (SampleRate a) -> SampleRate (T a)
unMultiValueSampleRate
   addPhi :: forall r.
BasicBlock
-> T (SampleRate a) -> T (SampleRate a) -> CodeGenFunction r ()
addPhi BasicBlock
bb T (SampleRate a)
a T (SampleRate a)
b =
      SampleRate (CodeGenFunction r ()) -> CodeGenFunction r ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
Fold.sequence_ (SampleRate (CodeGenFunction r ()) -> CodeGenFunction r ())
-> SampleRate (CodeGenFunction r ()) -> CodeGenFunction r ()
forall a b. (a -> b) -> a -> b
$
      (T a -> T a -> CodeGenFunction r ())
-> SampleRate (T a)
-> SampleRate (T a)
-> SampleRate (CodeGenFunction r ())
forall a b c.
(a -> b -> c) -> SampleRate a -> SampleRate b -> SampleRate c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (BasicBlock -> T a -> T a -> CodeGenFunction r ()
forall a r. C a => BasicBlock -> T a -> T a -> CodeGenFunction r ()
forall r. BasicBlock -> T a -> T a -> CodeGenFunction r ()
MultiValue.addPhi BasicBlock
bb)
         (T (SampleRate a) -> SampleRate (T a)
forall a. T (SampleRate a) -> SampleRate (T a)
unMultiValueSampleRate T (SampleRate a)
a) (T (SampleRate a) -> SampleRate (T a)
forall a. T (SampleRate a) -> SampleRate (T a)
unMultiValueSampleRate T (SampleRate a)
b)

instance (Marshal.C a) => Marshal.C (SampleRate a) where
   pack :: SampleRate a -> Struct (SampleRate a)
pack (SampleRate a
a) = a -> Struct a
forall a. C a => a -> Struct a
Marshal.pack a
a
   unpack :: Struct (SampleRate a) -> SampleRate a
unpack = a -> SampleRate a
forall a. a -> SampleRate a
SampleRate (a -> SampleRate a) -> (Struct a -> a) -> Struct a -> SampleRate a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Struct a -> a
forall a. C a => Struct a -> a
Marshal.unpack

multiValueSampleRate ::
   SampleRate (MultiValue.T a) -> MultiValue.T (SampleRate a)
multiValueSampleRate :: forall a. SampleRate (T a) -> T (SampleRate a)
multiValueSampleRate (SampleRate (MultiValue.Cons Repr a
a)) = Repr (SampleRate a) -> T (SampleRate a)
forall a. Repr a -> T a
MultiValue.Cons Repr a
Repr (SampleRate a)
a

unMultiValueSampleRate ::
   MultiValue.T (SampleRate a) -> SampleRate (MultiValue.T a)
unMultiValueSampleRate :: forall a. T (SampleRate a) -> SampleRate (T a)
unMultiValueSampleRate (MultiValue.Cons Repr (SampleRate a)
a) = T a -> SampleRate (T a)
forall a. a -> SampleRate a
SampleRate (Repr a -> T a
forall a. Repr a -> T a
MultiValue.Cons Repr a
Repr (SampleRate a)
a)


expSampleRate :: Exp (SampleRate a) -> SampleRate (Exp a)
expSampleRate :: forall a. Exp (SampleRate a) -> SampleRate (Exp a)
expSampleRate = Exp a -> SampleRate (Exp a)
forall a. a -> SampleRate a
SampleRate (Exp a -> SampleRate (Exp a))
-> (Exp (SampleRate a) -> Exp a)
-> Exp (SampleRate a)
-> SampleRate (Exp a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (T (SampleRate a) -> T a) -> Exp (SampleRate a) -> Exp a
forall a b. (T a -> T b) -> Exp a -> Exp b
forall (val :: * -> *) a b.
Value val =>
(T a -> T b) -> val a -> val b
Expr.lift1 T (SampleRate a) -> T a
forall a b. (Repr a ~ Repr b) => T a -> T b
MultiValue.cast



($/) :: (Functor f) => f (a -> b) -> a -> f b
f (a -> b)
f $/ :: forall (f :: * -> *) a b. Functor f => f (a -> b) -> a -> f b
$/ a
x = ((a -> b) -> b) -> f (a -> b) -> f b
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ a
x) f (a -> b)
f


infixr 0 $+, $++

($+) ::
   (SampleRate a -> b -> c) ->
   (c -> SampleRate a -> d) ->
   SampleRate a -> b -> d
(SampleRate a -> b -> c
p$+ :: forall a b c d.
(SampleRate a -> b -> c)
-> (c -> SampleRate a -> d) -> SampleRate a -> b -> d
$+c -> SampleRate a -> d
f) SampleRate a
sampleRate b
param = c -> SampleRate a -> d
f (SampleRate a -> b -> c
p SampleRate a
sampleRate b
param) SampleRate a
sampleRate

($++) ::
   (SampleRate a -> b -> c, b) ->
   (c -> SampleRate a -> d) ->
   SampleRate a -> d
((SampleRate a -> b -> c
p,b
param)$++ :: forall a b c d.
(SampleRate a -> b -> c, b)
-> (c -> SampleRate a -> d) -> SampleRate a -> d
$++c -> SampleRate a -> d
f) SampleRate a
sampleRate = c -> SampleRate a -> d
f (SampleRate a -> b -> c
p SampleRate a
sampleRate b
param) SampleRate a
sampleRate

constant ::
   (SampleRate a -> b -> c) -> b ->
   (c -> SampleRate a -> d) ->
   SampleRate a -> d
constant :: forall a b c d.
(SampleRate a -> b -> c)
-> b -> (c -> SampleRate a -> d) -> SampleRate a -> d
constant SampleRate a -> b -> c
p b
param c -> SampleRate a -> d
f SampleRate a
sampleRate = c -> SampleRate a -> d
f (SampleRate a -> b -> c
p SampleRate a
sampleRate b
param) SampleRate a
sampleRate


frequency :: (Field.C a) => SampleRate a -> a -> a
frequency :: forall a. C a => SampleRate a -> a -> a
frequency (SampleRate a
sr) a
param = a
param a -> a -> a
forall a. C a => a -> a -> a
/ a
sr

time :: (Ring.C a) => SampleRate a -> a -> a
time :: forall a. C a => SampleRate a -> a -> a
time (SampleRate a
sr) a
param = a
param a -> a -> a
forall a. C a => a -> a -> a
* a
sr

noiseReference :: (Field.C a) => SampleRate a -> a -> a
noiseReference :: forall a. C a => SampleRate a -> a -> a
noiseReference (SampleRate a
sr) a
freq = a
sra -> a -> a
forall a. C a => a -> a -> a
/a
freq

number :: SampleRate a -> a -> a
number :: forall a. SampleRate a -> a -> a
number = (a -> SampleRate a -> a) -> SampleRate a -> a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> SampleRate a -> a
forall a b. a -> b -> a
const


data Number
data Frequency
data Time
data NoiseReference

class Quantity quantity a where
   data Arg quantity a
   eval :: SampleRate a -> a -> Arg quantity a

instance Quantity Number a where
   data Arg Number a = Number a
   eval :: SampleRate a -> a -> Arg Number a
eval SampleRate a
sampleRate a
a = a -> Arg Number a
forall a. a -> Arg Number a
Number (a -> Arg Number a) -> a -> Arg Number a
forall a b. (a -> b) -> a -> b
$ SampleRate a -> a -> a
forall a. SampleRate a -> a -> a
number SampleRate a
sampleRate a
a

instance (Field.C a) => Quantity Frequency a where
   data Arg Frequency a = Frequency a
   eval :: SampleRate a -> a -> Arg Frequency a
eval SampleRate a
sampleRate a
a = a -> Arg Frequency a
forall a. a -> Arg Frequency a
Frequency (a -> Arg Frequency a) -> a -> Arg Frequency a
forall a b. (a -> b) -> a -> b
$ SampleRate a -> a -> a
forall a. C a => SampleRate a -> a -> a
frequency SampleRate a
sampleRate a
a

instance (Ring.C a) => Quantity Time a where
   data Arg Time a = Time a
   eval :: SampleRate a -> a -> Arg Time a
eval SampleRate a
sampleRate a
a = a -> Arg Time a
forall a. a -> Arg Time a
Time (a -> Arg Time a) -> a -> Arg Time a
forall a b. (a -> b) -> a -> b
$ SampleRate a -> a -> a
forall a. C a => SampleRate a -> a -> a
time SampleRate a
sampleRate a
a

instance (Field.C a) => Quantity NoiseReference a where
   data Arg NoiseReference a = NoiseReference a
   eval :: SampleRate a -> a -> Arg NoiseReference a
eval SampleRate a
sampleRate a
a = a -> Arg NoiseReference a
forall a. a -> Arg NoiseReference a
NoiseReference (a -> Arg NoiseReference a) -> a -> Arg NoiseReference a
forall a b. (a -> b) -> a -> b
$ SampleRate a -> a -> a
forall a. C a => SampleRate a -> a -> a
noiseReference SampleRate a
sampleRate a
a


class Input signal a where
   data InputArg signal a
   type InputSource signal a
   evalInput :: SampleRate a -> InputSource signal a -> InputArg signal a

data Parameter b

instance Input (Parameter b) a where
   data InputArg (Parameter b) a = Parameter b
   type InputSource (Parameter b) a = b
   evalInput :: SampleRate a
-> InputSource (Parameter b) a -> InputArg (Parameter b) a
evalInput SampleRate a
_sr = b -> InputArg (Parameter b) a
InputSource (Parameter b) a -> InputArg (Parameter b) a
forall b a. b -> InputArg (Parameter b) a
Parameter

data Control b

instance Input (Control b) a where
   data InputArg (Control b) a = Control (Sig.T b)
   type InputSource (Control b) a = Sig.T b
   evalInput :: SampleRate a -> InputSource (Control b) a -> InputArg (Control b) a
evalInput SampleRate a
_sr = T b -> InputArg (Control b) a
InputSource (Control b) a -> InputArg (Control b) a
forall b a. T b -> InputArg (Control b) a
Control

data Signal b

instance Input (Signal b) a where
   data InputArg (Signal b) a = Signal (Sig.T b)
   type InputSource (Signal b) a = Sig.T b
   evalInput :: SampleRate a -> InputSource (Signal b) a -> InputArg (Signal b) a
evalInput SampleRate a
_sr = T b -> InputArg (Signal b) a
InputSource (Signal b) a -> InputArg (Signal b) a
forall b a. T b -> InputArg (Signal b) a
Signal


class ArgTuple a tuple where
   type ArgPlain tuple
   evalTuple :: SampleRate a -> ArgPlain tuple -> tuple

instance (Quantity quantity b, a ~ b) => ArgTuple a (Arg quantity b) where
   type ArgPlain (Arg quantity b) = b
   evalTuple :: SampleRate a -> ArgPlain (Arg quantity b) -> Arg quantity b
evalTuple = SampleRate a -> a -> Arg quantity a
SampleRate a -> ArgPlain (Arg quantity b) -> Arg quantity b
forall quantity a.
Quantity quantity a =>
SampleRate a -> a -> Arg quantity a
eval

instance (Input signal b, a ~ b) => ArgTuple a (InputArg signal b) where
   type ArgPlain (InputArg signal b) = InputSource signal b
   evalTuple :: SampleRate a -> ArgPlain (InputArg signal b) -> InputArg signal b
evalTuple = SampleRate a -> ArgPlain (InputArg signal b) -> InputArg signal b
SampleRate a -> InputSource signal a -> InputArg signal a
forall signal a.
Input signal a =>
SampleRate a -> InputSource signal a -> InputArg signal a
evalInput

instance (ArgTuple a b, ArgTuple a c) => ArgTuple a (b,c) where
   type ArgPlain (b,c) = (ArgPlain b, ArgPlain c)
   evalTuple :: SampleRate a -> ArgPlain (b, c) -> (b, c)
evalTuple SampleRate a
sampleRate (ArgPlain b
b,ArgPlain c
c) = (SampleRate a -> ArgPlain b -> b
forall a tuple.
ArgTuple a tuple =>
SampleRate a -> ArgPlain tuple -> tuple
evalTuple SampleRate a
sampleRate ArgPlain b
b, SampleRate a -> ArgPlain c -> c
forall a tuple.
ArgTuple a tuple =>
SampleRate a -> ArgPlain tuple -> tuple
evalTuple SampleRate a
sampleRate ArgPlain c
c)

instance (ArgTuple a b, ArgTuple a c, ArgTuple a d) => ArgTuple a (b,c,d) where
   type ArgPlain (b,c,d) = (ArgPlain b, ArgPlain c, ArgPlain d)
   evalTuple :: SampleRate a -> ArgPlain (b, c, d) -> (b, c, d)
evalTuple SampleRate a
sampleRate (ArgPlain b
b,ArgPlain c
c,ArgPlain d
d) =
      (SampleRate a -> ArgPlain b -> b
forall a tuple.
ArgTuple a tuple =>
SampleRate a -> ArgPlain tuple -> tuple
evalTuple SampleRate a
sampleRate ArgPlain b
b, SampleRate a -> ArgPlain c -> c
forall a tuple.
ArgTuple a tuple =>
SampleRate a -> ArgPlain tuple -> tuple
evalTuple SampleRate a
sampleRate ArgPlain c
c, SampleRate a -> ArgPlain d -> d
forall a tuple.
ArgTuple a tuple =>
SampleRate a -> ArgPlain tuple -> tuple
evalTuple SampleRate a
sampleRate ArgPlain d
d)



class Wrapped a f where
   type Unwrapped f
   wrapped :: f -> SampleRate a -> Unwrapped f

instance (a ~ b) => Wrapped a (SampleRate b -> f) where
   type Unwrapped (SampleRate b -> f) = f
   wrapped :: (SampleRate b -> f)
-> SampleRate a -> Unwrapped (SampleRate b -> f)
wrapped SampleRate b -> f
f = SampleRate a -> Unwrapped (SampleRate b -> f)
SampleRate b -> f
f

instance
   (a ~ b, Quantity quantity b, Wrapped a f) =>
      Wrapped a (Arg quantity b -> f) where
   type Unwrapped (Arg quantity b -> f) = b -> Unwrapped f
   wrapped :: (Arg quantity b -> f)
-> SampleRate a -> Unwrapped (Arg quantity b -> f)
wrapped Arg quantity b -> f
f SampleRate a
sampleRate b
arg =
      f -> SampleRate a -> Unwrapped f
forall a f. Wrapped a f => f -> SampleRate a -> Unwrapped f
wrapped (Arg quantity b -> f
f (SampleRate b -> b -> Arg quantity b
forall quantity a.
Quantity quantity a =>
SampleRate a -> a -> Arg quantity a
eval SampleRate a
SampleRate b
sampleRate b
arg)) SampleRate a
sampleRate

instance
   (a ~ b, Input signal b, Wrapped a f) =>
      Wrapped a (InputArg signal b -> f) where
   type Unwrapped (InputArg signal b -> f) =
         InputSource signal b -> Unwrapped f
   wrapped :: (InputArg signal b -> f)
-> SampleRate a -> Unwrapped (InputArg signal b -> f)
wrapped InputArg signal b -> f
f SampleRate a
sampleRate InputSource signal b
arg =
      f -> SampleRate a -> Unwrapped f
forall a f. Wrapped a f => f -> SampleRate a -> Unwrapped f
wrapped (InputArg signal b -> f
f (SampleRate b -> InputSource signal b -> InputArg signal b
forall signal a.
Input signal a =>
SampleRate a -> InputSource signal a -> InputArg signal a
evalInput SampleRate a
SampleRate b
sampleRate InputSource signal b
arg)) SampleRate a
sampleRate

instance
   (ArgTuple a b, ArgTuple a c, Wrapped a f) =>
      Wrapped a ((b,c) -> f) where
   type Unwrapped ((b,c) -> f) = (ArgPlain b, ArgPlain c) -> Unwrapped f
   wrapped :: ((b, c) -> f) -> SampleRate a -> Unwrapped ((b, c) -> f)
wrapped (b, c) -> f
f SampleRate a
sampleRate (ArgPlain b, ArgPlain c)
arg =
      f -> SampleRate a -> Unwrapped f
forall a f. Wrapped a f => f -> SampleRate a -> Unwrapped f
wrapped ((b, c) -> f
f (SampleRate a -> ArgPlain (b, c) -> (b, c)
forall a tuple.
ArgTuple a tuple =>
SampleRate a -> ArgPlain tuple -> tuple
evalTuple SampleRate a
sampleRate (ArgPlain b, ArgPlain c)
ArgPlain (b, c)
arg)) SampleRate a
sampleRate

instance
   (ArgTuple a b, ArgTuple a c, ArgTuple a d, Wrapped a f) =>
      Wrapped a ((b,c,d) -> f) where
   type Unwrapped ((b,c,d) -> f) =
         (ArgPlain b, ArgPlain c, ArgPlain d) -> Unwrapped f
   wrapped :: ((b, c, d) -> f) -> SampleRate a -> Unwrapped ((b, c, d) -> f)
wrapped (b, c, d) -> f
f SampleRate a
sampleRate (ArgPlain b, ArgPlain c, ArgPlain d)
arg =
      f -> SampleRate a -> Unwrapped f
forall a f. Wrapped a f => f -> SampleRate a -> Unwrapped f
wrapped ((b, c, d) -> f
f (SampleRate a -> ArgPlain (b, c, d) -> (b, c, d)
forall a tuple.
ArgTuple a tuple =>
SampleRate a -> ArgPlain tuple -> tuple
evalTuple SampleRate a
sampleRate (ArgPlain b, ArgPlain c, ArgPlain d)
ArgPlain (b, c, d)
arg)) SampleRate a
sampleRate


{-# INLINE amplitudeFromVelocity #-}
amplitudeFromVelocity :: (Trans.C a) => a -> a
amplitudeFromVelocity :: forall a. C a => a -> a
amplitudeFromVelocity a
vel = Integer -> a
forall a. C a => Integer -> a
fromInteger Integer
4 a -> a -> a
forall a. C a => a -> a -> a
^? a
vel


piecewiseConstant :: (Memory.C a) => Sig.T (Const.T a) -> Sig.T a
piecewiseConstant :: forall a. C a => T (T a) -> T a
piecewiseConstant = T (T a) -> T a
forall a. C a => T (T a) -> T a
Const.flatten

transposeModulation :: (Field.C a, Expr.Aggregate a am) =>
   SampleRate a -> a -> Sig.T (Const.T (BM.T am)) -> Sig.T (Const.T (BM.T am))
transposeModulation :: forall a am.
(C a, Aggregate a am) =>
SampleRate a -> a -> T (T (T am)) -> T (T (T am))
transposeModulation (SampleRate a
sampleRate) a
freq T (T (T am))
xs =
   (T a -> T a) -> T (T (T am)) (T (T am))
forall a am b bm.
(Aggregate a am, Aggregate b bm) =>
(a -> b) -> T (T am) (T bm)
Const.causalMap (a -> T a -> T a
forall a. C a => a -> T a -> T a
BM.shift (a
freqa -> a -> a
forall a. C a => a -> a -> a
/a
sampleRate)) T (T (T am)) (T (T am))
-> SignalOf T (T (T am)) -> SignalOf T (T (T am))
forall (process :: * -> * -> *) a b.
C process =>
process a b -> SignalOf process a -> SignalOf process b
$* SignalOf T (T (T am))
T (T (T am))
xs



pioApply ::
   (Storable a, Storable b) =>
   PIO.T (SV.Vector a) (SV.Vector b) -> SVL.Vector a -> SVL.Vector b
pioApply :: forall a b.
(Storable a, Storable b) =>
T (Vector a) (Vector b) -> Vector a -> Vector b
pioApply = (Vector a -> Vector b)
-> T (Vector a) (Vector b) -> Vector a -> Vector b
forall a b.
(Storable a, Storable b) =>
(Vector a -> Vector b)
-> T (Vector a) (Vector b) -> Vector a -> Vector b
pioApplyCont (Vector b -> Vector a -> Vector b
forall a b. a -> b -> a
const Vector b
forall a. Storable a => Vector a
SVL.empty)

pioApplyCont ::
   (Storable a, Storable b) =>
   (SVL.Vector a -> SVL.Vector b) ->
   PIO.T (SV.Vector a) (SV.Vector b) -> SVL.Vector a -> SVL.Vector b
pioApplyCont :: forall a b.
(Storable a, Storable b) =>
(Vector a -> Vector b)
-> T (Vector a) (Vector b) -> Vector a -> Vector b
pioApplyCont Vector a -> Vector b
cont T (Vector a) (Vector b)
proc Vector a
sig = IO (Vector b) -> Vector b
forall a. IO a -> a
Unsafe.performIO (IO (Vector b) -> Vector b) -> IO (Vector b) -> Vector b
forall a b. (a -> b) -> a -> b
$ do
   (Vector a -> Vector b) -> Vector a -> Vector b
act <- T (Vector a) (Vector b)
-> IO ((Vector a -> Vector b) -> Vector a -> Vector b)
forall a b.
(Storable a, Storable b) =>
T (Vector a) (Vector b)
-> IO ((Vector a -> Vector b) -> Vector a -> Vector b)
PIO.runStorableChunkyCont T (Vector a) (Vector b)
proc
   Vector b -> IO (Vector b)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector b -> IO (Vector b)) -> Vector b -> IO (Vector b)
forall a b. (a -> b) -> a -> b
$ (Vector a -> Vector b) -> Vector a -> Vector b
act Vector a -> Vector b
cont Vector a
sig

pioApplyToLazyTime ::
   (Storable b) =>
   PIO.T SigG.LazySize (SV.Vector b) -> Ev.LazyTime -> SVL.Vector b
pioApplyToLazyTime :: forall b.
Storable b =>
T LazySize (Vector b) -> LazyTime -> Vector b
pioApplyToLazyTime T LazySize (Vector b)
proc LazyTime
sig = IO (Vector b) -> Vector b
forall a. IO a -> a
Unsafe.performIO (IO (Vector b) -> Vector b) -> IO (Vector b) -> Vector b
forall a b. (a -> b) -> a -> b
$ do
   ([LazySize] -> [Vector b]) -> [LazySize] -> [Vector b]
act <- T LazySize (Vector b)
-> IO (([LazySize] -> [Vector b]) -> [LazySize] -> [Vector b])
forall a b.
(Transform a, Transform b) =>
T a b -> IO (([a] -> [b]) -> [a] -> [b])
PIO.runCont T LazySize (Vector b)
proc
   Vector b -> IO (Vector b)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector b -> IO (Vector b)) -> Vector b -> IO (Vector b)
forall a b. (a -> b) -> a -> b
$ [Vector b] -> Vector b
forall a. Storable a => [Vector a] -> Vector a
SVL.fromChunks ([Vector b] -> Vector b) -> [Vector b] -> Vector b
forall a b. (a -> b) -> a -> b
$ ([LazySize] -> [Vector b]) -> [LazySize] -> [Vector b]
act ([Vector b] -> [LazySize] -> [Vector b]
forall a b. a -> b -> a
const []) ([LazySize] -> [Vector b]) -> [LazySize] -> [Vector b]
forall a b. (a -> b) -> a -> b
$
      (T Int -> LazySize) -> [T Int] -> [LazySize]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> LazySize
SigG.LazySize (Int -> LazySize) -> (T Int -> Int) -> T Int -> LazySize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T Int -> Int
forall a. T a -> a
NonNegW.toNumber) ([T Int] -> [LazySize]) -> [T Int] -> [LazySize]
forall a b. (a -> b) -> a -> b
$
      (StrictTime -> [T Int]) -> [StrictTime] -> [T Int]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap StrictTime -> [T Int]
PC.chopLongTime ([StrictTime] -> [T Int]) -> [StrictTime] -> [T Int]
forall a b. (a -> b) -> a -> b
$ LazyTime -> [StrictTime]
forall a. T a -> [a]
NonNegChunky.toChunks LazyTime
sig



controllerAttack, controllerDetune, controllerTimbre0, controllerTimbre1,
   controllerFilterCutoff, controllerFilterResonance,
   controllerVolume :: VoiceMsg.Controller
controllerAttack :: Controller
controllerAttack = Controller
Ctrl.attackTime
controllerDetune :: Controller
controllerDetune = Controller
Ctrl.chorusDepth   -- Ctrl.effect3Depth
controllerTimbre0 :: Controller
controllerTimbre0 = Controller
Ctrl.soundVariation
controllerTimbre1 :: Controller
controllerTimbre1 = Controller
Ctrl.timbre
controllerFilterCutoff :: Controller
controllerFilterCutoff = Controller
Ctrl.effect4Depth
controllerFilterResonance :: Controller
controllerFilterResonance = Controller
Ctrl.effect5Depth
controllerVolume :: Controller
controllerVolume = Controller
Ctrl.volume