{-# Language ScopedTypeVariables, TypeSynonymInstances, FlexibleInstances, LambdaCase #-}
-- | Patches.
module Csound.Air.Patch(

  CsdNote, Instr, MonoInstr, Fx, Fx1, Fx2, FxSpec(..), DryWetRatio,
  Patch1, Patch2, Patch(..), PolySyntSpec(..), MonoSyntSpec(..),
    SyntSkin, GenInstr, GenMonoInstr, GenFxSpec,
    polySynt, monoSynt, adsrMono, adsrMonoFilter, fxSpec, polySyntFilter, monoSyntFilter, fxSpecFilter,

    mapPatchInstr, mapMonoPolyInstr, transPatch, dryPatch, getPatchFx,
    setFxMix, setFxMixes,
    setMidiChn,

  -- * Midi
  atMidi,

  -- * Events
  atSched, atSchedUntil, atSchedHarp,

  -- * Sco
  atSco,

  -- * Single note
  atNote,

  -- * Fx
    addInstrFx, addPreFx, addPostFx,

    -- ** Specific fx
    fxSig, fxSigMix, fxSig2, fxSigMix2,
    mapFx, mapFx', bindFx, bindFx',
    mapPreFx, mapPreFx', bindPreFx, bindPreFx',

  -- * Pads
  harmonPatch, deepPad,

  -- * Misc
  patchWhen,

    mixInstr,

  -- * Rever
  withSmallRoom, withSmallRoom',
  withSmallHall, withSmallHall',
  withLargeHall, withLargeHall',
  withMagicCave, withMagicCave',

  -- * Sound font patches
  sfPatch, sfPatchHall,

    -- * Monosynt params
    onMonoSyntSpec, setMonoSlide, setMonoSharp,

    -- * Csound API
    patchByNameMidi,

  -- * Custom temperament
  -- ** Midi
  atMidiTemp,
  -- ** Csound API
    patchByNameMidiTemp
) where

import Data.Boolean hiding (cond)
import Data.Text (Text)
import Data.Default
import Control.Monad
import Control.Applicative
import Control.Arrow(second)

import Control.Monad.Trans.Reader
import Csound.Typed hiding (arg)
import Csound.Control.Midi
import Csound.Control.Instr
import Csound.Control.Evt(impulse)
import Csound.Control.Sf
import Csound.Air.Fx
import Csound.Air.Filter(ResonFilter, mlp)
import Csound.Typed.Opcode(cpsmidinn)
import Csound.Tuning
import Csound.Types

import Temporal.Media hiding (rest)
import Csound.IO

-- | Common parameters for patches. We use this type to parametrize the patch with some tpyes of arguments
-- that we'd like to be able to change after patch is already constructed. For instance the filter type can greatly
-- change the character of the patch. So by making patches depend on filter type we can let the user to change
-- the filter type and  leave the algorithm the same. It's like changing between trademarks. Moog sound vs Korg sound.
--
-- The instruments in the patches depend on the @SyntSkin@ through the @Reader@ data type.
--
-- If user doesn't supply any syntSkin value the default is used (`mlp` -- moog low pass filter). Right now
-- the data type is just a synonym for filter but it can become a data type with more parameters in the future releases.
type SyntSkin = ResonFilter

-- | Generic polyphonic instrument. It depends on @SyntSkin@.
type GenInstr a b = Reader SyntSkin (Instr a b)

-- | Generic FX. It depends on @SyntSkin@.
type GenFxSpec a = Reader SyntSkin (FxSpec a)

-- | Generic monophonic instrument. It depends on @SyntSkin@.
type GenMonoInstr a = Reader SyntSkin (MonoInstr a)

-- | Data type for monophonic instruments.
type MonoInstr a = MonoArg -> SE a

-- | A simple csound note (good for playing with midi-keyboard).
-- It's a pair of amplitude (0 to 1) and freuqncy (Hz).
type CsdNote a = (a, a)

-- | An instrument transforms a note to a signal.
type Instr a b = CsdNote a -> SE b

-- | An effect processes the input signal.
type Fx a = a  -> SE a
type DryWetRatio = Sig

-- | Mono effect.
type Fx1 = Fx Sig

-- | Stereo effect.
type Fx2 = Fx Sig2

-- | Fx specification. It;s a pair of dryWet ratio and a transformation function.
data FxSpec a = FxSpec
  { forall a. FxSpec a -> Sig
fxMix :: DryWetRatio
  , forall a. FxSpec a -> Fx a
fxFun :: Fx a
  }

-- | Mono-output patch.
type Patch1 = Patch Sig

-- | Stereo-output patch.
type Patch2 = Patch Sig2

-- | Specification for monophonic synthesizer.
--
-- * Chn -- midi channel to listen on
--
-- * SlideTime -- time of transition between notes
data MonoSyntSpec = MonoSyntSpec
    { MonoSyntSpec -> MidiChn
monoSyntChn       :: MidiChn
    , MonoSyntSpec -> Maybe D
monoSyntSlideTime :: Maybe D }

instance Default MonoSyntSpec where
    def :: MonoSyntSpec
def = MonoSyntSpec
        { monoSyntChn :: MidiChn
monoSyntChn = MidiChn
ChnAll
        , monoSyntSlideTime :: Maybe D
monoSyntSlideTime = D -> Maybe D
forall a. a -> Maybe a
Just D
0.008 }

data PolySyntSpec = PolySyntSpec
    { PolySyntSpec -> MidiChn
polySyntChn :: MidiChn }

instance Default PolySyntSpec where
    def :: PolySyntSpec
def = PolySyntSpec { polySyntChn :: MidiChn
polySyntChn = MidiChn
ChnAll }

-- | The patch can be:
--
-- *  a monophonic synt
--
-- * polyphonic synt
--
-- * set of common parameters (@SyntSkin@)
--
-- * patch with chain of effects,
--
-- * split on keyboard with certain frequency
--
-- * layer of patches. That is a several patches that sound at the same time.
--  the layer is a patch and the weight of volume for a given patch.
data Patch a
    = MonoSynt MonoSyntSpec (GenMonoInstr a) -- (GenInstr Sig a)
    | PolySynt PolySyntSpec (GenInstr D   a)
    | SetSkin SyntSkin (Patch a)
    | FxChain [GenFxSpec a] (Patch a)
    | SplitPatch (Patch a) D (Patch a)
    | LayerPatch [(Sig, Patch a)]

smoothMonoSpec :: MonoSyntSpec -> MonoArg -> MonoArg
smoothMonoSpec :: MonoSyntSpec -> MonoArg -> MonoArg
smoothMonoSpec MonoSyntSpec
spec = (MonoArg -> MonoArg)
-> (D -> MonoArg -> MonoArg) -> Maybe D -> MonoArg -> MonoArg
forall b a. b -> (a -> b) -> Maybe a -> b
maybe MonoArg -> MonoArg
forall a. a -> a
id D -> MonoArg -> MonoArg
smoothMonoArg (MonoSyntSpec -> Maybe D
monoSyntSlideTime MonoSyntSpec
spec)

-- | Constructor for polyphonic synthesizer. It expects a function from notes to signals.
polySynt :: (Instr D a) -> Patch a
polySynt :: forall a. Instr D a -> Patch a
polySynt = PolySyntSpec -> GenInstr D a -> Patch a
forall a. PolySyntSpec -> GenInstr D a -> Patch a
PolySynt PolySyntSpec
forall a. Default a => a
def (GenInstr D a -> Patch a)
-> (Instr D a -> GenInstr D a) -> Instr D a -> Patch a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Instr D a -> GenInstr D a
forall a. a -> ReaderT SyntSkin Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return

-- | Constructor for polyphonic synthesizer with flexible choice of the low-pass filter.
-- If we use the filter from the first argument user lately can change it to some another filter. It defaults to mlp.
polySyntFilter :: (ResonFilter -> Instr D a) -> Patch a
polySyntFilter :: forall a. (SyntSkin -> Instr D a) -> Patch a
polySyntFilter SyntSkin -> Instr D a
instr = PolySyntSpec -> GenInstr D a -> Patch a
forall a. PolySyntSpec -> GenInstr D a -> Patch a
PolySynt PolySyntSpec
forall a. Default a => a
def (GenInstr D a -> Patch a) -> GenInstr D a -> Patch a
forall a b. (a -> b) -> a -> b
$ (SyntSkin -> Instr D a) -> GenInstr D a
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
reader SyntSkin -> Instr D a
instr

-- | Constructor for monophonic synth with envelope generator. The envelope generator is synced with note triggering.
-- So it restarts itself when the note is retriggered. The envelope generator is a simple ADSR gennerator see the type @MonoAdsr@.
adsrMono :: (MonoAdsr -> Instr Sig a) -> Patch a
adsrMono :: forall a. (MonoAdsr -> Instr Sig a) -> Patch a
adsrMono MonoAdsr -> Instr Sig a
f = MonoInstr a -> Patch a
forall a. MonoInstr a -> Patch a
monoSynt ((MonoAdsr -> Instr Sig a) -> MonoInstr a
forall a. (MonoAdsr -> (Sig, Sig) -> a) -> MonoArg -> a
adsrMonoSynt MonoAdsr -> Instr Sig a
f)

-- | Constructor for monophonic synth with envelope generator and flexible choice of filter. It's just like @adsrMono@
-- but the user lately can change filter provided in the first argument to some another filter.
adsrMonoFilter :: (ResonFilter -> MonoAdsr -> Instr Sig a) -> Patch a
adsrMonoFilter :: forall a. (SyntSkin -> MonoAdsr -> Instr Sig a) -> Patch a
adsrMonoFilter SyntSkin -> MonoAdsr -> Instr Sig a
f = (SyntSkin -> MonoInstr a) -> Patch a
forall a. (SyntSkin -> MonoInstr a) -> Patch a
monoSyntFilter (\SyntSkin
fltr -> (MonoAdsr -> Instr Sig a) -> MonoInstr a
forall a. (MonoAdsr -> (Sig, Sig) -> a) -> MonoArg -> a
adsrMonoSynt (SyntSkin -> MonoAdsr -> Instr Sig a
f SyntSkin
fltr))

-- | Constructor for monophonic synthesizer. The instrument is defned on the raw monophonic aruments (see @MonoArg@).
monoSynt :: (MonoInstr a) -> Patch a
monoSynt :: forall a. MonoInstr a -> Patch a
monoSynt = MonoSyntSpec -> GenMonoInstr a -> Patch a
forall a. MonoSyntSpec -> GenMonoInstr a -> Patch a
MonoSynt MonoSyntSpec
forall a. Default a => a
def (GenMonoInstr a -> Patch a)
-> (MonoInstr a -> GenMonoInstr a) -> MonoInstr a -> Patch a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MonoInstr a -> GenMonoInstr a
forall a. a -> ReaderT SyntSkin Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return

-- | Constructor for monophonic synthesizer with flexible filter choice.
monoSyntFilter :: (ResonFilter -> MonoInstr a) -> Patch a
monoSyntFilter :: forall a. (SyntSkin -> MonoInstr a) -> Patch a
monoSyntFilter SyntSkin -> MonoInstr a
instr = MonoSyntSpec -> GenMonoInstr a -> Patch a
forall a. MonoSyntSpec -> GenMonoInstr a -> Patch a
MonoSynt MonoSyntSpec
forall a. Default a => a
def (GenMonoInstr a -> Patch a) -> GenMonoInstr a -> Patch a
forall a b. (a -> b) -> a -> b
$ (SyntSkin -> MonoInstr a) -> GenMonoInstr a
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
reader SyntSkin -> MonoInstr a
instr

-- | Constructor for FX-specification.
--
-- > fxSpec dryWetRatio fxFun
fxSpec :: Sig -> Fx a -> GenFxSpec a
fxSpec :: forall a. Sig -> Fx a -> GenFxSpec a
fxSpec Sig
ratio Fx a
fx = FxSpec a -> ReaderT SyntSkin Identity (FxSpec a)
forall a. a -> ReaderT SyntSkin Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (FxSpec a -> ReaderT SyntSkin Identity (FxSpec a))
-> FxSpec a -> ReaderT SyntSkin Identity (FxSpec a)
forall a b. (a -> b) -> a -> b
$ Sig -> Fx a -> FxSpec a
forall a. Sig -> Fx a -> FxSpec a
FxSpec Sig
ratio Fx a
fx

-- | Constructor for FX-specification with flexible filter choice.
--
-- > fxSpec dryWetRatio fxFun
fxSpecFilter :: Sig -> (ResonFilter -> Fx a) -> GenFxSpec a
fxSpecFilter :: forall a. Sig -> (SyntSkin -> Fx a) -> GenFxSpec a
fxSpecFilter Sig
ratio SyntSkin -> Fx a
fx = (SyntSkin -> FxSpec a) -> ReaderT SyntSkin Identity (FxSpec a)
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
reader ((SyntSkin -> FxSpec a) -> ReaderT SyntSkin Identity (FxSpec a))
-> (SyntSkin -> FxSpec a) -> ReaderT SyntSkin Identity (FxSpec a)
forall a b. (a -> b) -> a -> b
$ \SyntSkin
resonFilter -> Sig -> Fx a -> FxSpec a
forall a. Sig -> Fx a -> FxSpec a
FxSpec Sig
ratio (SyntSkin -> Fx a
fx SyntSkin
resonFilter)

-- Maps all monophonic and polyphonic patches within the given patch.
mapMonoPolyInstr :: (MonoInstr a -> MonoInstr a) -> (Instr D a -> Instr D a) -> Patch a -> Patch a
mapMonoPolyInstr :: forall a.
(MonoInstr a -> MonoInstr a)
-> (Instr D a -> Instr D a) -> Patch a -> Patch a
mapMonoPolyInstr MonoInstr a -> MonoInstr a
mono Instr D a -> Instr D a
poly Patch a
x = case Patch a
x of
    MonoSynt MonoSyntSpec
spec GenMonoInstr a
instr -> MonoSyntSpec -> GenMonoInstr a -> Patch a
forall a. MonoSyntSpec -> GenMonoInstr a -> Patch a
MonoSynt MonoSyntSpec
spec ((MonoInstr a -> MonoInstr a) -> GenMonoInstr a -> GenMonoInstr a
forall a b.
(a -> b)
-> ReaderT SyntSkin Identity a -> ReaderT SyntSkin Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MonoInstr a -> MonoInstr a
mono GenMonoInstr a
instr)
    PolySynt PolySyntSpec
spec GenInstr D a
instr -> PolySyntSpec -> GenInstr D a -> Patch a
forall a. PolySyntSpec -> GenInstr D a -> Patch a
PolySynt PolySyntSpec
spec ((Instr D a -> Instr D a) -> GenInstr D a -> GenInstr D a
forall a b.
(a -> b)
-> ReaderT SyntSkin Identity a -> ReaderT SyntSkin Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Instr D a -> Instr D a
poly GenInstr D a
instr)
    SetSkin SyntSkin
skin Patch a
p      -> SyntSkin -> Patch a -> Patch a
forall a. SyntSkin -> Patch a -> Patch a
SetSkin SyntSkin
skin (Patch a -> Patch a
rec Patch a
p)
    FxChain  [GenFxSpec a]
fxs Patch a
p      -> [GenFxSpec a] -> Patch a -> Patch a
forall a. [GenFxSpec a] -> Patch a -> Patch a
FxChain [GenFxSpec a]
fxs (Patch a -> Patch a
rec Patch a
p)
    LayerPatch [(Sig, Patch a)]
xs       -> [(Sig, Patch a)] -> Patch a
forall a. [(Sig, Patch a)] -> Patch a
LayerPatch ((Patch a -> Patch a) -> [(Sig, Patch a)] -> [(Sig, Patch a)]
forall a b c. (a -> b) -> [(c, a)] -> [(c, b)]
mapSnd Patch a -> Patch a
rec [(Sig, Patch a)]
xs)
    SplitPatch Patch a
a D
dt Patch a
b   -> Patch a -> D -> Patch a -> Patch a
forall a. Patch a -> D -> Patch a -> Patch a
SplitPatch (Patch a -> Patch a
rec Patch a
a) D
dt (Patch a -> Patch a
rec Patch a
b)
    where
        rec :: Patch a -> Patch a
rec = (MonoInstr a -> MonoInstr a)
-> (Instr D a -> Instr D a) -> Patch a -> Patch a
forall a.
(MonoInstr a -> MonoInstr a)
-> (Instr D a -> Instr D a) -> Patch a -> Patch a
mapMonoPolyInstr MonoInstr a -> MonoInstr a
mono Instr D a -> Instr D a
poly

-- Maps all polyphonic patches within the given patch.
mapPatchInstr :: (Instr D a -> Instr D a) -> Patch a -> Patch a
mapPatchInstr :: forall a. (Instr D a -> Instr D a) -> Patch a -> Patch a
mapPatchInstr Instr D a -> Instr D a
f Patch a
x = case Patch a
x of
    MonoSynt MonoSyntSpec
_ GenMonoInstr a
_ -> Patch a
x
    PolySynt PolySyntSpec
spec GenInstr D a
instr -> PolySyntSpec -> GenInstr D a -> Patch a
forall a. PolySyntSpec -> GenInstr D a -> Patch a
PolySynt PolySyntSpec
spec (GenInstr D a -> Patch a) -> GenInstr D a -> Patch a
forall a b. (a -> b) -> a -> b
$ (Instr D a -> Instr D a) -> GenInstr D a -> GenInstr D a
forall a b.
(a -> b)
-> ReaderT SyntSkin Identity a -> ReaderT SyntSkin Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Instr D a -> Instr D a
f GenInstr D a
instr
    SetSkin SyntSkin
skin Patch a
p -> SyntSkin -> Patch a -> Patch a
forall a. SyntSkin -> Patch a -> Patch a
SetSkin SyntSkin
skin (Patch a -> Patch a
rec Patch a
p)
    FxChain [GenFxSpec a]
fxs Patch a
p -> [GenFxSpec a] -> Patch a -> Patch a
forall a. [GenFxSpec a] -> Patch a -> Patch a
FxChain [GenFxSpec a]
fxs (Patch a -> Patch a) -> Patch a -> Patch a
forall a b. (a -> b) -> a -> b
$ Patch a -> Patch a
rec Patch a
p
    LayerPatch [(Sig, Patch a)]
xs -> [(Sig, Patch a)] -> Patch a
forall a. [(Sig, Patch a)] -> Patch a
LayerPatch ((Patch a -> Patch a) -> [(Sig, Patch a)] -> [(Sig, Patch a)]
forall a b c. (a -> b) -> [(c, a)] -> [(c, b)]
mapSnd Patch a -> Patch a
rec [(Sig, Patch a)]
xs)
    SplitPatch Patch a
a D
dt Patch a
b -> Patch a -> D -> Patch a -> Patch a
forall a. Patch a -> D -> Patch a -> Patch a
SplitPatch (Patch a -> Patch a
rec Patch a
a) D
dt (Patch a -> Patch a
rec Patch a
b)
    where
        rec :: Patch a -> Patch a
rec = (Instr D a -> Instr D a) -> Patch a -> Patch a
forall a. (Instr D a -> Instr D a) -> Patch a -> Patch a
mapPatchInstr Instr D a -> Instr D a
f

-- | Removes all effects from the patch.
dryPatch :: Patch a -> Patch a
dryPatch :: forall a. Patch a -> Patch a
dryPatch Patch a
patch = case Patch a
patch of
    MonoSynt MonoSyntSpec
_ GenMonoInstr a
_ -> Patch a
patch
    PolySynt PolySyntSpec
_ GenInstr D a
_ -> Patch a
patch
    SetSkin SyntSkin
skin Patch a
p -> SyntSkin -> Patch a -> Patch a
forall a. SyntSkin -> Patch a -> Patch a
SetSkin SyntSkin
skin (Patch a -> Patch a
forall a. Patch a -> Patch a
dryPatch Patch a
p)
    FxChain [GenFxSpec a]
_ Patch a
p         -> Patch a -> Patch a
forall a. Patch a -> Patch a
dryPatch Patch a
p
    SplitPatch Patch a
a D
dt Patch a
b   -> Patch a -> D -> Patch a -> Patch a
forall a. Patch a -> D -> Patch a -> Patch a
SplitPatch (Patch a -> Patch a
forall a. Patch a -> Patch a
dryPatch Patch a
a) D
dt (Patch a -> Patch a
forall a. Patch a -> Patch a
dryPatch Patch a
b)
    LayerPatch [(Sig, Patch a)]
xs       -> [(Sig, Patch a)] -> Patch a
forall a. [(Sig, Patch a)] -> Patch a
LayerPatch ([(Sig, Patch a)] -> Patch a) -> [(Sig, Patch a)] -> Patch a
forall a b. (a -> b) -> a -> b
$ (Patch a -> Patch a) -> [(Sig, Patch a)] -> [(Sig, Patch a)]
forall a b c. (a -> b) -> [(c, a)] -> [(c, b)]
mapSnd Patch a -> Patch a
forall a. Patch a -> Patch a
dryPatch [(Sig, Patch a)]
xs

-- | Sets the dryWet ratio of the effects wwithin the patch.
setFxMix :: Sig -> Patch a -> Patch a
setFxMix :: forall a. Sig -> Patch a -> Patch a
setFxMix Sig
a = [Sig] -> Patch a -> Patch a
forall a. [Sig] -> Patch a -> Patch a
setFxMixes [Sig
a]

-- | Sets the dryWet ratios for the chain of the effects wwithin the patch.
setFxMixes :: [Sig] -> Patch a -> Patch a
setFxMixes :: forall a. [Sig] -> Patch a -> Patch a
setFxMixes [Sig]
ks = \case
    FxChain [GenFxSpec a]
fxs Patch a
x -> [GenFxSpec a] -> Patch a -> Patch a
forall a. [GenFxSpec a] -> Patch a -> Patch a
FxChain ((Sig -> GenFxSpec a -> GenFxSpec a)
-> [Sig] -> [GenFxSpec a] -> [GenFxSpec a]
forall {t} {t}. (t -> t -> t) -> [t] -> [t] -> [t]
zipFirst (\Sig
k GenFxSpec a
q -> (FxSpec a -> FxSpec a) -> GenFxSpec a -> GenFxSpec a
forall a b.
(a -> b)
-> ReaderT SyntSkin Identity a -> ReaderT SyntSkin Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\FxSpec a
t -> FxSpec a
t { fxMix = k }) GenFxSpec a
q) [Sig]
ks [GenFxSpec a]
fxs) Patch a
x
    Patch a
