module Csound.Air.Patch(
CsdNote, Instr, Fx, Fx1, Fx2, FxSpec(..), DryWetRatio,
Patch1, Patch2, Patch(..),
getPatchFx, dryPatch, atMix, atMixes,
atMidi,
atSched,
atSchedUntil,
atSco,
atNote,
addInstrFx, addPreFx, addPostFx,
harmonPatch, deepPad,
patchWhen, mixInstr
) where
import Control.Monad
import Control.Applicative
import Csound.Typed
import Csound.SigSpace
import Csound.Control.Midi
import Csound.Control.Instr
type CsdNote = (D, D)
type Instr a = CsdNote -> SE a
type Fx a = a -> SE a
type DryWetRatio = Sig
type Fx1 = Fx Sig
type Fx2 = Fx Sig2
type Patch1 = Patch Sig
type Patch2 = Patch Sig2
data FxSpec a = FxSpec
{ fxMix :: DryWetRatio
, fxFun :: Fx a
}
data Patch a = Patch
{ patchInstr :: Instr a
, patchFx :: [FxSpec a]
}
dryPatch :: Patch a -> Patch a
dryPatch p = p { patchFx = [] }
atMix :: Sig -> Patch a -> Patch a
atMix k p = p { patchFx = mapHead (\x -> x { fxMix = k }) (patchFx p) }
where
mapHead f xs = case xs of
[] -> []
a:as -> f a : as
atMixes :: [Sig] -> Patch a -> Patch a
atMixes ks p = p { patchFx = zipFirst (\k x -> x { fxMix = k }) ks (patchFx p) }
where
zipFirst f xs ys = case (xs, ys) of
(_, []) -> []
([], bs) -> bs
(a:as, b:bs) -> f a b : zipFirst f as bs
wet :: (SigSpace a, Sigs a) => FxSpec a -> Fx a
wet (FxSpec k fx) asig = fmap ((mul (1 k) asig + ) . mul k) $ fx asig
getPatchFx :: (SigSpace a, Sigs a) => Patch a -> Fx a
getPatchFx p = foldr (<=<) return $ fmap wet $ patchFx p
instance SigSpace a => SigSpace (Patch a) where
mapSig f p = p { patchInstr = fmap (mapSig f) . patchInstr p }
atNote :: (SigSpace a, Sigs a) => Patch a -> CsdNote -> SE a
atNote p note = getPatchFx p =<< patchInstr p note
atMidi :: (SigSpace a, Sigs a) => Patch a -> SE a
atMidi a = getPatchFx a =<< midi (patchInstr a . ampCps)
atSched :: (SigSpace a, Sigs a) => Patch a -> Evt (Sco CsdNote) -> SE a
atSched p evt = getPatchFx p $ sched (patchInstr p) evt
atSchedUntil :: (SigSpace a, Sigs a) => Patch a -> Evt CsdNote -> Evt b -> SE a
atSchedUntil p evt stop = getPatchFx p $ schedUntil (patchInstr p) evt stop
atSco :: (SigSpace a, Sigs a) => Patch a -> Sco CsdNote -> Sco (Mix a)
atSco p sc = eff (getPatchFx p) $ sco (patchInstr p) sc
addInstrFx :: Fx a -> Patch a -> Patch a
addInstrFx f p = p { patchInstr = f <=< patchInstr p }
addPreFx :: DryWetRatio -> Fx a -> Patch a -> Patch a
addPreFx dw f p = p { patchFx = patchFx p ++ [FxSpec dw f] }
addPostFx :: DryWetRatio -> Fx a -> Patch a -> Patch a
addPostFx dw f p = p { patchFx = FxSpec dw f : patchFx p }
patchWhen :: Sigs a => BoolSig -> Patch a -> Patch a
patchWhen cond p = p
{ patchInstr = playWhen cond (patchInstr p)
, patchFx = fmap (mapFun $ playWhen cond) (patchFx p) }
where mapFun f x = x { fxFun = f $ fxFun x }
mixInstr :: (SigSpace a, Num a) => Sig -> Patch a -> Patch a -> Patch a
mixInstr k f p = p { patchInstr = \x -> liftA2 (+) (patchInstr p x) (fmap (mul k) (patchInstr f x)) }
harmonPatch :: (SigSpace a, Sigs a) => [Sig] -> [D] -> Patch a -> Patch a
harmonPatch amps freqs p = p {
patchInstr = \(amp, cps) -> fmap sum $ zipWithM (\a f -> fmap (mul a) $ patchInstr p (amp, cps * f)) amps freqs
}
deepPad :: (SigSpace a, Sigs a) => Patch a -> Patch a
deepPad = harmonPatch (fmap (* 0.75) [1, 0.5]) [1, 0.5]