other -> Patch a
other
    where
        zipFirst :: (t -> t -> t) -> [t] -> [t] -> [t]
zipFirst t -> t -> t
f [t]
xs [t]
ys = case ([t]
xs, [t]
ys) of
            ([t]
_,    [])   -> []
            ([],   [t]
bs)   -> [t]
bs
            (t
a:[t]
as, t
b:[t]
bs) -> t -> t -> t
f t
a t
b t -> [t] -> [t]
forall a. a -> [a] -> [a]
: (t -> t -> t) -> [t] -> [t] -> [t]
zipFirst t -> t -> t
f [t]
as [t]
bs

--------------------------------------------------------------

instance SigSpace a => SigSpace (Patch a) where
  mapSig :: (Sig -> Sig) -> Patch a -> Patch a
mapSig Sig -> Sig
f Patch a
x =
            case Patch a
x of
                MonoSynt MonoSyntSpec
spec GenMonoInstr a
instr -> MonoSyntSpec -> GenMonoInstr a -> Patch a
forall a. MonoSyntSpec -> GenMonoInstr a -> Patch a
MonoSynt MonoSyntSpec
spec (GenMonoInstr a -> Patch a) -> GenMonoInstr a -> Patch a
forall a b. (a -> b) -> a -> b
$ (MonoInstr a -> MonoInstr a) -> GenMonoInstr a -> GenMonoInstr a
forall a b.
(a -> b)
-> ReaderT SyntSkin Identity a -> ReaderT SyntSkin Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> a) -> SE a -> SE a
forall a b. (a -> b) -> SE a -> SE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Sig -> Sig) -> a -> a
forall a. SigSpace a => (Sig -> Sig) -> a -> a
mapSig Sig -> Sig
f) (SE a -> SE a) -> MonoInstr a -> MonoInstr a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ) (GenMonoInstr a -> GenMonoInstr a)
-> GenMonoInstr a -> GenMonoInstr a
forall a b. (a -> b) -> a -> b
$ GenMonoInstr a
instr
                PolySynt PolySyntSpec
spec GenInstr D a
instr -> PolySyntSpec -> GenInstr D a -> Patch a
forall a. PolySyntSpec -> GenInstr D a -> Patch a
PolySynt PolySyntSpec
spec (GenInstr D a -> Patch a) -> GenInstr D a -> Patch a
forall a b. (a -> b) -> a -> b
$ (Instr D a -> Instr D a) -> GenInstr D a -> GenInstr D a
forall a b.
(a -> b)
-> ReaderT SyntSkin Identity a -> ReaderT SyntSkin Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> a) -> SE a -> SE a
forall a b. (a -> b) -> SE a -> SE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Sig -> Sig) -> a -> a
forall a. SigSpace a => (Sig -> Sig) -> a -> a
mapSig Sig -> Sig
f) (SE a -> SE a) -> Instr D a -> Instr D a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ) (GenInstr D a -> GenInstr D a) -> GenInstr D a -> GenInstr D a
forall a b. (a -> b) -> a -> b
$ GenInstr D a
instr
                SetSkin SyntSkin
skin Patch a
p -> SyntSkin -> Patch a -> Patch a
forall a. SyntSkin -> Patch a -> Patch a
SetSkin SyntSkin
skin (Patch a -> Patch a) -> Patch a -> Patch a
forall a b. (a -> b) -> a -> b
$ (Sig -> Sig) -> Patch a -> Patch a
forall a. SigSpace a => (Sig -> Sig) -> a -> a
mapSig Sig -> Sig
f Patch a
p
                FxChain [GenFxSpec a]
fxs Patch a
p  -> [GenFxSpec a] -> Patch a -> Patch a
forall a. [GenFxSpec a] -> Patch a -> Patch a
FxChain [GenFxSpec a]
fxs (Patch a -> Patch a) -> Patch a -> Patch a
forall a b. (a -> b) -> a -> b
$ (Sig -> Sig) -> Patch a -> Patch a
forall a. SigSpace a => (Sig -> Sig) -> a -> a
mapSig Sig -> Sig
f Patch a
p
                SplitPatch Patch a
a D
dt Patch a
b -> Patch a -> D -> Patch a -> Patch a
forall a. Patch a -> D -> Patch a -> Patch a
SplitPatch ((Sig -> Sig) -> Patch a -> Patch a
forall a. SigSpace a => (Sig -> Sig) -> a -> a
mapSig Sig -> Sig
f Patch a
a) D
dt ((Sig -> Sig) -> Patch a -> Patch a
forall a. SigSpace a => (Sig -> Sig) -> a -> a
mapSig Sig -> Sig
f Patch a
b)
                LayerPatch [(Sig, Patch a)]
xs  -> [GenFxSpec a] -> Patch a -> Patch a
forall a. [GenFxSpec a] -> Patch a -> Patch a
FxChain [FxSpec a -> GenFxSpec a
forall a. a -> ReaderT SyntSkin Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (FxSpec a -> GenFxSpec a) -> FxSpec a -> GenFxSpec a
forall a b. (a -> b) -> a -> b
$ Sig -> Fx a -> FxSpec a
forall a. Sig -> Fx a -> FxSpec a
FxSpec Sig
1 (Fx a
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return Fx a -> (a -> a) -> Fx a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sig -> Sig) -> a -> a
forall a. SigSpace a => (Sig -> Sig) -> a -> a
mapSig Sig -> Sig
f)] (Patch a -> Patch a) -> Patch a -> Patch a
forall a b. (a -> b) -> a -> b
$ [(Sig, Patch a)] -> Patch a
forall a. [(Sig, Patch a)] -> Patch a
LayerPatch [(Sig, Patch a)]
xs

mapSnd :: (a -> b) -> [(c, a)] -> [(c, b)]
mapSnd :: forall a b c. (a -> b) -> [(c, a)] -> [(c, b)]
mapSnd a -> b
f = ((c, a) -> (c, b)) -> [(c, a)] -> [(c, b)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> (c, a) -> (c, b)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second a -> b
f)

wet :: (SigSpace a, Sigs a) => FxSpec a -> Fx a
wet :: forall a. (SigSpace a, Sigs a) => FxSpec a -> Fx a
wet (FxSpec Sig
k Fx a
fx) a
asig = (a -> a) -> SE a -> SE a
forall a b. (a -> b) -> SE a -> SE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Sig -> a -> a
forall a. SigSpace a => Sig -> a -> a
mul (Sig
1 Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
- Sig
k) a
asig a -> a -> a
forall a. Num a => a -> a -> a
+ ) (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sig -> a -> a
forall a. SigSpace a => Sig -> a -> a
mul Sig
k) (SE a -> SE a) -> SE a -> SE a
forall a b. (a -> b) -> a -> b
$ Fx a
fx a
asig

-- | Renders the effect chain to a single function.
getPatchFx :: (SigSpace a, Sigs a) => Maybe SyntSkin -> [GenFxSpec a] -> Fx a
getPatchFx :: forall a.
(SigSpace a, Sigs a) =>
Maybe SyntSkin -> [GenFxSpec a] -> Fx a
getPatchFx Maybe SyntSkin
maybeSkin [GenFxSpec a]
xs = ((a -> SE a) -> (a -> SE a) -> a -> SE a)
-> (a -> SE a) -> [a -> SE a] -> a -> SE a
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (a -> SE a) -> (a -> SE a) -> a -> SE a
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
(<=<) a -> SE a
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return ([a -> SE a] -> a -> SE a) -> [a -> SE a] -> a -> SE a
forall a b. (a -> b) -> a -> b
$ (GenFxSpec a -> a -> SE a) -> [GenFxSpec a] -> [a -> SE a]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FxSpec a -> a -> SE a
forall a. (SigSpace a, Sigs a) => FxSpec a -> Fx a
wet (FxSpec a -> a -> SE a)
-> (GenFxSpec a -> FxSpec a) -> GenFxSpec a -> a -> SE a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenFxSpec a -> Maybe SyntSkin -> FxSpec a)
-> Maybe SyntSkin -> GenFxSpec a -> FxSpec a
forall a b c. (a -> b -> c) -> b -> a -> c
flip GenFxSpec a -> Maybe SyntSkin -> FxSpec a
forall a. Reader SyntSkin a -> Maybe SyntSkin -> a
runSkin Maybe SyntSkin
maybeSkin) [GenFxSpec a]
xs

-- | Plays a patch with a single infinite note.
atNote :: (SigSpace a, Sigs a) => Patch a -> CsdNote D -> SE a
atNote :: forall a. (SigSpace a, Sigs a) => Patch a -> CsdNote D -> SE a
atNote = Maybe SyntSkin -> Patch a -> CsdNote D -> SE a
forall {a}.
Sigs a =>
Maybe SyntSkin -> Patch a -> CsdNote D -> SE a
go Maybe SyntSkin
forall a. Maybe a
Nothing
    where
        go :: Maybe SyntSkin -> Patch a -> CsdNote D -> SE a
go Maybe SyntSkin
maybeSkin Patch a
q note :: CsdNote D
note@(D
amp, D
cps) = case Patch a
q of
            MonoSynt MonoSyntSpec
_spec GenMonoInstr a
instr -> (GenMonoInstr a -> Maybe SyntSkin -> MonoArg -> SE a
forall a. Reader SyntSkin a -> Maybe SyntSkin -> a
runSkin GenMonoInstr a
instr Maybe SyntSkin
maybeSkin) (Sig -> Sig -> Sig -> Sig -> MonoArg
MonoArg (D -> Sig
sig D
amp) (D -> Sig
sig D
cps) Sig
1 (D -> Sig
impulse D
0))
            PolySynt PolySyntSpec
_spec GenInstr D a
instr -> (GenInstr D a -> Maybe SyntSkin -> CsdNote D -> SE a
forall a. Reader SyntSkin a -> Maybe SyntSkin -> a
runSkin GenInstr D a
instr Maybe SyntSkin
maybeSkin) CsdNote D
note
            SetSkin  SyntSkin
skin Patch a
p -> SyntSkin -> Patch a -> SE a
newSkin SyntSkin
skin Patch a
p
            FxChain [GenFxSpec a]
fxs Patch a
p -> Maybe SyntSkin -> [GenFxSpec a] -> Fx a
forall a.
(SigSpace a, Sigs a) =>
Maybe SyntSkin -> [GenFxSpec a] -> Fx a
getPatchFx Maybe SyntSkin
maybeSkin [GenFxSpec a]
fxs Fx a -> SE a -> SE a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Patch a -> SE a
rec Patch a
p
            LayerPatch [(Sig, Patch a)]
xs -> [(Sig, Patch a)] -> (Patch a -> SE a) -> SE a
forall a.
(SigSpace a, Sigs a) =>
[(Sig, Patch a)] -> (Patch a -> SE a) -> SE a
onLayered [(Sig, Patch a)]
xs Patch a -> SE a
rec
            SplitPatch Patch a
a D
t Patch a
b -> BoolD -> SE a -> SE a -> SE a
forall a. (Num a, Tuple a) => BoolD -> SE a -> SE a -> SE a
getSplit (D
cps D -> D -> BooleanOf D
forall a. OrdB a => a -> a -> BooleanOf a
`lessThan` D
t) (Patch a -> SE a
rec Patch a
a) (Patch a -> SE a
rec Patch a
b)
            where
                rec :: Patch a -> SE a
rec Patch a
x = Maybe SyntSkin -> Patch a -> CsdNote D -> SE a
go Maybe SyntSkin
maybeSkin Patch a
x CsdNote D
note
                newSkin :: SyntSkin -> Patch a -> SE a
newSkin SyntSkin
skin Patch a
x = Maybe SyntSkin -> Patch a -> CsdNote D -> SE a
go (SyntSkin -> Maybe SyntSkin
forall a. a -> Maybe a
Just SyntSkin
skin) Patch a
x CsdNote D
note

runSkin :: Reader SyntSkin a -> Maybe SyntSkin -> a
runSkin :: forall a. Reader SyntSkin a -> Maybe SyntSkin -> a
runSkin Reader SyntSkin a
instr Maybe SyntSkin
maybeSkin = Reader SyntSkin a -> SyntSkin -> a
forall r a. Reader r a -> r -> a
runReader Reader SyntSkin a
instr (SyntSkin -> a) -> SyntSkin -> a
forall a b. (a -> b) -> a -> b
$ SyntSkin -> (SyntSkin -> SyntSkin) -> Maybe SyntSkin -> SyntSkin
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SyntSkin
mlp SyntSkin -> SyntSkin
forall a. a -> a
id Maybe SyntSkin
maybeSkin

getSplit :: (Num a, Tuple a) => BoolD -> SE a -> SE a -> SE a
getSplit :: forall a. (Num a, Tuple a) => BoolD -> SE a -> SE a -> SE a
getSplit BoolD
cond SE a
a SE a
b = do
    Ref a
ref <- a -> SE (Ref a)
forall a. Tuple a => a -> SE (Ref a)
newRef a
0
    BoolD -> SE () -> SE () -> SE ()
whenElseD BoolD
cond
        (Ref a -> a -> SE ()
forall a. (Num a, Tuple a) => Ref a -> a -> SE ()
mixRef Ref a
ref (a -> SE ()) -> SE a -> SE ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SE a
a)
        (Ref a -> a -> SE ()
forall a. (Num a, Tuple a) => Ref a -> a -> SE ()
mixRef Ref a
ref (a -> SE ()) -> SE a -> SE ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SE a
b)
    Ref a -> SE a
forall a. Tuple a => Ref a -> SE a
readRef Ref a
ref

--------------------------------------------------------------
-- midi

midiChn :: Sigs a => MidiChn -> (Msg -> SE a) -> SE a
midiChn :: forall a. Sigs a => MidiChn -> (Msg -> SE a) -> SE a
midiChn = \case
    MidiChn
ChnAll -> (Msg -> SE a) -> SE a
forall a. (Num a, Sigs a) => (Msg -> SE a) -> SE a
midi
    Chn Int
n  -> Int -> (Msg -> SE a) -> SE a
forall a. (Num a, Sigs a) => Int -> (Msg -> SE a) -> SE a
midin Int
n
    Pgm Maybe Int
pgm Int
chn -> Maybe Int -> Int -> (Msg -> SE a) -> SE a
forall a.
(Num a, Sigs a) =>
Maybe Int -> Int -> (Msg -> SE a) -> SE a
pgmidi Maybe Int
pgm Int
chn

-- | Plays a patch with midi.
atMidi :: (SigSpace a, Sigs a) => Patch a -> SE a
atMidi :: forall a. (SigSpace a, Sigs a) => Patch a -> SE a
atMidi = Maybe SyntSkin -> Patch a -> SE a
forall {b}. Sigs b => Maybe SyntSkin -> Patch b -> SE b
go Maybe SyntSkin
forall a. Maybe a
Nothing
    where
        go :: Maybe SyntSkin -> Patch b -> SE b
go Maybe SyntSkin
maybeSkin = \case
            MonoSynt MonoSyntSpec
spec GenMonoInstr b
instr -> MonoSyntSpec -> (MonoArg -> SE b) -> SE b
forall {b}. MonoSyntSpec -> (MonoArg -> SE b) -> SE b
monoSyntProc MonoSyntSpec
spec (GenMonoInstr b -> Maybe SyntSkin -> MonoArg -> SE b
forall a. Reader SyntSkin a -> Maybe SyntSkin -> a
runSkin GenMonoInstr b
instr Maybe SyntSkin
maybeSkin)
            PolySynt PolySyntSpec
spec GenInstr D b
instr -> MidiChn -> (Msg -> SE b) -> SE b
forall a. Sigs a => MidiChn -> (Msg -> SE a) -> SE a
midiChn (PolySyntSpec -> MidiChn
polySyntChn PolySyntSpec
spec) ((GenInstr D b -> Maybe SyntSkin -> CsdNote D -> SE b
forall a. Reader SyntSkin a -> Maybe SyntSkin -> a
runSkin GenInstr D b
instr Maybe SyntSkin
maybeSkin) (CsdNote D -> SE b) -> (Msg -> CsdNote D) -> Msg -> SE b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Msg -> CsdNote D
ampCps)
            SetSkin SyntSkin
skin Patch b
p -> SyntSkin -> Patch b -> SE b
newSkin SyntSkin
skin Patch b
p
            FxChain [GenFxSpec b]
fxs Patch b
p -> Maybe SyntSkin -> [GenFxSpec b] -> Fx b
forall a.
(SigSpace a, Sigs a) =>
Maybe SyntSkin -> [GenFxSpec a] -> Fx a
getPatchFx Maybe SyntSkin
maybeSkin [GenFxSpec b]
fxs Fx b -> SE b -> SE b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Patch b -> SE b
rec Patch b
p
            LayerPatch [(Sig, Patch b)]
xs -> [(Sig, Patch b)] -> (Patch b -> SE b) -> SE b
forall a.
(SigSpace a, Sigs a) =>
[(Sig, Patch a)] -> (Patch a -> SE a) -> SE a
onLayered [(Sig, Patch b)]
xs Patch b -> SE b
rec
            SplitPatch Patch b
a D
dt Patch b
b -> Maybe SyntSkin
-> (Msg -> CsdNote D) -> Patch b -> D -> Patch b -> SE b
forall a.
(SigSpace a, Sigs a) =>
Maybe SyntSkin
-> (Msg -> CsdNote D) -> Patch a -> D -> Patch a -> SE a
genMidiSplitPatch Maybe SyntSkin
maybeSkin Msg -> CsdNote D
ampCps Patch b
a D
dt Patch b
b
            where
                newSkin :: SyntSkin -> Patch b -> SE b
newSkin SyntSkin
skin Patch b
p = Maybe SyntSkin -> Patch b -> SE b
go (SyntSkin -> Maybe SyntSkin
forall a. a -> Maybe a
Just SyntSkin
skin) Patch b
p
                rec :: Patch b -> SE b
rec = Maybe SyntSkin -> Patch b -> SE b
go Maybe SyntSkin
maybeSkin

                monoSyntProc :: MonoSyntSpec -> (MonoArg -> SE b) -> SE b
monoSyntProc MonoSyntSpec
spec MonoArg -> SE b
instr = MonoArg -> SE b
instr (MonoArg -> SE b) -> SE MonoArg -> SE b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SE MonoArg
getArg
                    where
                        getArg :: SE MonoArg
getArg = (MonoArg -> MonoArg) -> SE MonoArg -> SE MonoArg
forall a b. (a -> b) -> SE a -> SE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (MonoSyntSpec -> MonoArg -> MonoArg
smoothMonoSpec MonoSyntSpec
spec) (SE MonoArg -> SE MonoArg) -> SE MonoArg -> SE MonoArg
forall a b. (a -> b) -> a -> b
$ MidiChn -> SE MonoArg
genMonoMsg MidiChn
chn
                        chn :: MidiChn
chn  = MonoSyntSpec -> MidiChn
monoSyntChn MonoSyntSpec
spec

-- | Plays a patch with midi with given temperament (see @Csound.Tuning@).
atMidiTemp :: (SigSpace a, Sigs a) => Temp -> Patch a -> SE a
atMidiTemp :: forall a. (SigSpace a, Sigs a) => Temp -> Patch a -> SE a
atMidiTemp Temp
tm = Maybe SyntSkin -> Patch a -> SE a
forall {b}. Sigs b => Maybe SyntSkin -> Patch b -> SE b
go Maybe SyntSkin
forall a. Maybe a
Nothing
    where
        go :: Maybe SyntSkin -> Patch b -> SE b
go Maybe SyntSkin
maybeSkin = \case
            MonoSynt MonoSyntSpec
spec GenMonoInstr b
instr -> MonoSyntSpec -> (MonoArg -> SE b) -> SE b
forall {b}. MonoSyntSpec -> (MonoArg -> SE b) -> SE b
monoSyntProc MonoSyntSpec
spec (GenMonoInstr b -> Maybe SyntSkin -> MonoArg -> SE b
forall a. Reader SyntSkin a -> Maybe SyntSkin -> a
runSkin GenMonoInstr b
instr Maybe SyntSkin
maybeSkin)
            PolySynt PolySyntSpec
spec GenInstr D b
instr -> MidiChn -> (Msg -> SE b) -> SE b
forall a. Sigs a => MidiChn -> (Msg -> SE a) -> SE a
midiChn (PolySyntSpec -> MidiChn
polySyntChn PolySyntSpec
spec) ((GenInstr D b -> Maybe SyntSkin -> CsdNote D -> SE b
forall a. Reader SyntSkin a -> Maybe SyntSkin -> a
runSkin GenInstr D b
instr Maybe SyntSkin
maybeSkin) (CsdNote D -> SE b) -> (Msg -> CsdNote D) -> Msg -> SE b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Temp -> Msg -> CsdNote D
ampCps' Temp
tm)
            SetSkin SyntSkin
skin Patch b
p -> SyntSkin -> Patch b -> SE b
newSkin SyntSkin
skin Patch b
p
            FxChain [GenFxSpec b]
fxs Patch b
p -> Maybe SyntSkin -> [GenFxSpec b] -> Fx b
forall a.
(SigSpace a, Sigs a) =>
Maybe SyntSkin -> [GenFxSpec a] -> Fx a
getPatchFx Maybe SyntSkin
maybeSkin [GenFxSpec b]
fxs Fx b -> SE b -> SE b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Patch b -> SE b
rec Patch b
p
            LayerPatch [(Sig, Patch b)]
xs -> [(Sig, Patch b)] -> (Patch b -> SE b) -> SE b
forall a.
(SigSpace a, Sigs a) =>
[(Sig, Patch a)] -> (Patch a -> SE a) -> SE a
onLayered [(Sig, Patch b)]
xs Patch b -> SE b
rec
            SplitPatch Patch b
a D
cps Patch b
b -> Maybe SyntSkin
-> (Msg -> CsdNote D) -> Patch b -> D -> Patch b -> SE b
forall a.
(SigSpace a, Sigs a) =>
Maybe SyntSkin
-> (Msg -> CsdNote D) -> Patch a -> D -> Patch a -> SE a
genMidiSplitPatch Maybe SyntSkin
maybeSkin (Temp -> Msg -> CsdNote D
ampCps' Temp
tm) Patch b
a D
cps Patch b
b
            where
                newSkin :: SyntSkin -> Patch b -> SE b
newSkin SyntSkin
skin Patch b
p = Maybe SyntSkin -> Patch b -> SE b
go (SyntSkin -> Maybe SyntSkin
forall a. a -> Maybe a
Just SyntSkin
skin) Patch b
p
                rec :: Patch b -> SE b
rec = Maybe SyntSkin -> Patch b -> SE b
go Maybe SyntSkin
maybeSkin

                monoSyntProc :: MonoSyntSpec -> (MonoArg -> SE b) -> SE b
monoSyntProc MonoSyntSpec
spec MonoArg -> SE b
instr = MonoArg -> SE b
instr (MonoArg -> SE b) -> SE MonoArg -> SE b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SE MonoArg
getArg
                    where
                        getArg :: SE MonoArg
getArg = (MonoArg -> MonoArg) -> SE MonoArg -> SE MonoArg
forall a b. (a -> b) -> SE a -> SE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (MonoSyntSpec -> MonoArg -> MonoArg
smoothMonoSpec MonoSyntSpec
spec) (SE MonoArg -> SE MonoArg) -> SE MonoArg -> SE MonoArg
forall a b. (a -> b) -> a -> b
$ Temp -> MidiChn -> SE MonoArg
genMonoMsgTemp Temp
tm MidiChn
chn
                        chn :: MidiChn
chn  = MonoSyntSpec -> MidiChn
monoSyntChn MonoSyntSpec
spec


genMidiSplitPatch :: (SigSpace a, Sigs a) => Maybe SyntSkin -> (Msg -> (D, D)) -> Patch a -> D -> Patch a -> SE a
genMidiSplitPatch :: forall a.
(SigSpace a, Sigs a) =>
Maybe SyntSkin
-> (Msg -> CsdNote D) -> Patch a -> D -> Patch a -> SE a
genMidiSplitPatch Maybe SyntSkin
maybeSkin Msg -> CsdNote D
midiArg = Maybe SyntSkin
-> (MidiChn -> (D -> BoolD) -> MonoInstr a -> SE a)
-> (MidiChn -> (CsdNote D -> SE a) -> SE a)
-> Patch a
-> D
-> Patch a
-> SE a
forall a.
(SigSpace a, Sigs a) =>
Maybe SyntSkin
-> (MidiChn -> (D -> BoolD) -> MonoInstr a -> SE a)
-> (MidiChn -> (CsdNote D -> SE a) -> SE a)
-> Patch a
-> D
-> Patch a
-> SE a
genSplitPatch Maybe SyntSkin
maybeSkin MidiChn -> (D -> BoolD) -> MonoInstr a -> SE a
forall {b}. MidiChn -> (D -> BoolD) -> (MonoArg -> SE b) -> SE b
playMonoInstr MidiChn -> (CsdNote D -> SE a) -> SE a
forall {a}. Sigs a => MidiChn -> (CsdNote D -> SE a) -> SE a
playInstr
    where
        playMonoInstr :: MidiChn -> (D -> BoolD) -> (MonoArg -> SE b) -> SE b
playMonoInstr MidiChn
chn D -> BoolD
cond MonoArg -> SE b
instr = MonoArg -> SE b
instr (MonoArg -> SE b) -> SE MonoArg -> SE b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MidiChn -> (D -> BoolD) -> SE MonoArg
genFilteredMonoMsg MidiChn
chn D -> BoolD
cond
        playInstr :: MidiChn -> (CsdNote D -> SE a) -> SE a
playInstr MidiChn
chn CsdNote D -> SE a
instr = MidiChn -> (Msg -> SE a) -> SE a
forall a. Sigs a => MidiChn -> (Msg -> SE a) -> SE a
midiChn MidiChn
chn (CsdNote D -> SE a
instr (CsdNote D -> SE a) -> (Msg -> CsdNote D) -> Msg -> SE a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Msg -> CsdNote D
midiArg)

genSplitPatch :: (SigSpace a, Sigs a) => Maybe SyntSkin -> (MidiChn -> (D -> BoolD) -> MonoInstr a -> SE a)  -> (MidiChn -> (CsdNote D -> SE a) -> SE a) -> Patch a -> D -> Patch a -> SE a
genSplitPatch :: forall a.
(SigSpace a, Sigs a) =>
Maybe SyntSkin
-> (MidiChn -> (D -> BoolD) -> MonoInstr a -> SE a)
-> (MidiChn -> (CsdNote D -> SE a) -> SE a)
-> Patch a
-> D
-> Patch a
-> SE a
genSplitPatch Maybe SyntSkin
maybeSkin' MidiChn -> (D -> BoolD) -> MonoInstr a -> SE a
playMonoInstr MidiChn -> (CsdNote D -> SE a) -> SE a
playInstr Patch a
a' D
dt' Patch a
b' = (a -> a -> a) -> SE a -> SE a -> SE a
forall a b c. (a -> b -> c) -> SE a -> SE b -> SE c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Num a => a -> a -> a
(+) (Maybe SyntSkin -> D -> Patch a -> SE a
leftSplit Maybe SyntSkin
maybeSkin' D
dt' Patch a
a') (Maybe SyntSkin -> D -> Patch a -> SE a
rightSplit Maybe SyntSkin
maybeSkin' D
dt' Patch a
b')
    where
        leftSplit :: Maybe SyntSkin -> D -> Patch a -> SE a
leftSplit  Maybe SyntSkin
maybeSkin D
dt Patch a
a = Maybe SyntSkin
-> (D -> BoolD) -> (Sig -> BoolSig) -> Patch a -> SE a
onCondPlay Maybe SyntSkin
maybeSkin ( D -> D -> BooleanOf D
forall a. OrdB a => a -> a -> BooleanOf a
`lessThan` D
dt)          ( Sig -> Sig -> BooleanOf Sig
forall a. OrdB a => a -> a -> BooleanOf a
`lessThan` (D -> Sig
sig D
dt))           Patch a
a
        rightSplit :: Maybe SyntSkin -> D -> Patch a -> SE a
rightSplit Maybe SyntSkin
maybeSkin D
dt Patch a
a = Maybe SyntSkin
-> (D -> BoolD) -> (Sig -> BoolSig) -> Patch a -> SE a
onCondPlay Maybe SyntSkin
maybeSkin ( D -> D -> BooleanOf D
forall a. OrdB a => a -> a -> BooleanOf a
`greaterThanEquals` D
dt) ( Sig -> Sig -> BooleanOf Sig
forall a. OrdB a => a -> a -> BooleanOf a
`greaterThanEquals` (D -> Sig
sig D
dt))  Patch a
a

        onCondPlay :: Maybe SyntSkin
-> (D -> BoolD) -> (Sig -> BoolSig) -> Patch a -> SE a
onCondPlay Maybe SyntSkin
maybeSkin D -> BoolD
cond Sig -> BoolSig
condSig = \case
            MonoSynt MonoSyntSpec
spec GenMonoInstr a
instr -> MidiChn -> (D -> BoolD) -> MonoInstr a -> SE a
playMonoInstr  (MonoSyntSpec -> MidiChn
monoSyntChn MonoSyntSpec
spec) D -> BoolD
cond  ((Sig -> BoolSig) -> MonoInstr a -> MonoInstr a
forall a. Sigs a => (Sig -> BoolSig) -> MonoInstr a -> MonoInstr a
restrictMonoInstr Sig -> BoolSig
condSig (MonoInstr a -> MonoInstr a) -> MonoInstr a -> MonoInstr a
forall a b. (a -> b) -> a -> b
$ GenMonoInstr a -> Maybe SyntSkin -> MonoInstr a
forall a. Reader SyntSkin a -> Maybe SyntSkin -> a
runSkin GenMonoInstr a
instr Maybe SyntSkin
maybeSkin)
            PolySynt PolySyntSpec
spec GenInstr D a
instr -> MidiChn -> (CsdNote D -> SE a) -> SE a
playInstr (PolySyntSpec -> MidiChn
polySyntChn PolySyntSpec
spec) ((D -> BoolD) -> (CsdNote D -> SE a) -> CsdNote D -> SE a
forall a.
Sigs a =>
(D -> BoolD) -> (CsdNote D -> SE a) -> CsdNote D -> SE a
restrictPolyInstr D -> BoolD
cond (GenInstr D a -> Maybe SyntSkin -> CsdNote D -> SE a
forall a. Reader SyntSkin a -> Maybe SyntSkin -> a
runSkin GenInstr D a
instr Maybe SyntSkin
maybeSkin))
            SetSkin  SyntSkin
skin Patch a
p -> Maybe SyntSkin
-> (D -> BoolD) -> (Sig -> BoolSig) -> Patch a -> SE a
onCondPlay (SyntSkin -> Maybe SyntSkin
forall a. a -> Maybe a
Just SyntSkin
skin) D -> BoolD
cond Sig -> BoolSig
condSig Patch a
p
            FxChain [GenFxSpec a]
fxs Patch a
p -> Maybe SyntSkin -> [GenFxSpec a] -> Fx a
forall a.
(SigSpace a, Sigs a) =>
Maybe SyntSkin -> [GenFxSpec a] -> Fx a
getPatchFx Maybe SyntSkin
maybeSkin [GenFxSpec a]
fxs Fx a -> SE a -> SE a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe SyntSkin
-> (D -> BoolD) -> (Sig -> BoolSig) -> Patch a -> SE a
onCondPlay Maybe SyntSkin
maybeSkin D -> BoolD
cond Sig -> BoolSig
condSig Patch a
p
            LayerPatch [(Sig, Patch a)]
xs -> [(Sig, Patch a)] -> (Patch a -> SE a) -> SE a
forall a.
(SigSpace a, Sigs a) =>
[(Sig, Patch a)] -> (Patch a -> SE a) -> SE a
onLayered [(Sig, Patch a)]
xs (Maybe SyntSkin
-> (D -> BoolD) -> (Sig -> BoolSig) -> Patch a -> SE a
onCondPlay Maybe SyntSkin
maybeSkin D -> BoolD
cond Sig -> BoolSig
condSig)
            SplitPatch Patch a
a D
dt Patch a
b -> (a -> a -> a) -> SE a -> SE a -> SE a
forall a b c. (a -> b -> c) -> SE a -> SE b -> SE c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Num a => a -> a -> a
(+)
                        (Maybe SyntSkin
-> (D -> BoolD) -> (Sig -> BoolSig) -> Patch a -> SE a
onCondPlay Maybe SyntSkin
maybeSkin (\D
x -> D -> BoolD
cond D
x BoolD -> BoolD -> BoolD
forall b. Boolean b => b -> b -> b
&&* (D
x D -> D -> BooleanOf D
forall a. OrdB a => a -> a -> BooleanOf a
`lessThan` D
dt))           (\Sig
x -> Sig -> BoolSig
condSig Sig
x BoolSig -> BoolSig -> BoolSig
forall b. Boolean b => b -> b -> b
&&* (Sig
x Sig -> Sig -> BooleanOf Sig
forall a. OrdB a => a -> a -> BooleanOf a
`lessThan` (D -> Sig
sig D
dt))) Patch a
a)
                        (Maybe SyntSkin
-> (D -> BoolD) -> (Sig -> BoolSig) -> Patch a -> SE a
onCondPlay Maybe SyntSkin
maybeSkin (\D
x -> D -> BoolD
cond D
x BoolD -> BoolD -> BoolD
forall b. Boolean b => b -> b -> b
&&* (D
x D -> D -> BooleanOf D
forall a. OrdB a => a -> a -> BooleanOf a
`greaterThanEquals` D
dt))  (\Sig
x -> Sig -> BoolSig
condSig Sig
x BoolSig -> BoolSig -> BoolSig
forall b. Boolean b => b -> b -> b
&&* (Sig
x Sig -> Sig -> BooleanOf Sig
forall a. OrdB a => a -> a -> BooleanOf a
`greaterThanEquals` (D -> Sig
sig D
dt) ))  Patch a
b)

restrictPolyInstr :: (Sigs a) => (D -> BoolD) -> (CsdNote D -> SE a) -> CsdNote D -> SE a
restrictPolyInstr :: forall a.
Sigs a =>
(D -> BoolD) -> (CsdNote D -> SE a) -> CsdNote D -> SE a
restrictPolyInstr D -> BoolD
cond CsdNote D -> SE a
instr note :: CsdNote D
note@(D
_amp, D
cps) = do
    Ref a
ref <- a -> SE (Ref a)
forall a. Tuple a => a -> SE (Ref a)
newRef a
0
    BoolD -> SE () -> SE () -> SE ()
whenElseD (D -> BoolD
cond D
cps)
        (Ref a -> a -> SE ()
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref a
ref (a -> SE ()) -> SE a -> SE ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CsdNote D -> SE a
instr CsdNote D
note)
        (Ref a -> a -> SE ()
forall a. Tuple a => Ref a -> a -> SE ()
writeRef Ref a
ref a
0)
    Ref a -> SE a
forall a. Tuple a => Ref a -> SE a
readRef Ref a
ref

restrictMonoInstr :: (Sigs a) => (Sig -> BoolSig) -> MonoInstr a -> MonoInstr a
restrictMonoInstr :: forall a. Sigs a => (Sig -> BoolSig) -> MonoInstr a -> MonoInstr a
restrictMonoInstr Sig -> BoolSig
cond MonoInstr a
instr MonoArg
arg = MonoInstr a
instr MonoInstr a -> MonoInstr a
forall a b. (a -> b) -> a -> b
$ MonoArg
arg { monoGate = monoGate arg * gate2 }
    where
        cps :: Sig
cps = MonoArg -> Sig
monoCps MonoArg
arg
        gate2 :: Sig
gate2 = BoolSig -> Sig -> Sig -> Sig
forall bool. (bool ~ BooleanOf Sig) => bool -> Sig -> Sig -> Sig
forall a bool. (IfB a, bool ~ BooleanOf a) => bool -> a -> a -> a
ifB (Sig -> BoolSig
cond Sig
cps) Sig
1 Sig
0

--------------------------------------------------------------
-- sched

-- | Plays a patch with event stream.
atSched :: (SigSpace a, Sigs a) => Patch a -> Evt (Sco (CsdNote D)) -> SE a
atSched :: forall a.
(SigSpace a, Sigs a) =>
Patch a -> Evt (Sco (CsdNote D)) -> SE a
atSched = Maybe SyntSkin -> Patch a -> Evt (Sco (CsdNote D)) -> SE a
forall {b}.
Sigs b =>
Maybe SyntSkin -> Patch b -> Evt (Sco (CsdNote D)) -> SE b
go Maybe SyntSkin
forall a. Maybe a
Nothing
    where
        go :: Maybe SyntSkin -> Patch b -> Evt (Sco (CsdNote D)) -> SE b
go Maybe SyntSkin
maybeSkin Patch b
x Evt (Sco (CsdNote D))
evt = case Patch b
x of
            MonoSynt MonoSyntSpec
spec GenMonoInstr b
instr -> (GenMonoInstr b -> Maybe SyntSkin -> MonoArg -> SE b
forall a. Reader SyntSkin a -> Maybe SyntSkin -> a
runSkin GenMonoInstr b
instr Maybe SyntSkin
maybeSkin) (MonoArg -> SE b) -> SE MonoArg -> SE b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ((MonoArg -> MonoArg) -> SE MonoArg -> SE MonoArg
forall a b. (a -> b) -> SE a -> SE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (MonoSyntSpec -> MonoArg -> MonoArg
smoothMonoSpec MonoSyntSpec
spec) (SE MonoArg -> SE MonoArg) -> SE MonoArg -> SE MonoArg
forall a b. (a -> b) -> a -> b
$ Evt (Sco (CsdNote D)) -> SE MonoArg
monoSched Evt (Sco (CsdNote D))
evt)
            PolySynt PolySyntSpec
_ GenInstr D b
instr -> (CsdNote D -> SE b) -> SE b
forall {m :: * -> *} {a}.
(Monad m, Sigs a) =>
(CsdNote D -> SE a) -> m a
playInstr (GenInstr D b -> Maybe SyntSkin -> CsdNote D -> SE b
forall a. Reader SyntSkin a -> Maybe SyntSkin -> a
runSkin GenInstr D b
instr Maybe SyntSkin
maybeSkin)
            SetSkin SyntSkin
skin Patch b
p -> SyntSkin -> Patch b -> SE b
newSkin SyntSkin
skin Patch b
p
            FxChain [GenFxSpec b]
fxs Patch b
p  -> Maybe SyntSkin -> [GenFxSpec b] -> Fx b
forall a.
(SigSpace a, Sigs a) =>
Maybe SyntSkin -> [GenFxSpec a] -> Fx a
getPatchFx Maybe SyntSkin
maybeSkin [GenFxSpec b]
fxs Fx b -> SE b -> SE b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Patch b -> SE b
rec Patch b
p
            LayerPatch [(Sig, Patch b)]
xs -> [(Sig, Patch b)] -> (Patch b -> SE b) -> SE b
forall a.
(SigSpace a, Sigs a) =>
[(Sig, Patch a)] -> (Patch a -> SE a) -> SE a
onLayered [(Sig, Patch b)]
xs Patch b -> SE b
rec
            SplitPatch Patch b
a D
t Patch b
b -> Maybe SyntSkin
-> (MidiChn -> (D -> BoolD) -> (MonoArg -> SE b) -> SE b)
-> (MidiChn -> (CsdNote D -> SE b) -> SE b)
-> Patch b
-> D
-> Patch b
-> SE b
forall a.
(SigSpace a, Sigs a) =>
Maybe SyntSkin
-> (MidiChn -> (D -> BoolD) -> MonoInstr a -> SE a)
-> (MidiChn -> (CsdNote D -> SE a) -> SE a)
-> Patch a
-> D
-> Patch a
-> SE a
genSplitPatch Maybe SyntSkin
maybeSkin (((D -> BoolD) -> (MonoArg -> SE b) -> SE b)
-> MidiChn -> (D -> BoolD) -> (MonoArg -> SE b) -> SE b
forall a b. a -> b -> a
const (((D -> BoolD) -> (MonoArg -> SE b) -> SE b)
 -> MidiChn -> (D -> BoolD) -> (MonoArg -> SE b) -> SE b)
-> ((D -> BoolD) -> (MonoArg -> SE b) -> SE b)
-> MidiChn
-> (D -> BoolD)
-> (MonoArg -> SE b)
-> SE b
forall a b. (a -> b) -> a -> b
$ ((MonoArg -> SE b) -> SE b)
-> (D -> BoolD) -> (MonoArg -> SE b) -> SE b
forall a b. a -> b -> a
const (MonoArg -> SE b) -> SE b
forall {b}. (MonoArg -> SE b) -> SE b
playMonoInstr) (((CsdNote D -> SE b) -> SE b)
-> MidiChn -> (CsdNote D -> SE b) -> SE b
forall a b. a -> b -> a
const (CsdNote D -> SE b) -> SE b
forall {m :: * -> *} {a}.
(Monad m, Sigs a) =>
(CsdNote D -> SE a) -> m a
playInstr) Patch b
a D
t Patch b
b
            where
                rec :: Patch b -> SE b
rec Patch b
a = Maybe SyntSkin -> Patch b -> Evt (Sco (CsdNote D)) -> SE b
go Maybe SyntSkin
maybeSkin Patch b
a Evt (Sco (CsdNote D))
evt
                newSkin :: SyntSkin -> Patch b -> SE b
newSkin SyntSkin
skin Patch b
a = Maybe SyntSkin -> Patch b -> Evt (Sco (CsdNote D)) -> SE b
go (SyntSkin -> Maybe SyntSkin
forall a. a -> Maybe a
Just SyntSkin
skin) Patch b
a Evt (Sco (CsdNote D))
evt
                playInstr :: (CsdNote D -> SE a) -> m a
playInstr CsdNote D -> SE a
instr = a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$ (CsdNote D -> SE a) -> Evt (Sco (CsdNote D)) -> a
forall a b. (Arg a, Sigs b) => (a -> SE b) -> Evt (Sco a) -> b
sched CsdNote D -> SE a
instr Evt (Sco (CsdNote D))
evt
                playMonoInstr :: (MonoArg -> SE b) -> SE b
playMonoInstr MonoArg -> SE b
instr = MonoArg -> SE b
instr (MonoArg -> SE b) -> SE MonoArg -> SE b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Evt (Sco (CsdNote D)) -> SE MonoArg
monoSched Evt (Sco (CsdNote D))
evt

-- | Plays a patch with event stream with stop-note event stream.
atSchedUntil :: (SigSpace a, Sigs a) => Patch a -> Evt (CsdNote D) -> Evt b -> SE a
atSchedUntil :: forall a b.
(SigSpace a, Sigs a) =>
Patch a -> Evt (CsdNote D) -> Evt b -> SE a
atSchedUntil = Maybe SyntSkin -> Patch a -> Evt (CsdNote D) -> Evt b -> SE a
forall {b} {a}.
Sigs b =>
Maybe SyntSkin -> Patch b -> Evt (CsdNote D) -> Evt a -> SE b
go Maybe SyntSkin
forall a. Maybe a
Nothing
    where
        go :: Maybe SyntSkin -> Patch b -> Evt (CsdNote D) -> Evt a -> SE b
go Maybe SyntSkin
maybeSkin Patch b
x Evt (CsdNote D)
evt Evt a
stop = case Patch b
x of
            MonoSynt MonoSyntSpec
_ GenMonoInstr b
instr -> (MonoArg -> SE b) -> SE b
forall {b}. (MonoArg -> SE b) -> SE b
playMonoInstr (GenMonoInstr b -> Maybe SyntSkin -> MonoArg -> SE b
forall a. Reader SyntSkin a -> Maybe SyntSkin -> a
runSkin GenMonoInstr b
instr Maybe SyntSkin
maybeSkin)
            PolySynt PolySyntSpec
_ GenInstr D b
instr -> (CsdNote D -> SE b) -> SE b
forall {m :: * -> *} {a}.
(Monad m, Sigs a) =>
(CsdNote D -> SE a) -> m a
playInstr (GenInstr D b -> Maybe SyntSkin -> CsdNote D -> SE b
forall a. Reader SyntSkin a -> Maybe SyntSkin -> a
runSkin GenInstr D b
instr Maybe SyntSkin
maybeSkin)
            SetSkin SyntSkin
skin Patch b
p -> SyntSkin -> Patch b -> SE b
newSkin SyntSkin
skin Patch b
p
            FxChain [GenFxSpec b]
fxs Patch b
p  -> Maybe SyntSkin -> [GenFxSpec b] -> Fx b
forall a.
(SigSpace a, Sigs a) =>
Maybe SyntSkin -> [GenFxSpec a] -> Fx a
getPatchFx Maybe SyntSkin
maybeSkin [GenFxSpec b]
fxs Fx b -> SE b -> SE b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Patch b -> SE b
rec Patch b
p
            LayerPatch [(Sig, Patch b)]
xs -> [(Sig, Patch b)] -> (Patch b -> SE b) -> SE b
forall a.
(SigSpace a, Sigs a) =>
[(Sig, Patch a)] -> (Patch a -> SE a) -> SE a
onLayered [(Sig, Patch b)]
xs Patch b -> SE b
rec
            SplitPatch Patch b
a D
cps Patch b
b -> Maybe SyntSkin
-> (MidiChn -> (D -> BoolD) -> (MonoArg -> SE b) -> SE b)
-> (MidiChn -> (CsdNote D -> SE b) -> SE b)
-> Patch b
-> D
-> Patch b
-> SE b
forall a.
(SigSpace a, Sigs a) =>
Maybe SyntSkin
-> (MidiChn -> (D -> BoolD) -> MonoInstr a -> SE a)
-> (MidiChn -> (CsdNote D -> SE a) -> SE a)
-> Patch a
-> D
-> Patch a
-> SE a
genSplitPatch Maybe SyntSkin
maybeSkin (((D -> BoolD) -> (MonoArg -> SE b) -> SE b)
-> MidiChn -> (D -> BoolD) -> (MonoArg -> SE b) -> SE b
forall a b. a -> b -> a
const (((D -> BoolD) -> (MonoArg -> SE b) -> SE b)
 -> MidiChn -> (D -> BoolD) -> (MonoArg -> SE b) -> SE b)
-> ((D -> BoolD) -> (MonoArg -> SE b) -> SE b)
-> MidiChn
-> (D -> BoolD)
-> (MonoArg -> SE b)
-> SE b
forall a b. (a -> b) -> a -> b
$ ((MonoArg -> SE b) -> SE b)
-> (D -> BoolD) -> (MonoArg -> SE b) -> SE b
forall a b. a -> b -> a
const (MonoArg -> SE b) -> SE b
forall {b}. (MonoArg -> SE b) -> SE b
playMonoInstr) (((CsdNote D -> SE b) -> SE b)
-> MidiChn -> (CsdNote D -> SE b) -> SE b
forall a b. a -> b -> a
const (CsdNote D -> SE b) -> SE b
forall {m :: * -> *} {a}.
(Monad m, Sigs a) =>
(CsdNote D -> SE a) -> m a
playInstr) Patch b
a D
cps Patch b
b
            where
                rec :: Patch b -> SE b
rec Patch b
a = Maybe SyntSkin -> Patch b -> Evt (CsdNote D) -> Evt a -> SE b
go Maybe SyntSkin
maybeSkin Patch b
a Evt (CsdNote D)
evt Evt a
stop
                newSkin :: SyntSkin -> Patch b -> SE b
newSkin SyntSkin
skin Patch b
a = Maybe SyntSkin -> Patch b -> Evt (CsdNote D) -> Evt a -> SE b
go (SyntSkin -> Maybe SyntSkin
forall a. a -> Maybe a
Just SyntSkin
skin) Patch b
a Evt (CsdNote D)
evt Evt a
stop
                playInstr :: (CsdNote D -> SE a) -> m a
playInstr CsdNote D -> SE a
instr = a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$ (CsdNote D -> SE a) -> Evt (CsdNote D) -> Evt a -> a
forall a b c. (Arg a, Sigs b) => (a -> SE b) -> Evt a -> Evt c -> b
schedUntil CsdNote D -> SE a
instr Evt (CsdNote D)
evt Evt a
stop
                playMonoInstr :: (MonoArg -> SE b) -> SE b
playMonoInstr MonoArg -> SE b
instr = MonoArg -> SE b
instr (MonoArg -> SE b) -> SE MonoArg -> SE b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Evt (CsdNote D) -> Evt a -> SE MonoArg
forall a. Evt (CsdNote D) -> Evt a -> SE MonoArg
monoSchedUntil Evt (CsdNote D)
evt Evt a
stop

-- | Plays notes indefinetely (it's more useful for monophonic synthesizers).
atSchedHarp :: (SigSpace a, Sigs a) => Patch a -> Evt (CsdNote D) -> SE a
atSchedHarp :: forall a.
(SigSpace a, Sigs a) =>
Patch a -> Evt (CsdNote D) -> SE a
atSchedHarp Patch a
x Evt (CsdNote D)
evt = Patch a -> Evt (CsdNote D) -> Evt Any -> SE a
forall a b.
(SigSpace a, Sigs a) =>
Patch a -> Evt (CsdNote D) -> Evt b -> SE a
atSchedUntil  Patch a
x Evt (CsdNote D)
evt Evt Any
forall a. Monoid a => a
mempty

--------------------------------------------------------------
-- sco

-- | Plays a patch with scores.
atSco :: forall a . (SigSpace a, Sigs a) => Patch a -> Sco (CsdNote D) -> Sco (Mix a)
atSco :: forall a.
(SigSpace a, Sigs a) =>
Patch a -> Sco (CsdNote D) -> Sco (Mix a)
atSco = Maybe SyntSkin -> Patch a -> Sco (CsdNote D) -> Sco (Mix a)
go Maybe SyntSkin
forall a. Maybe a
Nothing
    where
        go :: Maybe SyntSkin -> Patch a -> Sco (CsdNote D) -> Sco (Mix a)
go Maybe SyntSkin
skin Patch a
x Sco (CsdNote D)
sc = case Patch a
x of
            MonoSynt MonoSyntSpec
_ GenMonoInstr a
instr -> (MonoArg -> SE a) -> Sco (CsdNote D) -> Sco (Mix a)
forall a.
Sigs a =>
(MonoArg -> SE a) -> Sco (CsdNote D) -> Sco (Mix a)
monoSco (GenMonoInstr a -> Maybe SyntSkin -> MonoArg -> SE a
forall a. Reader SyntSkin a -> Maybe SyntSkin -> a
runSkin GenMonoInstr a
instr Maybe SyntSkin
skin) Sco (CsdNote D)
sc
            PolySynt PolySyntSpec
_ GenInstr D a
instr -> (CsdNote D -> SE a) -> Sco (CsdNote D) -> Sco (Mix a)
forall a b. (Arg a, Sigs b) => (a -> SE b) -> Sco a -> Sco (Mix b)
sco (GenInstr D a -> Maybe SyntSkin -> CsdNote D -> SE a
forall a. Reader SyntSkin a -> Maybe SyntSkin -> a
runSkin GenInstr D a
instr Maybe SyntSkin
skin) Sco (CsdNote D)
sc
            SetSkin SyntSkin
sk Patch a
p -> SyntSkin -> Patch a -> Sco (Mix a)
newSkin SyntSkin
sk Patch a
p
            FxChain [GenFxSpec a]
fxs Patch a
p  -> (a -> SE a) -> Sco (Mix a) -> Sco (Mix a)
forall a b.
(Sigs a, Sigs b) =>
(a -> SE b) -> Sco (Mix a) -> Sco (Mix b)
eff (Maybe SyntSkin -> [GenFxSpec a] -> a -> SE a
forall a.
(SigSpace a, Sigs a) =>
Maybe SyntSkin -> [GenFxSpec a] -> Fx a
getPatchFx Maybe SyntSkin
skin [GenFxSpec a]
fxs) (Sco (Mix a) -> Sco (Mix a)) -> Sco (Mix a) -> Sco (Mix a)
forall a b. (a -> b) -> a -> b
$ Patch a -> Sco (Mix a)
rec Patch a
p
            LayerPatch [(Sig, Patch a)]
xs -> [Sco (Mix a)] -> Sco (Mix a)
forall a. Harmony a => [a] -> a
har ([Sco (Mix a)] -> Sco (Mix a)) -> [Sco (Mix a)] -> Sco (Mix a)
forall a b. (a -> b) -> a -> b
$ ((Sig, Patch a) -> Sco (Mix a))
-> [(Sig, Patch a)] -> [Sco (Mix a)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Sig
vol, Patch a
p) -> Patch a -> Sco (Mix a)
rec (Sig -> Patch a -> Patch a
forall a. SigSpace a => Sig -> a -> a
mul Sig
vol Patch a
p)) [(Sig, Patch a)]
xs
            SplitPatch Patch a
a D
cps Patch a
b -> Maybe SyntSkin -> Patch a -> D -> Patch a -> Sco (Mix a)
scoSplitPatch Maybe SyntSkin
skin Patch a
a D
cps Patch a
b
            where
                rec :: Patch a -> Sco (Mix a)
rec Patch a
a = Maybe SyntSkin -> Patch a -> Sco (CsdNote D) -> Sco (Mix a)
go Maybe SyntSkin
skin Patch a
a Sco (CsdNote D)
sc
                newSkin :: SyntSkin -> Patch a -> Sco (Mix a)
newSkin SyntSkin
sk Patch a
a = Maybe SyntSkin -> Patch a -> Sco (CsdNote D) -> Sco (Mix a)
go (SyntSkin -> Maybe SyntSkin
forall a. a -> Maybe a
Just SyntSkin
sk) Patch a
a Sco (CsdNote D)
sc

                scoSplitPatch :: Maybe SyntSkin -> Patch a -> D -> Patch a -> Sco (Mix a)
                scoSplitPatch :: Maybe SyntSkin -> Patch a -> D -> Patch a -> Sco (Mix a)
scoSplitPatch Maybe SyntSkin
maybeSkin Patch a
a D
dt Patch a
b = [Sco (Mix a)] -> Sco (Mix a)
forall a. Harmony a => [a] -> a
har [Maybe SyntSkin -> D -> Patch a -> Sco (Mix a)
leftSplit Maybe SyntSkin
maybeSkin D
dt Patch a
a, Maybe SyntSkin -> D -> Patch a -> Sco (Mix a)
rightSplit Maybe SyntSkin
maybeSkin D
dt Patch a
b]
                    where
                        leftSplit :: Maybe SyntSkin -> D -> Patch a -> Sco (Mix a)
leftSplit  Maybe SyntSkin
mSkin D
t = Maybe SyntSkin -> (D -> BoolD) -> Patch a -> Sco (Mix a)
onCondPlay Maybe SyntSkin
mSkin ( D -> D -> BooleanOf D
forall a. OrdB a => a -> a -> BooleanOf a
`lessThan` D
t)
                        rightSplit :: Maybe SyntSkin -> D -> Patch a -> Sco (Mix a)
rightSplit Maybe SyntSkin
mSkin D
t = Maybe SyntSkin -> (D -> BoolD) -> Patch a -> Sco (Mix a)
onCondPlay Maybe SyntSkin
mSkin ( D -> D -> BooleanOf D
forall a. OrdB a => a -> a -> BooleanOf a
`greaterThanEquals` D
t)

                        onCondPlay :: Maybe SyntSkin -> (D -> BoolD) -> Patch a -> Sco (Mix a)
onCondPlay Maybe SyntSkin
mSkin D -> BoolD
cond = \case
                            MonoSynt MonoSyntSpec
_spec GenMonoInstr a
_instr -> [Char] -> Sco (Mix a)
forall a. HasCallStack => [Char] -> a
error [Char]
"Split doesn't work for monophonic synths with Scores. Please use only polyphonic synths in this case."
                            PolySynt PolySyntSpec
_spec GenInstr D a
instr -> (CsdNote D -> SE a) -> Sco (CsdNote D) -> Sco (Mix a)
forall a b. (Arg a, Sigs b) => (a -> SE b) -> Sco a -> Sco (Mix b)
sco ((D -> BoolD) -> (CsdNote D -> SE a) -> CsdNote D -> SE a
forall a.
Sigs a =>
(D -> BoolD) -> (CsdNote D -> SE a) -> CsdNote D -> SE a
restrictPolyInstr D -> BoolD
cond (GenInstr D a -> Maybe SyntSkin -> CsdNote D -> SE a
forall a. Reader SyntSkin a -> Maybe SyntSkin -> a
runSkin GenInstr D a
instr Maybe SyntSkin
mSkin)) Sco (CsdNote D)
sc
                            SetSkin SyntSkin
sk Patch a
p -> Maybe SyntSkin -> (D -> BoolD) -> Patch a -> Sco (Mix a)
onCondPlay (SyntSkin -> Maybe SyntSkin
forall a. a -> Maybe a
Just SyntSkin
sk) D -> BoolD
cond Patch a
p
                            FxChain [GenFxSpec a]
fxs Patch a
p -> (a -> SE a) -> Sco (Mix a) -> Sco (Mix a)
forall a b.
(Sigs a, Sigs b) =>
(a -> SE b) -> Sco (Mix a) -> Sco (Mix b)
eff (Maybe SyntSkin -> [GenFxSpec a] -> a -> SE a
forall a.
(SigSpace a, Sigs a) =>
Maybe SyntSkin -> [GenFxSpec a] -> Fx a
getPatchFx Maybe SyntSkin
mSkin [GenFxSpec a]
fxs) (Sco (Mix a) -> Sco (Mix a)) -> Sco (Mix a) -> Sco (Mix a)
forall a b. (a -> b) -> a -> b
$ Maybe SyntSkin -> Patch a -> Sco (CsdNote D) -> Sco (Mix a)
go Maybe SyntSkin
mSkin Patch a
p Sco (CsdNote D)
sc
                            LayerPatch [(Sig, Patch a)]
xs -> [Sco (Mix a)] -> Sco (Mix a)
forall a. Harmony a => [a] -> a
har ([Sco (Mix a)] -> Sco (Mix a)) -> [Sco (Mix a)] -> Sco (Mix a)
forall a b. (a -> b) -> a -> b
$ ((Sig, Patch a) -> Sco (Mix a))
-> [(Sig, Patch a)] -> [Sco (Mix a)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Sig
vol, Patch a
p) -> Maybe SyntSkin -> Patch a -> Sco (CsdNote D) -> Sco (Mix a)
go Maybe SyntSkin
mSkin (Sig -> Patch a -> Patch a
forall a. SigSpace a => Sig -> a -> a
mul Sig
vol Patch a
p) Sco (CsdNote D)
sc) [(Sig, Patch a)]
xs
                            SplitPatch Patch a
m D
t Patch a
n -> [Sco (Mix a)] -> Sco (Mix a)
forall a. Harmony a => [a] -> a
har
                                        [ Maybe SyntSkin -> (D -> BoolD) -> Patch a -> Sco (Mix a)
onCondPlay Maybe SyntSkin
mSkin (\D
q -> D -> BoolD
cond D
q BoolD -> BoolD -> BoolD
forall b. Boolean b => b -> b -> b
&&* (D
q D -> D -> BooleanOf D
forall a. OrdB a => a -> a -> BooleanOf a
`lessThan` D
t)) Patch a
m
                                        , Maybe SyntSkin -> (D -> BoolD) -> Patch a -> Sco (Mix a)
onCondPlay Maybe SyntSkin
mSkin (\D
q -> D -> BoolD
cond D
q BoolD -> BoolD -> BoolD
forall b. Boolean b => b -> b -> b
&&* (D
q D -> D -> BooleanOf D
forall a. OrdB a => a -> a -> BooleanOf a
`greaterThanEquals` D
t)) Patch a
n ]

onLayered :: (SigSpace a, Sigs a) => [(Sig, Patch a)] -> (Patch a -> SE a) -> SE a
onLayered :: forall a.
(SigSpace a, Sigs a) =>
[(Sig, Patch a)] -> (Patch a -> SE a) -> SE a
onLayered [(Sig, Patch a)]
xs Patch a -> SE a
f = ([a] -> a) -> SE [a] -> SE a
forall a b. (a -> b) -> SE a -> SE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> a
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (SE [a] -> SE a) -> SE [a] -> SE a
forall a b. (a -> b) -> a -> b
$ ((Sig, Patch a) -> SE a) -> [(Sig, Patch a)] -> SE [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\(Sig
vol, Patch a
p) -> (a -> a) -> SE a -> SE a
forall a b. (a -> b) -> SE a -> SE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Sig -> a -> a
forall a. SigSpace a => Sig -> a -> a
mul Sig
vol) (SE a -> SE a) -> SE a -> SE a
forall a b. (a -> b) -> a -> b
$ Patch a -> SE a
f Patch a
p) [(Sig, Patch a)]
xs

--    getPatchFx a =<< midi (patchInstr a . ampCps)

-- | Transform  the spec for monophonic patch.
onMonoSyntSpec :: (MonoSyntSpec -> MonoSyntSpec) -> Patch a -> Patch a
onMonoSyntSpec :: forall a. (MonoSyntSpec -> MonoSyntSpec) -> Patch a -> Patch a
onMonoSyntSpec MonoSyntSpec -> MonoSyntSpec
f Patch a
x = case Patch a
x of
    MonoSynt MonoSyntSpec
spec GenMonoInstr a
instr -> MonoSyntSpec -> GenMonoInstr a -> Patch a
forall a. MonoSyntSpec -> GenMonoInstr a -> Patch a
MonoSynt (MonoSyntSpec -> MonoSyntSpec
f MonoSyntSpec
spec) GenMonoInstr a
instr
    PolySynt PolySyntSpec
spec GenInstr D a
instr -> PolySyntSpec -> GenInstr D a -> Patch a
forall a. PolySyntSpec -> GenInstr D a -> Patch a
PolySynt PolySyntSpec
spec GenInstr D a
instr
    SetSkin SyntSkin
skin Patch a
p -> SyntSkin -> Patch a -> Patch a
forall a. SyntSkin -> Patch a -> Patch a
SetSkin SyntSkin
skin  (Patch a -> Patch a) -> Patch a -> Patch a
forall a b. (a -> b) -> a -> b
$ (MonoSyntSpec -> MonoSyntSpec) -> Patch a -> Patch a
forall a. (MonoSyntSpec -> MonoSyntSpec) -> Patch a -> Patch a
onMonoSyntSpec MonoSyntSpec -> MonoSyntSpec
f Patch a
p
    FxChain [GenFxSpec a]
fxs Patch a
p -> [GenFxSpec a] -> Patch a -> Patch a
forall a. [GenFxSpec a] -> Patch a -> Patch a
FxChain [GenFxSpec a]
fxs (Patch a -> Patch a) -> Patch a -> Patch a
forall a b. (a -> b) -> a -> b
$ (MonoSyntSpec -> MonoSyntSpec) -> Patch a -> Patch a
forall a. (MonoSyntSpec -> MonoSyntSpec) -> Patch a -> Patch a
onMonoSyntSpec MonoSyntSpec -> MonoSyntSpec
f Patch a
p
    LayerPatch [(Sig, Patch a)]
xs -> [(Sig, Patch a)] -> Patch a
forall a. [(Sig, Patch a)] -> Patch a
LayerPatch ([(Sig, Patch a)] -> Patch a) -> [(Sig, Patch a)] -> Patch a
forall a b. (a -> b) -> a -> b
$ (Patch a -> Patch a) -> [(Sig, Patch a)] -> [(Sig, Patch a)]
forall a b c. (a -> b) -> [(c, a)] -> [(c, b)]
mapSnd ((MonoSyntSpec -> MonoSyntSpec) -> Patch a -> Patch a
forall a. (MonoSyntSpec -> MonoSyntSpec) -> Patch a -> Patch a
onMonoSyntSpec MonoSyntSpec -> MonoSyntSpec
f) [(Sig, Patch a)]
xs
    SplitPatch Patch a
a D
cps Patch a
b -> Patch a -> D -> Patch a -> Patch a
forall a. Patch a -> D -> Patch a -> Patch a
SplitPatch ((MonoSyntSpec -> MonoSyntSpec) -> Patch a -> Patch a
forall a. (MonoSyntSpec -> MonoSyntSpec) -> Patch a -> Patch a
onMonoSyntSpec MonoSyntSpec -> MonoSyntSpec
f Patch a
a) D
cps ((MonoSyntSpec -> MonoSyntSpec) -> Patch a -> Patch a
forall a. (MonoSyntSpec -> MonoSyntSpec) -> Patch a -> Patch a
onMonoSyntSpec MonoSyntSpec -> MonoSyntSpec
f Patch a
b)

-- | Sets the midi channel for all instruments in the patch.
setMidiChn :: MidiChn -> Patch a -> Patch a
setMidiChn :: forall a. MidiChn -> Patch a -> Patch a
setMidiChn MidiChn
chn Patch a
x = case Patch a
x of
    MonoSynt MonoSyntSpec
spec GenMonoInstr a
instr -> MonoSyntSpec -> GenMonoInstr a -> Patch a
forall a. MonoSyntSpec -> GenMonoInstr a -> Patch a
MonoSynt (MonoSyntSpec
spec { monoSyntChn = chn }) GenMonoInstr a
instr
    PolySynt PolySyntSpec
spec GenInstr D a
instr -> PolySyntSpec -> GenInstr D a -> Patch a
forall a. PolySyntSpec -> GenInstr D a -> Patch a
PolySynt (PolySyntSpec
spec { polySyntChn = chn }) GenInstr D a
instr
    SetSkin SyntSkin
skin Patch a
p -> SyntSkin -> Patch a -> Patch a
forall a. SyntSkin -> Patch a -> Patch a
SetSkin SyntSkin
skin (Patch a -> Patch a) -> Patch a -> Patch a
forall a b. (a -> b) -> a -> b
$ Patch a -> Patch a
forall a. Patch a -> Patch a
go Patch a
p
    FxChain [GenFxSpec a]
fxs Patch a
p -> [GenFxSpec a] -> Patch a -> Patch a
forall a. [GenFxSpec a] -> Patch a -> Patch a
FxChain [GenFxSpec a]
fxs (Patch a -> Patch a) -> Patch a -> Patch a
forall a b. (a -> b) -> a -> b
$ Patch a -> Patch a
forall a. Patch a -> Patch a
go Patch a
p
    LayerPatch [(Sig, Patch a)]
xs -> [(Sig, Patch a)] -> Patch a
forall a. [(Sig, Patch a)] -> Patch a
LayerPatch ([(Sig, Patch a)] -> Patch a) -> [(Sig, Patch a)] -> Patch a
forall a b. (a -> b) -> a -> b
$ (Patch a -> Patch a) -> [(Sig, Patch a)] -> [(Sig, Patch a)]
forall a b c. (a -> b) -> [(c, a)] -> [(c, b)]
mapSnd Patch a -> Patch a
forall a. Patch a -> Patch a
go [(Sig, Patch a)]
xs
    SplitPatch Patch a
a D
cps Patch a
b -> Patch a -> D -> Patch a -> Patch a
forall a. Patch a -> D -> Patch a -> Patch a
SplitPatch (Patch a -> Patch a
forall a. Patch a -> Patch a
go Patch a
a) D
cps (Patch a -> Patch a
forall a. Patch a -> Patch a
go Patch a
b)
    where go :: Patch a -> Patch a
go = MidiChn -> Patch a -> Patch a
forall a. MidiChn -> Patch a -> Patch a
setMidiChn MidiChn
chn


-- | Sets the monophonic to sharp transition and quick release.
setMonoSharp :: Patch a -> Patch a
setMonoSharp :: forall a. Patch a -> Patch a
setMonoSharp = D -> Patch a -> Patch a
forall a. D -> Patch a -> Patch a
setMonoSlide D
0.004

-- | Sets the slide time for pitch and amplitude of monophomic synthesizers.
setMonoSlide :: D -> Patch a -> Patch a
setMonoSlide :: forall a. D -> Patch a -> Patch a
setMonoSlide D
slideTime = (MonoSyntSpec -> MonoSyntSpec) -> Patch a -> Patch a
forall a. (MonoSyntSpec -> MonoSyntSpec) -> Patch a -> Patch a
onMonoSyntSpec (\MonoSyntSpec
x -> MonoSyntSpec
x { monoSyntSlideTime = Just slideTime })

-- | Transpose the patch by a given ratio. We can use the functions semitone, cent to calculate the ratio.
transPatch :: D -> Patch a -> Patch a
transPatch :: forall a. D -> Patch a -> Patch a
transPatch D
k = (MonoInstr a -> MonoInstr a)
-> (Instr D a -> Instr D a) -> Patch a -> Patch a
forall a.
(MonoInstr a -> MonoInstr a)
-> (Instr D a -> Instr D a) -> Patch a -> Patch a
mapMonoPolyInstr (D -> MonoInstr a -> MonoInstr a
forall a. D -> MonoInstr a -> MonoInstr a
transMonoInstr D
k) (D -> Instr D a -> Instr D a
forall a. D -> Instr D a -> Instr D a
transPolyInstr D
k)

transMonoInstr :: D -> MonoInstr a -> MonoInstr a
transMonoInstr :: forall a. D -> MonoInstr a -> MonoInstr a
transMonoInstr D
k MonoInstr a
instr = \MonoArg
arg -> MonoInstr a
instr (MonoArg
arg { monoCps = sig k * monoCps arg })

transPolyInstr :: D -> Instr D a -> Instr D a
transPolyInstr :: forall a. D -> Instr D a -> Instr D a
transPolyInstr D
k Instr D a
instr = \(D
amp, D
cps) -> Instr D a
instr (D
amp, D
k D -> D -> D
forall a. Num a => a -> a -> a
* D
cps)

-- | Adds an effect to the patch's instrument.
addInstrFx :: Fx a -> Patch a -> Patch a
addInstrFx :: forall a. Fx a -> Patch a -> Patch a
addInstrFx Fx a
f Patch a
p = (Instr D a -> Instr D a) -> Patch a -> Patch a
forall a. (Instr D a -> Instr D a) -> Patch a -> Patch a
mapPatchInstr (\Instr D a
instr -> Fx a
f Fx a -> Instr D a -> Instr D a
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Instr D a
instr) Patch a
p

-- | Appends an effect before patch's effect.
addPreFx :: DryWetRatio -> Fx a -> Patch a -> Patch a
addPreFx :: forall a. Sig -> Fx a -> Patch a -> Patch a
addPreFx Sig
dw Fx a
f Patch a
p = case Patch a
p of
    FxChain [GenFxSpec a]
fxs (PolySynt PolySyntSpec
spec GenInstr D a
instr) -> [GenFxSpec a] -> Patch a -> Patch a
forall a. [GenFxSpec a] -> Patch a -> Patch a
FxChain ([GenFxSpec a] -> [GenFxSpec a]
addFx [GenFxSpec a]
fxs) (PolySyntSpec -> GenInstr D a -> Patch a
forall a. PolySyntSpec -> GenInstr D a -> Patch a
PolySynt PolySyntSpec
spec GenInstr D a
instr)
    FxChain [GenFxSpec a]
fxs (MonoSynt MonoSyntSpec
spec GenMonoInstr a
instr) -> [GenFxSpec a] -> Patch a -> Patch a
forall a. [GenFxSpec a] -> Patch a -> Patch a
FxChain ([GenFxSpec a] -> [GenFxSpec a]
addFx [GenFxSpec a]
fxs) (MonoSyntSpec -> GenMonoInstr a -> Patch a
forall a. MonoSyntSpec -> GenMonoInstr a -> Patch a
MonoSynt MonoSyntSpec
spec GenMonoInstr a
instr)
    SetSkin SyntSkin
skin Patch a
q -> SyntSkin -> Patch a -> Patch a
forall a. SyntSkin -> Patch a -> Patch a
SetSkin SyntSkin
skin (Patch a -> Patch a) -> Patch a -> Patch a
forall a b. (a -> b) -> a -> b
$ Sig -> Fx a -> Patch a -> Patch a
forall a. Sig -> Fx a -> Patch a -> Patch a
addPreFx Sig
dw Fx a
f Patch a
q
    PolySynt PolySyntSpec
spec GenInstr D a
instr -> [GenFxSpec a] -> Patch a -> Patch a
forall a. [GenFxSpec a] -> Patch a -> Patch a
FxChain [GenFxSpec a]
fxSpec' (Patch a -> Patch a) -> Patch a -> Patch a
forall a b. (a -> b) -> a -> b
$ PolySyntSpec -> GenInstr D a -> Patch a
forall a. PolySyntSpec -> GenInstr D a -> Patch a
PolySynt PolySyntSpec
spec GenInstr D a
instr
    MonoSynt MonoSyntSpec
spec GenMonoInstr a
instr -> [GenFxSpec a] -> Patch a -> Patch a
forall a. [GenFxSpec a] -> Patch a -> Patch a
FxChain [GenFxSpec a]
fxSpec' (Patch a -> Patch a) -> Patch a -> Patch a
forall a b. (a -> b) -> a -> b
$ MonoSyntSpec -> GenMonoInstr a -> Patch a
forall a. MonoSyntSpec -> GenMonoInstr a -> Patch a
MonoSynt MonoSyntSpec
spec GenMonoInstr a
instr
    LayerPatch [(Sig, Patch a)]
xs -> [(Sig, Patch a)] -> Patch a
forall a. [(Sig, Patch a)] -> Patch a
LayerPatch ([(Sig, Patch a)] -> Patch a) -> [(Sig, Patch a)] -> Patch a
forall a b. (a -> b) -> a -> b
$ (Patch a -> Patch a) -> [(Sig, Patch a)] -> [(Sig, Patch a)]
forall a b c. (a -> b) -> [(c, a)] -> [(c, b)]
mapSnd (Sig -> Fx a -> Patch a -> Patch a
forall a. Sig -> Fx a -> Patch a -> Patch a
addPreFx Sig
dw Fx a
f) [(Sig, Patch a)]
xs
    SplitPatch Patch a
a D
cps Patch a
b -> Patch a -> D -> Patch a -> Patch a
forall a. Patch a -> D -> Patch a -> Patch a
SplitPatch (Sig -> Fx a -> Patch a -> Patch a
forall a. Sig -> Fx a -> Patch a -> Patch a
addPreFx Sig
dw Fx a
f Patch a
a) D
cps (Sig -> Fx a -> Patch a -> Patch a
forall a. Sig -> Fx a -> Patch a -> Patch a
addPreFx Sig
dw Fx a
f Patch a
b)
    Patch a
_ -> Patch a
forall a. HasCallStack => a
undefined
    where
        addFx :: [GenFxSpec a] -> [GenFxSpec a]
addFx [GenFxSpec a]
xs = [GenFxSpec a]
xs [GenFxSpec a] -> [GenFxSpec a] -> [GenFxSpec a]
forall a. [a] -> [a] -> [a]
++ [GenFxSpec a]
fxSpec'
        fxSpec' :: [GenFxSpec a]
fxSpec' = [FxSpec a -> GenFxSpec a
forall a. a -> ReaderT SyntSkin Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (FxSpec a -> GenFxSpec a) -> FxSpec a -> GenFxSpec a
forall a b. (a -> b) -> a -> b
$ Sig -> Fx a -> FxSpec a
forall a. Sig -> Fx a -> FxSpec a
FxSpec Sig
dw Fx a
f]

-- | Appends an effect after patch's effect.
addPostFx :: DryWetRatio -> Fx a -> Patch a -> Patch a
addPostFx :: forall a. Sig -> Fx a -> Patch a -> Patch a
addPostFx Sig
dw Fx a
f Patch a
p = case Patch a
p of
    FxChain [GenFxSpec a]
fxs Patch a
rest -> [GenFxSpec a] -> Patch a -> Patch a
forall a. [GenFxSpec a] -> Patch a -> Patch a
FxChain (FxSpec a -> GenFxSpec a
forall a. a -> ReaderT SyntSkin Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return FxSpec a
fxSpec' GenFxSpec a -> [GenFxSpec a] -> [GenFxSpec a]
forall a. a -> [a] -> [a]
: [GenFxSpec a]
fxs) Patch a
rest
    Patch a
_                -> [GenFxSpec a] -> Patch a -> Patch a
forall a. [GenFxSpec a] -> Patch a -> Patch a
FxChain [FxSpec a -> GenFxSpec a
forall a. a -> ReaderT SyntSkin Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return FxSpec a
fxSpec'] Patch a
p
    where fxSpec' :: FxSpec a
fxSpec' = Sig -> Fx a -> FxSpec a
forall a. Sig -> Fx a -> FxSpec a
FxSpec Sig
dw Fx a
f

--------------------------------------------------------------

-- | Plays a patch when the condition signal is satisfied. Can be useful for switches.
patchWhen :: (Sigs a) => BoolSig -> Patch a -> Patch a
patchWhen :: forall a. Sigs a => BoolSig -> Patch a -> Patch a
patchWhen BoolSig
cond Patch a
x = case Patch a
x of
    MonoSynt MonoSyntSpec
spec GenMonoInstr a
instr -> MonoSyntSpec -> GenMonoInstr a -> Patch a
forall a. MonoSyntSpec -> GenMonoInstr a -> Patch a
MonoSynt MonoSyntSpec
spec (((MonoArg -> SE a) -> MonoArg -> SE a)
-> GenMonoInstr a -> GenMonoInstr a
forall a b.
(a -> b)
-> ReaderT SyntSkin Identity a -> ReaderT SyntSkin Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (BoolSig -> (MonoArg -> SE a) -> MonoArg -> SE a
forall a b. Sigs a => BoolSig -> (b -> SE a) -> b -> SE a
playWhen BoolSig
cond) GenMonoInstr a
instr)
    PolySynt PolySyntSpec
spec GenInstr D a
instr -> PolySyntSpec -> GenInstr D a -> Patch a
forall a. PolySyntSpec -> GenInstr D a -> Patch a
PolySynt PolySyntSpec
spec (((CsdNote D -> SE a) -> CsdNote D -> SE a)
-> GenInstr D a -> GenInstr D a
forall a b.
(a -> b)
-> ReaderT SyntSkin Identity a -> ReaderT SyntSkin Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (BoolSig -> (CsdNote D -> SE a) -> CsdNote D -> SE a
forall a b. Sigs a => BoolSig -> (b -> SE a) -> b -> SE a
playWhen BoolSig
cond) GenInstr D a
instr)
    SetSkin SyntSkin
skin Patch a
p -> SyntSkin -> Patch a -> Patch a
forall a. SyntSkin -> Patch a -> Patch a
SetSkin SyntSkin
skin (Patch a -> Patch a) -> Patch a -> Patch a
forall a b. (a -> b) -> a -> b
$ Patch a -> Patch a
rec Patch a
p
    FxChain  [GenFxSpec a]
fxs Patch a
p      -> [GenFxSpec a] -> Patch a -> Patch a
forall a. [GenFxSpec a] -> Patch a -> Patch a
FxChain ((GenFxSpec a -> GenFxSpec a) -> [GenFxSpec a] -> [GenFxSpec a]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((FxSpec a -> FxSpec a) -> GenFxSpec a -> GenFxSpec a
forall a b.
(a -> b)
-> ReaderT SyntSkin Identity a -> ReaderT SyntSkin Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((FxSpec a -> FxSpec a) -> GenFxSpec a -> GenFxSpec a)
-> (FxSpec a -> FxSpec a) -> GenFxSpec a -> GenFxSpec a
forall a b. (a -> b) -> a -> b
$ (Fx a -> Fx a) -> FxSpec a -> FxSpec a
forall {a} {a}. (Fx a -> Fx a) -> FxSpec a -> FxSpec a
mapFun (BoolSig -> Fx a -> Fx a
forall a b. Sigs a => BoolSig -> (b -> SE a) -> b -> SE a
playWhen BoolSig
cond)) [GenFxSpec a]
fxs) (Patch a -> Patch a
rec Patch a
p)
    LayerPatch [(Sig, Patch a)]
xs       -> [(Sig, Patch a)] -> Patch a
forall a. [(Sig, Patch a)] -> Patch a
LayerPatch ([(Sig, Patch a)] -> Patch a) -> [(Sig, Patch a)] -> Patch a
forall a b. (a -> b) -> a -> b
$ (Patch a -> Patch a) -> [(Sig, Patch a)] -> [(Sig, Patch a)]
forall a b c. (a -> b) -> [(c, a)] -> [(c, b)]
mapSnd Patch a -> Patch a
rec [(Sig, Patch a)]
xs
    SplitPatch Patch a
a D
cps Patch a
b  -> Patch a -> D -> Patch a -> Patch a
forall a. Patch a -> D -> Patch a -> Patch a
SplitPatch (Patch a -> Patch a
rec Patch a
a) D
cps (Patch a -> Patch a
rec Patch a
b)
    where
        rec :: Patch a -> Patch a
rec = BoolSig -> Patch a -> Patch a
forall a. Sigs a => BoolSig -> Patch a -> Patch a
patchWhen BoolSig
cond
        mapFun :: (Fx a -> Fx a) -> FxSpec a -> FxSpec a
mapFun Fx a -> Fx a
f FxSpec a
a = FxSpec a
a { fxFun = f $ fxFun a }

-- | Mix two patches together.
mixInstr :: (SigSpace b, Num b) => Sig -> Patch b -> Patch b -> Patch b
mixInstr :: forall b.
(SigSpace b, Num b) =>
Sig -> Patch b -> Patch b -> Patch b
mixInstr Sig
k Patch b
f Patch b
p = [(Sig, Patch b)] -> Patch b
forall a. [(Sig, Patch a)] -> Patch a
LayerPatch [(Sig
k, Patch b
f), (Sig
1, Patch b
p)]

------------------------------------------------
-- pads

-- | Harmnoic series of patches.
harmonPatch :: (SigSpace b, Sigs b) => [Sig] -> [D] -> Patch b -> Patch b
harmonPatch :: forall b.
(SigSpace b, Sigs b) =>
[Sig] -> [D] -> Patch b -> Patch b
harmonPatch [Sig]
amps [D]
freqs = (MonoInstr b -> MonoInstr b)
-> ((CsdNote D -> SE b) -> CsdNote D -> SE b) -> Patch b -> Patch b
forall a.
(MonoInstr a -> MonoInstr a)
-> (Instr D a -> Instr D a) -> Patch a -> Patch a
tfmInstr MonoInstr b -> MonoInstr b
forall {b}. (Num b, SigSpace b) => MonoInstr b -> MonoInstr b
monoTfm (CsdNote D -> SE b) -> CsdNote D -> SE b
forall {b}. (Num b, SigSpace b) => Instr D b -> Instr D b
polyTfm
    where
        monoTfm :: MonoInstr b -> MonoInstr b
monoTfm MonoInstr b
instr = \MonoArg
arg -> ([b] -> b) -> SE [b] -> SE b
forall a b. (a -> b) -> SE a -> SE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [b] -> b
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (SE [b] -> SE b) -> SE [b] -> SE b
forall a b. (a -> b) -> a -> b
$ (Sig -> D -> SE b) -> [Sig] -> [D] -> SE [b]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (\Sig
a D
f -> (b -> b) -> SE b -> SE b
forall a b. (a -> b) -> SE a -> SE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Sig -> b -> b
forall a. SigSpace a => Sig -> a -> a
mul Sig
a) (SE b -> SE b) -> SE b -> SE b
forall a b. (a -> b) -> a -> b
$ D -> MonoInstr b -> MonoInstr b
forall a. D -> MonoInstr a -> MonoInstr a
transMonoInstr D
f MonoInstr b
instr MonoArg
arg) [Sig]
amps [D]
freqs
        polyTfm :: Instr D b -> Instr D b
polyTfm Instr D b
instr = \CsdNote D
arg -> ([b] -> b) -> SE [b] -> SE b
forall a b. (a -> b) -> SE a -> SE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [b] -> b
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (SE [b] -> SE b) -> SE [b] -> SE b
forall a b. (a -> b) -> a -> b
$ (Sig -> D -> SE b) -> [Sig] -> [D] -> SE [b]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (\Sig
a D
f -> (b -> b) -> SE b -> SE b
forall a b. (a -> b) -> SE a -> SE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Sig -> b -> b
forall a. SigSpace a => Sig -> a -> a
mul Sig
a) (SE b -> SE b) -> SE b -> SE b
forall a b. (a -> b) -> a -> b
$ D -> Instr D b -> Instr D b
forall a. D -> Instr D a -> Instr D a
transPolyInstr D
f Instr D b
instr CsdNote D
arg) [Sig]
amps [D]
freqs

-- | Adds an octave below note for a given patch to make the sound deeper.
deepPad :: (SigSpace b, Sigs b) => Patch b -> Patch b
deepPad :: forall b. (SigSpace b, Sigs b) => Patch b -> Patch b
deepPad = [Sig] -> [D] -> Patch b -> Patch b
forall b.
(SigSpace b, Sigs b) =>
[Sig] -> [D] -> Patch b -> Patch b
harmonPatch ((Sig -> Sig) -> [Sig] -> [Sig]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Sig -> Sig -> Sig
forall a. Num a => a -> a -> a
* Sig
0.75) [Sig
1, Sig
0.5]) [D
1, D
0.5]

-- | Transforms instrument functions for polyphonic and monophonic patches.
tfmInstr :: (MonoInstr b -> MonoInstr b) -> ((CsdNote D -> SE b) -> (CsdNote D -> SE b)) -> Patch b -> Patch b
tfmInstr :: forall a.
(MonoInstr a -> MonoInstr a)
-> (Instr D a -> Instr D a) -> Patch a -> Patch a
tfmInstr MonoInstr b -> MonoInstr b
monoTfm (CsdNote D -> SE b) -> CsdNote D -> SE b
polyTfm Patch b
x = case Patch b
x of
    MonoSynt MonoSyntSpec
spec GenMonoInstr b
instr -> MonoSyntSpec -> GenMonoInstr b -> Patch b
forall a. MonoSyntSpec -> GenMonoInstr a -> Patch a
MonoSynt MonoSyntSpec
spec (GenMonoInstr b -> Patch b) -> GenMonoInstr b -> Patch b
forall a b. (a -> b) -> a -> b
$ (MonoInstr b -> MonoInstr b) -> GenMonoInstr b -> GenMonoInstr b
forall a b.
(a -> b)
-> ReaderT SyntSkin Identity a -> ReaderT SyntSkin Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MonoInstr b -> MonoInstr b
monoTfm GenMonoInstr b
instr
    PolySynt PolySyntSpec
spec GenInstr D b
instr -> PolySyntSpec -> GenInstr D b -> Patch b
forall a. PolySyntSpec -> GenInstr D a -> Patch a
PolySynt PolySyntSpec
spec (GenInstr D b -> Patch b) -> GenInstr D b -> Patch b
forall a b. (a -> b) -> a -> b
$ ((CsdNote D -> SE b) -> CsdNote D -> SE b)
-> GenInstr D b -> GenInstr D b
forall a b.
(a -> b)
-> ReaderT SyntSkin Identity a -> ReaderT SyntSkin Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CsdNote D -> SE b) -> CsdNote D -> SE b
polyTfm GenInstr D b
instr
    SetSkin  SyntSkin
skin Patch b
p -> SyntSkin -> Patch b -> Patch b
forall a. SyntSkin -> Patch a -> Patch a
SetSkin SyntSkin
skin (Patch b -> Patch b) -> Patch b -> Patch b
forall a b. (a -> b) -> a -> b
$ Patch b -> Patch b
rec Patch b
p
    FxChain [GenFxSpec b]
fxs Patch b
p -> [GenFxSpec b] -> Patch b -> Patch b
forall a. [GenFxSpec a] -> Patch a -> Patch a
FxChain [GenFxSpec b]
fxs (Patch b -> Patch b) -> Patch b -> Patch b
forall a b. (a -> b) -> a -> b
$ Patch b -> Patch b
rec Patch b
p
    SplitPatch Patch b
a D
cps Patch b
b -> Patch b -> D -> Patch b -> Patch b
forall a. Patch a -> D -> Patch a -> Patch a
SplitPatch (Patch b -> Patch b
rec Patch b
a) D
cps (Patch b -> Patch b
rec Patch b
b)
    LayerPatch [(Sig, Patch b)]
xs -> [(Sig, Patch b)] -> Patch b
forall a. [(Sig, Patch a)] -> Patch a
LayerPatch ([(Sig, Patch b)] -> Patch b) -> [(Sig, Patch b)] -> Patch b
forall a b. (a -> b) -> a -> b
$ ((Sig, Patch b) -> (Sig, Patch b))
-> [(Sig, Patch b)] -> [(Sig, Patch b)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Patch b -> Patch b) -> (Sig, Patch b) -> (Sig, Patch b)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Patch b -> Patch b
rec) [(Sig, Patch b)]
xs
    where
        rec :: Patch b -> Patch b
rec = (MonoInstr b -> MonoInstr b)
-> ((CsdNote D -> SE b) -> CsdNote D -> SE b) -> Patch b -> Patch b
forall a.
(MonoInstr a -> MonoInstr a)
-> (Instr D a -> Instr D a) -> Patch a -> Patch a
tfmInstr MonoInstr b -> MonoInstr b
monoTfm (CsdNote D -> SE b) -> CsdNote D -> SE b
polyTfm

------------------------------------------------
-- revers

withSmallRoom :: Patch2 -> Patch2
withSmallRoom :: Patch2 -> Patch2
withSmallRoom = Sig -> Patch2 -> Patch2
withSmallRoom' Sig
0.25

withSmallRoom' :: DryWetRatio -> Patch2 -> Patch2
withSmallRoom' :: Sig -> Patch2 -> Patch2
withSmallRoom' = ((Sig, Sig) -> (Sig, Sig)) -> Sig -> Patch2 -> Patch2
withRever (Sig, Sig) -> (Sig, Sig)
smallRoom2

withSmallHall :: Patch2 -> Patch2
withSmallHall :: Patch2 -> Patch2
withSmallHall = Sig -> Patch2 -> Patch2
withSmallHall' Sig
0.25

withSmallHall' :: DryWetRatio -> Patch2 -> Patch2
withSmallHall' :: Sig -> Patch2 -> Patch2
withSmallHall' = ((Sig, Sig) -> (Sig, Sig)) -> Sig -> Patch2 -> Patch2
withRever (Sig, Sig) -> (Sig, Sig)
smallHall2

withLargeHall :: Patch2 -> Patch2
withLargeHall :: Patch2 -> Patch2
withLargeHall = Sig -> Patch2 -> Patch2
withLargeHall' Sig
0.25

withLargeHall' :: DryWetRatio -> Patch2 -> Patch2
withLargeHall' :: Sig -> Patch2 -> Patch2
withLargeHall' = ((Sig, Sig) -> (Sig, Sig)) -> Sig -> Patch2 -> Patch2
withRever (Sig, Sig) -> (Sig, Sig)
largeHall2

withMagicCave :: Patch2 -> Patch2
withMagicCave :: Patch2 -> Patch2
withMagicCave = Sig -> Patch2 -> Patch2
withMagicCave' Sig
0.25

withMagicCave' :: DryWetRatio -> Patch2 -> Patch2
withMagicCave' :: Sig -> Patch2 -> Patch2
withMagicCave' = ((Sig, Sig) -> (Sig, Sig)) -> Sig -> Patch2 -> Patch2
withRever (Sig, Sig) -> (Sig, Sig)
magicCave2

withRever :: (Sig2 -> Sig2) -> DryWetRatio -> Patch2 -> Patch2
withRever :: ((Sig, Sig) -> (Sig, Sig)) -> Sig -> Patch2 -> Patch2
withRever (Sig, Sig) -> (Sig, Sig)
fx Sig
ratio Patch2
p = Sig -> Fx (Sig, Sig) -> Patch2 -> Patch2
forall a. Sig -> Fx a -> Patch a -> Patch a
addPostFx Sig
ratio (Fx (Sig, Sig)
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return Fx (Sig, Sig) -> ((Sig, Sig) -> (Sig, Sig)) -> Fx (Sig, Sig)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sig, Sig) -> (Sig, Sig)
fx) Patch2
p

------------------------------------------------
-- sound font patch

-- | Sound font patch with a bit of reverb.
sfPatchHall :: Sf -> Patch2
sfPatchHall :: Sf -> Patch2
sfPatchHall = Patch2 -> Patch2
withSmallHall (Patch2 -> Patch2) -> (Sf -> Patch2) -> Sf -> Patch2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sf -> Patch2
sfPatch

-- | Sound font patch.
sfPatch :: Sf -> Patch2
sfPatch :: Sf -> Patch2
sfPatch Sf
sf = Instr D (Sig, Sig) -> Patch2
forall a. Instr D a -> Patch a
polySynt (Instr D (Sig, Sig) -> Patch2) -> Instr D (Sig, Sig) -> Patch2
forall a b. (a -> b) -> a -> b
$ \(D
amp, D
cps) -> Fx (Sig, Sig)
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return Fx (Sig, Sig) -> Fx (Sig, Sig)
forall a b. (a -> b) -> a -> b
$ Sf -> D -> D -> D -> (Sig, Sig)
sfCps Sf
sf D
0.5 D
amp D
cps

------------------------------------------------
-- Csound API


-- | Triggers patch with Csound API.
-- It creates a named instruement with given name (first argument).
--
-- It simulates the midi-like instrument. Notes are encoded with messages:
--
-- > i "givenName" 1 pitchKey volumeKey     -- note on
-- > i "givenName" 0 pitchKey volumeKey     -- note off
patchByNameMidi :: (SigSpace a, Sigs a) => Text -> Patch a -> SE a
patchByNameMidi :: forall a. (SigSpace a, Sigs a) => Text -> Patch a -> SE a
patchByNameMidi = (Sig -> Sig) -> (D -> D) -> Text -> Patch a -> SE a
forall a.
(SigSpace a, Sigs a) =>
(Sig -> Sig) -> (D -> D) -> Text -> Patch a -> SE a
genPatchByNameMidi Sig -> Sig
forall a. SigOrD a => a -> a
cpsmidinn D -> D
forall a. SigOrD a => a -> a
cpsmidinn

-- | Triggers patch with Csound API.
-- It creates a named instruement with given name (second argument).
-- It behaves like the function @patchByNameMidi@ but we can specify custom temperament.
patchByNameMidiTemp :: (SigSpace a, Sigs a) => Temp -> Text -> Patch a -> SE a
patchByNameMidiTemp :: forall a. (SigSpace a, Sigs a) => Temp -> Text -> Patch a -> SE a
patchByNameMidiTemp Temp
tm = (Sig -> Sig) -> (D -> D) -> Text -> Patch a -> SE a
forall a.
(SigSpace a, Sigs a) =>
(Sig -> Sig) -> (D -> D) -> Text -> Patch a -> SE a
genPatchByNameMidi (Temp -> Sig -> Sig
cpsmidi'Sig Temp
tm) (Temp -> D -> D
cpsmidi'D Temp
tm)

genPatchByNameMidi :: forall a . (SigSpace a, Sigs a) => (Sig -> Sig) -> (D -> D) -> Text -> Patch a -> SE a
genPatchByNameMidi :: forall a.
(SigSpace a, Sigs a) =>
(Sig -> Sig) -> (D -> D) -> Text -> Patch a -> SE a
genPatchByNameMidi Sig -> Sig
monoKey2cps D -> D
polyKey2cps Text
name Patch a
x = Maybe SyntSkin -> Patch a -> SE a
go Maybe SyntSkin
forall a. Maybe a
Nothing Patch a
x
    where
        go :: Maybe SyntSkin -> Patch a -> SE a
go Maybe SyntSkin
maybeSkin = \case
            MonoSynt MonoSyntSpec
spec GenMonoInstr a
instr -> MonoSyntSpec -> (MonoArg -> SE a) -> SE a
forall {b}. MonoSyntSpec -> (MonoArg -> SE b) -> SE b
monoSyntProc MonoSyntSpec
spec (GenMonoInstr a -> Maybe SyntSkin -> MonoArg -> SE a
forall a. Reader SyntSkin a -> Maybe SyntSkin -> a
runSkin GenMonoInstr a
instr Maybe SyntSkin
maybeSkin)
            PolySynt PolySyntSpec
spec GenInstr D a
instr -> PolySyntSpec -> (CsdNote D -> SE a) -> SE a
forall {p}. p -> (CsdNote D -> SE a) -> SE a
polySyntProc PolySyntSpec
spec (GenInstr D a -> Maybe SyntSkin -> CsdNote D -> SE a
forall a. Reader SyntSkin a -> Maybe SyntSkin -> a
runSkin GenInstr D a
instr Maybe SyntSkin
maybeSkin)
            SetSkin SyntSkin
skin Patch a
p      -> SyntSkin -> Patch a -> SE a
newSkin SyntSkin
skin Patch a
p
            FxChain [GenFxSpec a]
fxs Patch a
p       -> Maybe SyntSkin -> [GenFxSpec a] -> Fx a
forall a.
(SigSpace a, Sigs a) =>
Maybe SyntSkin -> [GenFxSpec a] -> Fx a
getPatchFx Maybe SyntSkin
maybeSkin [GenFxSpec a]
fxs Fx a -> SE a -> SE a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Patch a -> SE a
rec Patch a
p
            LayerPatch [(Sig, Patch a)]
xs       -> [(Sig, Patch a)] -> (Patch a -> SE a) -> SE a
forall a.
(SigSpace a, Sigs a) =>
[(Sig, Patch a)] -> (Patch a -> SE a) -> SE a
onLayered [(Sig, Patch a)]
xs Patch a -> SE a
rec
            SplitPatch Patch a
a D
cps Patch a
b  -> Patch a -> D -> Patch a -> SE a
splitPatch Patch a
a D
cps Patch a
b
            where
                rec :: Patch a -> SE a
rec = Maybe SyntSkin -> Patch a -> SE a
go Maybe SyntSkin
maybeSkin
                newSkin :: SyntSkin -> Patch a -> SE a
newSkin SyntSkin
skin = Maybe SyntSkin -> Patch a -> SE a
go (SyntSkin -> Maybe SyntSkin
forall a. a -> Maybe a
Just SyntSkin
skin)

                monoSyntProc :: MonoSyntSpec -> (MonoArg -> SE b) -> SE b
monoSyntProc MonoSyntSpec
spec MonoArg -> SE b
instr = MonoArg -> SE b
instr (MonoArg -> SE b) -> SE MonoArg -> SE b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ((MonoArg -> MonoArg) -> SE MonoArg -> SE MonoArg
forall a b. (a -> b) -> SE a -> SE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (MonoSyntSpec -> MonoArg -> MonoArg
smoothMonoSpec MonoSyntSpec
spec (MonoArg -> MonoArg) -> (MonoArg -> MonoArg) -> MonoArg -> MonoArg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MonoArg -> MonoArg
convert) (SE MonoArg -> SE MonoArg) -> SE MonoArg -> SE MonoArg
forall a b. (a -> b) -> a -> b
$ Text -> SE MonoArg
trigNamedMono Text
name)
                    where
                        convert :: MonoArg -> MonoArg
convert MonoArg
a = MonoArg
a { monoAmp = vel2ampSig (monoAmp a), monoCps = monoKey2cps (monoCps a) }

                polySyntProc :: p -> (CsdNote D -> SE a) -> SE a
polySyntProc p
_spec CsdNote D -> SE a
instr = Text -> ((D, D, Unit) -> SE a) -> SE a
forall a b. (Arg a, Sigs b) => Text -> ((D, D, a) -> SE b) -> SE b
trigByNameMidi Text
name (D, D, Unit) -> SE a
proc
                    where
                        proc :: (D, D, Unit) -> SE a
                        proc :: (D, D, Unit) -> SE a
proc (D
pitch, D
vol, Unit
_) = CsdNote D -> SE a
instr (D -> D
vel2amp D
vol, D -> D
polyKey2cps D
pitch)

                splitPatch :: Patch a -> D -> Patch a -> SE a
splitPatch Patch a
a D
cps Patch a
b = Maybe SyntSkin
-> (MidiChn -> (D -> BoolD) -> (MonoArg -> SE a) -> SE a)
-> (MidiChn -> (CsdNote D -> SE a) -> SE a)
-> Patch a
-> D
-> Patch a
-> SE a
forall a.
(SigSpace a, Sigs a) =>
Maybe SyntSkin
-> (MidiChn -> (D -> BoolD) -> MonoInstr a -> SE a)
-> (MidiChn -> (CsdNote D -> SE a) -> SE a)
-> Patch a
-> D
-> Patch a
-> SE a
genSplitPatch Maybe SyntSkin
maybeSkin MidiChn -> (D -> BoolD) -> (MonoArg -> SE a) -> SE a
forall {p} {b}. MidiChn -> p -> (MonoArg -> SE b) -> SE b
playMonoInstr MidiChn -> (CsdNote D -> SE a) -> SE a
playInstr Patch a
a D
cps Patch a
b

                playMonoInstr :: MidiChn -> p -> (MonoArg -> SE b) -> SE b
playMonoInstr MidiChn
chn p
_cond MonoArg -> SE b
instr = MonoSyntSpec -> (MonoArg -> SE b) -> SE b
forall {b}. MonoSyntSpec -> (MonoArg -> SE b) -> SE b
monoSyntProc (MonoSyntSpec
forall a. Default a => a
def { monoSyntChn = chn }) MonoArg -> SE b
instr
                playInstr :: MidiChn -> (CsdNote D -> SE a) -> SE a
playInstr MidiChn
chn CsdNote D -> SE a
instr = PolySyntSpec -> (CsdNote D -> SE a) -> SE a
forall {p}. p -> (CsdNote D -> SE a) -> SE a
polySyntProc (PolySyntSpec
forall a. Default a => a
def { polySyntChn = chn }) CsdNote D -> SE a
instr

vel2amp :: D -> D
vel2amp :: D -> D
vel2amp D
vol = ((D
vol D -> D -> D
forall a. Fractional a => a -> a -> a
/ D
64) D -> D -> D
forall a. Floating a => a -> a -> a
** D
2) D -> D -> D
forall a. Fractional a => a -> a -> a
/ D
2

vel2ampSig :: Sig -> Sig
vel2ampSig :: Sig -> Sig
vel2ampSig Sig
vol = ((Sig
vol Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/ Sig
64) Sig -> Sig -> Sig
forall a. Floating a => a -> a -> a
** Sig
2) Sig -> Sig -> Sig
forall a. Fractional a => a -> a -> a
/ Sig
2

{-

-- | Triggers patch with Csound API.
-- It creates a named instruement with given name (first argument).
--
-- It simulates the midi-like instrument. Notes are encoded with messages:
--
-- > i "givenName" 1 pitchKey volumeKey     -- note on
-- > i "givenName" 0 pitchKey volumeKey     -- note off
patchByNameMidi :: (SigSpace a, Sigs a) => String -> Patch D a -> SE a
patchByNameMidi = genPatchByNameMidi cpsmidinn

-- | Triggers patch with Csound API.
-- It creates a named instruement with given name (second argument).
-- It behaves like the function @patchByNameMidi@ but we can specify custom temperament.
patchByNameMidiTemp :: (SigSpace a, Sigs a) => Temp -> String -> Patch D a -> SE a
patchByNameMidiTemp tm = genPatchByNameMidi (cpsmidi'D tm)

-- | Wrapper for function @trigByNameMidi@.
genPatchByNameMidi :: forall a . (SigSpace a, Sigs a) => (D -> D) -> String -> Patch D a -> SE a
genPatchByNameMidi key2cps name p = getPatchFx p =<< trigByNameMidi name go
  where
    go :: (D, D, Unit) -> SE a
    go (pitch, vol, _) = patchInstr p (vel2amp vol, key2cps pitch)


-- | Triggers patch with Csound API.
-- It creates a named instruement with given name (first argument).
--
-- It simulates the midi-like instrument. Notes are encoded with messages:
--
-- > i "givenName" 1 pitchKey volumeKey     -- note on
-- > i "givenName" 0 pitchKey volumeKey     -- note off
--
-- It behaves just like the function @patchByNameMidi@ but it's defined for
-- monophonic patches. For instruments that take in continuous signals not messages/notes.
monoPatchByNameMidi :: (SigSpace a, Sigs a) => String -> Patch Sig a -> SE a
monoPatchByNameMidi name p = monoPatchByNameMidi' 0.01 0.1 name p

-- | Triggers patch with Csound API.
-- It creates a named instruement with given name (first argument).
-- It behaves like the function @monoPatchByNameMidi@ but we can specify custom temperament.
monoPatchByNameMidiTemp :: (SigSpace a, Sigs a) => Temp -> String -> Patch Sig a -> SE a
monoPatchByNameMidiTemp tm name p = monoPatchByNameMidiTemp' tm 0.01 0.1 name p

-- | The monophonic patch with sharper transition from note to note.
monoSharpPatchByNameMidi :: (SigSpace a, Sigs a) => String -> Patch Sig a -> SE a
monoSharpPatchByNameMidi name p = monoPatchByNameMidi' 0.005 0.05 name p

-- | The monophonic patch with sharper transition from note to note.
-- We can specify a custom temperament.
monoSharpPatchByNameMidiTemp :: (SigSpace a, Sigs a) => Temp -> String -> Patch Sig a -> SE a
monoSharpPatchByNameMidiTemp tm name p = monoPatchByNameMidiTemp' tm 0.005 0.05 name p

-- | Generic function fr invocation of monophonic instrument with Csound API.
-- We can specify portamento and release times.
monoPatchByNameMidi' :: (SigSpace a, Sigs a) => D -> D -> String -> Patch Sig a -> SE a
monoPatchByNameMidi' = genMonoPatchByNameMidi' cpsmidinn

-- | Generic function fr invocation of monophonic instrument with Csound API.
-- We can specify portamento and release times. Also we can specify a temperament.
monoPatchByNameMidiTemp' :: (SigSpace a, Sigs a) => Temp -> D -> D -> String -> Patch Sig a -> SE a
monoPatchByNameMidiTemp' tm = genMonoPatchByNameMidi' (cpsmidi'Sig tm)

-- | Wrapper for function @trigByNameMidi@ for mono synth.
genMonoPatchByNameMidi' :: forall a . (SigSpace a, Sigs a) => (Sig -> Sig) -> D -> D -> String -> Patch Sig a -> SE a
genMonoPatchByNameMidi' key2cps portTime relTime name p = getPatchFx p =<< patchInstr p =<< fmap convert (trigNamedMono portTime relTime name)
  where
    convert (vol, pch) = (vel2ampSig vol, key2cps pch)

vel2amp :: D -> D
vel2amp vol = ((vol / 64) ** 2) / 2

vel2ampSig :: Sig -> Sig
vel2ampSig vol = ((vol / 64) ** 2) / 2

-}


--------------------------------------------------
-- special functions to add effects

-- | Make an effect out of a pure function.
fxSig :: SigSpace a => (Sig -> Sig) -> GenFxSpec a
fxSig :: forall a. SigSpace a => (Sig -> Sig) -> GenFxSpec a
fxSig Sig -> Sig
f = Sig -> Fx a -> GenFxSpec a
forall a. Sig -> Fx a -> GenFxSpec a
fxSpec Sig
1 (Fx a
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return Fx a -> (a -> a) -> Fx a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sig -> Sig) -> a -> a
forall a. SigSpace a => (Sig -> Sig) -> a -> a
mapSig Sig -> Sig
f)

-- | Make an effect out of a pure function and specify dry/wet ratio.
fxSigMix :: SigSpace a => Sig -> (Sig -> Sig) -> GenFxSpec a
fxSigMix :: forall a. SigSpace a => Sig -> (Sig -> Sig) -> GenFxSpec a
fxSigMix Sig
ratio Sig -> Sig
f = Sig -> Fx a -> GenFxSpec a
forall a. Sig -> Fx a -> GenFxSpec a
fxSpec Sig
ratio (Fx a
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return Fx a -> (a -> a) -> Fx a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sig -> Sig) -> a -> a
forall a. SigSpace a => (Sig -> Sig) -> a -> a
mapSig Sig -> Sig
f)

-- | Make an effect out of a stereo pure function.
fxSig2 :: (Sig2 -> Sig2) -> GenFxSpec Sig2
fxSig2 :: ((Sig, Sig) -> (Sig, Sig)) -> GenFxSpec (Sig, Sig)
fxSig2 (Sig, Sig) -> (Sig, Sig)
f = Sig -> Fx (Sig, Sig) -> GenFxSpec (Sig, Sig)
forall a. Sig -> Fx a -> GenFxSpec a
fxSpec Sig
1 (Fx (Sig, Sig)
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return Fx (Sig, Sig) -> ((Sig, Sig) -> (Sig, Sig)) -> Fx (Sig, Sig)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sig, Sig) -> (Sig, Sig)
f)

-- | Make an effect out of a stereo pure function and specify dry/wet ratio.
fxSigMix2 :: Sig -> (Sig2 -> Sig2) -> GenFxSpec Sig2
fxSigMix2 :: Sig -> ((Sig, Sig) -> (Sig, Sig)) -> GenFxSpec (Sig, Sig)
fxSigMix2 Sig
ratio (Sig, Sig) -> (Sig, Sig)
f = Sig -> Fx (Sig, Sig) -> GenFxSpec (Sig, Sig)
forall a. Sig -> Fx a -> GenFxSpec a
fxSpec Sig
ratio (Fx (Sig, Sig)
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return Fx (Sig, Sig) -> ((Sig, Sig) -> (Sig, Sig)) -> Fx (Sig, Sig)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sig, Sig) -> (Sig, Sig)
f)


-- | Adds post fx with pure signal function.
mapFx :: SigSpace a => (Sig -> Sig) -> Patch a -> Patch a
mapFx :: forall a. SigSpace a => (Sig -> Sig) -> Patch a -> Patch a
mapFx Sig -> Sig
f = Sig -> Fx a -> Patch a -> Patch a
forall a. Sig -> Fx a -> Patch a -> Patch a
addPostFx Sig
1 (Fx a
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return Fx a -> (a -> a) -> Fx a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sig -> Sig) -> a -> a
forall a. SigSpace a => (Sig -> Sig) -> a -> a
mapSig Sig -> Sig
f)

-- | Adds post fx with pure signal function and specifies dry/wet ratio.
mapFx' :: SigSpace a => Sig -> (Sig -> Sig) -> Patch a -> Patch a
mapFx' :: forall a. SigSpace a => Sig -> (Sig -> Sig) -> Patch a -> Patch a
mapFx' Sig
rate Sig -> Sig
f = Sig -> Fx a -> Patch a -> Patch a
forall a. Sig -> Fx a -> Patch a -> Patch a
addPostFx Sig
rate (Fx a
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return Fx a -> (a -> a) -> Fx a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sig -> Sig) -> a -> a
forall a. SigSpace a => (Sig -> Sig) -> a -> a
mapSig Sig -> Sig
f)

-- | Adds post fx with effectful signal function.
bindFx :: BindSig a => (Sig -> SE Sig) -> Patch a -> Patch a
bindFx :: forall a. BindSig a => (Sig -> SE Sig) -> Patch a -> Patch a
bindFx Sig -> SE Sig
f = Sig -> Fx a -> Patch a -> Patch a
forall a. Sig -> Fx a -> Patch a -> Patch a
addPostFx Sig
1 ((Sig -> SE Sig) -> Fx a
forall a. BindSig a => (Sig -> SE Sig) -> a -> SE a
bindSig Sig -> SE Sig
f)

-- | Adds post fx with effectful signal function and specifies dry/wet ratio.
bindFx' :: BindSig a => Sig -> (Sig -> SE Sig) -> Patch a -> Patch a
bindFx' :: forall a. BindSig a => Sig -> (Sig -> SE Sig) -> Patch a -> Patch a
bindFx' Sig
rate Sig -> SE Sig
f = Sig -> Fx a -> Patch a -> Patch a
forall a. Sig -> Fx a -> Patch a -> Patch a
addPostFx Sig
rate ((Sig -> SE Sig) -> Fx a
forall a. BindSig a => (Sig -> SE Sig) -> a -> SE a
bindSig Sig -> SE Sig
f)


-- | Adds pre fx with pure signal function.
mapPreFx :: SigSpace a => (Sig -> Sig) -> Patch a -> Patch a
mapPreFx :: forall a. SigSpace a => (Sig -> Sig) -> Patch a -> Patch a
mapPreFx Sig -> Sig
f = Sig -> Fx a -> Patch a -> Patch a
forall a. Sig -> Fx a -> Patch a -> Patch a
addPreFx Sig
1 (Fx a
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return Fx a -> (a -> a) -> Fx a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sig -> Sig) -> a -> a
forall a. SigSpace a => (Sig -> Sig) -> a -> a
mapSig Sig -> Sig
f)

-- | Adds pre fx with pure signal function and specifies dry/wet ratio.
mapPreFx' :: SigSpace a => Sig -> (Sig -> Sig) -> Patch a -> Patch a
mapPreFx' :: forall a. SigSpace a => Sig -> (Sig -> Sig) -> Patch a -> Patch a
mapPreFx' Sig
rate Sig -> Sig
f = Sig -> Fx a -> Patch a -> Patch a
forall a. Sig -> Fx a -> Patch a -> Patch a
addPreFx Sig
rate (Fx a
forall a. a -> SE a
forall (m :: * -> *) a. Monad m => a -> m a
return Fx a -> (a -> a) -> Fx a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sig -> Sig) -> a -> a
forall a. SigSpace a => (Sig -> Sig) -> a -> a
mapSig Sig -> Sig
f)

-- | Adds pre fx with effectful signal function.
bindPreFx :: BindSig a => (Sig -> SE Sig) -> Patch a -> Patch a
bindPreFx :: forall a. BindSig a => (Sig -> SE Sig) -> Patch a -> Patch a
bindPreFx Sig -> SE Sig
f = Sig -> Fx a -> Patch a -> Patch a
forall a. Sig -> Fx a -> Patch a -> Patch a
addPreFx Sig
1 ((Sig -> SE Sig) -> Fx a
forall a. BindSig a => (Sig -> SE Sig) -> a -> SE a
bindSig Sig -> SE Sig
f)

-- | Adds pre fx with effectful signal function and specifies dry/wet ratio.
bindPreFx' :: BindSig a => Sig -> (Sig -> SE Sig) -> Patch a -> Patch a
bindPreFx' :: forall a. BindSig a => Sig -> (Sig -> SE Sig) -> Patch a -> Patch a
bindPreFx' Sig
rate Sig -> SE Sig
f = Sig -> Fx a -> Patch a -> Patch a
forall a. Sig -> Fx a -> Patch a -> Patch a
addPreFx Sig
rate ((Sig -> SE Sig) -> Fx a
forall a. BindSig a => (Sig -> SE Sig) -> a -> SE a
bindSig Sig -> SE Sig
f)

instance RenderCsd Patch1 where
    renderCsdBy :: Options -> Patch1 -> IO [Char]
renderCsdBy Options
opt Patch1
p = Options -> SE Sig -> IO [Char]
forall a. RenderCsd a => Options -> a -> IO [Char]
renderCsdBy Options
opt (Patch1 -> SE Sig
forall a. (SigSpace a, Sigs a) => Patch a -> SE a
atMidi Patch1
p)
    csdArity :: Proxy Patch1 -> CsdArity
csdArity Proxy Patch1
_ = Int -> Int -> CsdArity
CsdArity Int
0 Int
1

instance RenderCsd Patch2 where
    renderCsdBy :: Options -> Patch2 -> IO [Char]
renderCsdBy Options
opt Patch2
p = Options -> SE (Sig, Sig) -> IO [Char]
forall a. RenderCsd a => Options -> a -> IO [Char]
renderCsdBy Options
opt (Patch2 -> SE (Sig, Sig)
forall a. (SigSpace a, Sigs a) => Patch a -> SE a
atMidi Patch2
p)
    csdArity :: Proxy Patch2 -> CsdArity
csdArity Proxy Patch2
_ = Int -> Int -> CsdArity
CsdArity Int
0 Int
2